CRHD2 ; CAIRO/CLC - GET DATA ITEMS FOR CHANGEOVER LIST ;08-Apr-2008 08:03;CLC
 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
 ;=================================================================
CODESTS(CRHDRTN,CRHDSTR) ;CODE STATUS -using orders, try to find and orderable item for DNR, if not found look for a text order
 ;                     by the name of DNRTITLE, title also set up as a p
 ;DFN      - patient internal entry number to Patient file
 ;DNRTITLE - DNR order title if not defined by a parameter
 ;DIVISION - the division user logged into
 ;LEN      - length of text to return for each line, default:18
 ;DTFLG    - return the start date and stop date for order default:yes
 ;
 
CRHDDFN,CRHDDNRT,CRHDDIV,CRHDLEN,CRHDX,CRHDY,CRHDCT,CRHDMDNR,CRHDQQFG
 
CRHDDTFG,CRHDOCT,CRHDSR,CRHDO,CRHDT,CRHDQ,CRHDQ1,CRHDQX,CRHDTMP,CRHDQY,CRHDFLG
 
CRHDRTN
 
CRHDDFN=+CRHDSTR
 
CRHDDNRT=$P(CRHDSTR,U,2)
 
CRHDDIV=$P(CRHDSTR,U,3)
 
CRHDLEN=$P(CRHDSTR,U,4)
 
'CRHDLEN CRHDLEN=18
 
CRHDDTFG=$P(CRHDSTR,U,5)
 
CRHDDTFG="" CRHDDTFG=1
 
CRHDMDNR=+$P(CRHDSTR,U,6)
 
ENT^CRHDDR(.CRHDO,CRHDDFN,.CRHDDNRT,.CRHDDIV,CRHDMDNR)
 
ENT^CRHDDNR(.CRHDT,CRHDDFN,.CRHDDNRT,.CRHDDIV,CRHDMDNR)
 
CRHDQ=0 F  S CRHDQ=$O(CRHDO(CRHDQ)) Q:'CRHDQ  I $P(CRHDO(CRHDQ),"~",1)&(CRHDO(CRHDQ)["~"CRHDTMP($P(CRHDO(CRHDQ),"~",1),$P(CRHDO(CRHDQ),"~",2))="CRHDO^"_CRHDQ
 
CRHDQ=0 F  S CRHDQ=$O(CRHDT(CRHDQ)) Q:'CRHDQ  I $P(CRHDT(CRHDQ),"~",1)&(CRHDT(CRHDQ)["~")  CRHDTMP($P(CRHDT(CRHDQ),"~",1),$P(CRHDT(CRHDQ),"~",2))="CRHDT^"_CRHDQ
 
(CRHDCT,CRHDQQFG)=0
 
CRHDQ=0 CRHDI=1:1 CRHDQ=$O(CRHDTMP(CRHDQ)) Q:'CRHDQ!(CRHDQQFG)  CRHDQ1=0 F  S CRHDQ1=$O(CRHDTMP(CRHDQ,CRHDQ1)) Q:'CRHDQ1  D
 
.CRHDQFLG=0
 .
'CRHDMDNR CRHDQQFG=1
 .
CRHDQX=$P(CRHDTMP(CRHDQ,CRHDQ1),"^",1),CRHDQY=$P(CRHDTMP(CRHDQ,CRHDQ1),"^",2)
 .
CRHDQ2=CRHDQY-1,CRHDQFLG=0 F  S CRHDQ2=$O(@CRHDQX@(CRHDQ2)) Q:'CRHDQ2!(CRHDQFLG)  D
 
..(CRHDQ2'=CRHDQY)&(@CRHDQX@(CRHDQ2)["~"CRHDQFLG=1 S:('CRHDMDNR)&(CRHDI>1) CRHDQQFG=1 Q
 
..(CRHDQ2'=CRHDQY)&(@CRHDQX@(CRHDQ2)["~"CRHDQFLG=1 Q
 
..CRHDCT=CRHDCT+1
 ..
@CRHDQX@(CRHDQ2)["~" CRHDRTN(CRHDCT)=$P(@CRHDQX@(CRHDQ2),"~",3)
 ..
E  S CRHDRTN(CRHDCT)=@CRHDQX@(CRHDQ2)
 
I $D(CRHDRTND
 
.CRHDX=0,CRHDCT=1
 .
F  S CRHDX=$O(CRHDRTN(CRHDX)) Q:'CRHDX  D
 
..I $L(CRHDRTN(CRHDX))>CRHDLEN D
 
...F  Q:$L(CRHDRTN(CRHDX))=0  CRHDCT=CRHDCT+1,CRHDY(CRHDCT)=$E(CRHDRTN(CRHDX),1,CRHDLEN),CRHDRTN(CRHDX)=$E(CRHDRTN(CRHDX),CRHDLEN+1,9999)
 ..
E  D
 
...CRHDRTN(CRHDX)["Stop Date" CRHDY(CRHDCT)=CRHDY(CRHDCT)_"  "_CRHDRTN(CRHDXD
 
....I $L(CRHDY(CRHDCT))>CRHDLEN CRHDOCT=CRHDCT,CRHDSR=CRHDY(CRHDCTF  Q:$L(CRHDSR)=0  CRHDY(CRHDCT)=$E(CRHDSR,1,CRHDLEN),CRHDSR=$E(CRHDSR,CRHDLEN+1,9999),CRHDOCT=CRHDOCT+1
 ...
E  S CRHDCT=CRHDCT+1,CRHDY(CRHDCT)=CRHDRTN(CRHDX)
 
CRHDRTN
 
CRHDRTN=CRHDY
 
CRHDCT>1 CRHDRTN(1)=CRHDCT-1
 
I $G(CRHDRTN(2))="" CRHDRTN(1)=1,CRHDRTN(2)="Code Status Not Found"
 
Q
NODETAM(CRHDY,CRHDDFN,CRHDCAT) ;GET ACTIVE MEDS WITHOUT THE DETAILS, FOR ACTIVE MEDS WITH DETAILS USE CRHDAM
 ;CRHDCAT :I - inpatient
 ;         O - outpatient
 
CRHDP1,CRHDP2,CRHDPP1,CRHDPP2,CRHDCT,CRHDN2,CRHDN3,CRHDRTN,CRHDSORT
 
CRHDN
 
CRHDCT=0
 
COVER^ORWPS(.CRHDRTN,CRHDDFN)
 
'$D(CRHDRTNQ
 S 
CRHDN=0
 
F  S CRHDN=$O(CRHDRTN(CRHDN)) Q:'CRHDN  D
 
.CRHDP1=$P(CRHDRTN(CRHDN),"^",1)
 .
CRHDPP1=$P(CRHDP1,";",1)
 .
CRHDPP2=$P(CRHDP1,";",2)
 .
CRHDCAT="O"&(CRHDPP2="O"SORT
 
.CRHDCAT="I"&(CRHDPP2="I"SORT
 
OUTPUT Q
 Q
SORT ;
 
I $P(CRHDRTN(CRHDN),"^",4)'["ACTIVE" Q
 S 
CRHDSORT($E(CRHDPP1,$L(CRHDPP1)),$P(CRHDRTN(CRHDN),"^",2),CRHDPP1)=""
 
Q
OUTPUT ;
 
CRHDN=""
 
F  S CRHDN=$O(CRHDSORT(CRHDN)) Q:CRHDN=""  D
 
.CRHDN2="" F  S CRHDN2=$O(CRHDSORT(CRHDN,CRHDN2)) Q:CRHDN2=""  D
 
..CRHDN3="" F  S CRHDN3=$O(CRHDSORT(CRHDN,CRHDN2,CRHDN3)) Q:CRHDN3=""  D
 
...CRHDCT=CRHDCT+1
 ...
CRHDCAT="O"&(CRHDN="N"CRHDY(CRHDN,CRHDCT)="NON-VA "_CRHDN2 Q
 
...CRHDY(CRHDN,CRHDCT)=CRHDN2
 
CRHDY(0)=CRHDCT_"^"_CRHDCAT_$S(CRHDCAT="O":"UT",1:"N")_"PATIENT"
 
Q
TEMPDATA(CRHDRTN,CRHDFLDN,CRHDUSER,CRHDDFN,CRHDTXT) ;TEMPORARY DATA, DATA ONLY USE FOR A SHORT TIME FRAME
 ;CRHDFLD - TEMP FIELD NAME
 ;CRHDUSER    - AUTHOR OF THE NOTE
 ;if fld already has the author then this is 'WHO LAST EDITED'
 ;CRHDDFN     - Patient
 ;TEXT    - Text to be stored
 
CRHDFDA,CRHDOUT,CRHDERR,CRHDFN,CRHDUPZ,CRHDUPZZ,CRHDPZZZ
 
CRHDRTN,CRHDUPY
 
CRHDFLDN=$$UP^XLFSTR(CRHDFLDN)
 
CRHDUPY=$$CHK(CRHDFLDN,CRHDUSER,CRHDDFN)
 
CRHDUPZ=$P(CRHDUPY,"^",2)
 
CRHDUPZ="+1," CRHDUPZZ="?+1,",CRHDPZZZ="?+2,"
 
E  S CRHDUPZZ="?+2,"
 
CRHDUPZ="+1," CRHDUPZ=CRHDUPZZ,CRHDUPZZ=CRHDPZZZ NEW
 
E  D UPDATE(CRHDFLDN,CRHDUSER,CRHDDFN,.CRHDTXT)
 
I $D(CRHDERRD  Q
 
.^CRHDER($$NOW^XLFDT,"ERROR-UPDATING DATA")=CRHDFLDN_U_CRHDUSER_U_CRHDDFN
 
.^CRHDER($$NOW^XLFDT,"ERROR-UPDATING DATA")=CRHDTXT Q
 
.CRHDERR,CRHDOUT,CRHDFDA
 
.CRHDRTN(1)=0_"^ERROR SAVING DATA..."
 
E  S CRHDRTN(1)=1_"^SAVE SUCCESSFUL..."
 
Q
NEW CRHDFDA(183.21,CRHDUPZZ_CRHDUPZ,1)=CRHDUSER
 
CRHDFDA(183.21,CRHDUPZZ_CRHDUPZ,2)=$$NOW^XLFDT
 
CRHDFDA(183.21,CRHDUPZZ_CRHDUPZ,5)=0
 
UPDATE(CRHDFLDN,CRHDUSER,CRHDDFN,.CRHDTXT)
 
I $D(CRHDERRD
 
.^CRHDER($$NOW^XLFDT,"ERROR-ADDING DATA")=CRHDFLDN_U_CRHDUSER_U_CRHDDFN
 
.^CRHDER($$NOW^XLFDT,"ERROR-ADDING DATA")=CRHDTXT Q
 
.CRHDERR,CRHDOUT,CRHDFDA
 
Q
UPDATE(CRHDFLD,CRHDUSER,CRHDDFN,CRHDTXT) ;
 ;SEE NEWDATA
 
CRHDFDA(183.2,"?+1,",.01)=CRHDFLD
 
CRHDFDA(183.21,CRHDUPZZ_CRHDUPZ,.01)=CRHDDFN
 
CRHDFDA(183.21,CRHDUPZZ_CRHDUPZ,3)=CRHDUSER
 
CRHDFDA(183.21,CRHDUPZZ_CRHDUPZ,4)=$$NOW^XLFDT
 
UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
 
CRHDIEN=$G(CRHDOUT(1)),CRHDMIEN=$G(CRHDOUT(2))
 
+^CRHD(183.2,CRHDIEN,1,CRHDMIEN):1 '$T Q
 I 
'$D(CRHDERRSTORETXT(CRHDIEN,CRHDMIEN,.CRHDTXT)
 
-^CRHD(183.2,CRHDIEN,1,CRHDMIEN)
 
Q
STORETXT(CRHDIEN,CRHDMIEN,CRHDTARY) ;store text to file
 
CRHDTRG,CRHDFG,CRHDX,CRHDCT,CRHDLINE
 
Q:'CRHDIEN&('CRHDMIEN)
 
CRHDTRG="CRHDTARY"
 
Q:'$D(@CRHDTRG)
 
;D SAVEOLD(CRHDIEN,CRHDMIEN)
 
^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT")
 
^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT",0)="^^^^"_$$DT^XLFDT
 
CRHDX=0 CRHDLINE=0:1 CRHDX=$O(@CRHDTRG@(CRHDX)) Q:'CRHDX
 
(CRHDFG,CRHDX,CRHDCT)=0
 
F  S CRHDX=$O(@CRHDTRG@(CRHDX)) Q:'CRHDX!(CRHDFG)  D
 
.I $D(@CRHDTRG@(CRHDX,0)) D  Q
 
..^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT")=@CRHDTRG
 
..S $P(^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT",0),"^",3,4)=CRHDLINE_"^"_CRHDLINE
 
..CRHDFG=1
 .
I $G(@CRHDTRG@(CRHDX))'="" D
 
..CRHDCT=CRHDCT+1
 ..
^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT",CRHDCT,0)=@CRHDTRG@(CRHDX)
 ..
S $P(^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT",0),"^",3,4)=CRHDCT_"^"_CRHDCT
 
Q
SAVEOLD(CRHDIEN,CRHDMIEN) ;
 
I $D(^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT")) D
 
.^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"ZOLD_TEXT")
 .
^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"ZOLD_TEXT")=^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT")
 
Q
CHK(CRHDFLDN,CRHDUSER,CRHDDFN) ;
 
CRHDFLG,CRHDX,CRHDP  ;FLG = 1 if record already exist
 
CRHDFLG=0
 
CRHDFN=183.2
 
CRHDFLD=$O(^CRHD(CRHDFN,"B",CRHDFLDN,0))
 
I $D(^CRHD(CRHDFN,"C",+CRHDDFN,+CRHDFLD)) D
 
.S:CRHDFLD CRHDFLG=1
 
CRHDFLG CRHDFLG=CRHDFLG_"^"_CRHDFLD_","
 
E  S CRHDFLG=CRHDFLG_"^"_"+1,"
 
CRHDFLG
XREF(CRHDIEN,CRHDMIEN) ;SET THE XREF FOR SPECIALTY AND TEAM
 
CRHDTM,CRHDTSP,CRHDAUTH,CRHDPAT
 
CRHDAUTH=$P($G(^CRHD(183.2,CRHDIEN,1,CRHDMIEN,0)),"^",2)
 
Q:'CRHDAUTH
 
CRHDPAT=$P($G(^CRHD(183.2,CRHDIEN,1,CRHDMIEN,0)),"^",1)
 
;do not set up reference if a private note
 
Q:+$P($G(^CRHD(183.2,CRHDIEN,1,CRHDMIEN,0)),"^",6)
 
CRHDTM=$$GET^XPAR("USR.`"_CRHDAUTH,"ORLP DEFAULT TEAM",1,"I")
 
CRHDTSP=$$GET^XPAR("USR.`"_CRHDAUTH,"ORLP DEFAULT SPECIALTY",1,"I")
 
S:+CRHDTM ^CRHD(183.2,"AC","TM",CRHDTM,CRHDPAT,CRHDIEN,CRHDMIEN)=""
 
S:+CRHDTSP ^CRHD(183.2,"AC","TSP",CRHDTSP,CRHDPAT,CRHDIEN,CRHDMIEN)=""
 
Q
KILXREF(CRHDIEN,CRHDMIEN) ;KILL XREF FOR SPECIALTY AND TEAM
 
CRHDTM,CRHDTSP,CRHDAUTH,CRHDPAT
 
CRHDAUTH=$P($G(^CRHD(183.2,CRHDIEN,1,CRHDMIEN,0)),"^",2)
 
Q:'CRHDAUTH
 
CRHDPAT=$P($G(^CRHD(183.2,CRHDIEN,1,CRHDMIEN,0)),"^",1)
 
CRHDTM=$$GET^XPAR("USR.`"_CRHDAUTH,"ORLP DEFAULT TEAM",1,"I")
 
CRHDTSP=$$GET^XPAR("USR.`"_CRHDAUTH,"ORLP DEFAULT SPECIALTY",1,"I")
 
K:+CRHDTM ^CRHD(183.2,"AC","TM",CRHDTM,CRHDPAT,CRHDIEN,CRHDMIEN)
 
K:+CRHDTSP ^CRHD(183.2,"AC","TSP",CRHDTSP,CRHDPAT,CRHDIEN,CRHDMIEN)
 
Q
ONOFFPRV(CRHDPRIV,CRHDIEN,CRHDMIEN) ;ON/OFF PRIVATE NOTE
 
'CRHDPRIV XREF(CRHDIEN,CRHDMIEN)
 
+CRHDPRIV KILXREF(CRHDIEN,CRHDMIEN)
 
Q
LOCK(CRHDRTN,CRHDDFN,CRHDFLDM) ;
 
CRHDIEN,CRHDMIEN
 
CRHDRTN=0
 
CRHDFLDM=$$UP^XLFSTR(CRHDFLDM)
 
CRHDIEN=$O(^CRHD(183.2,"B",CRHDFLDM,0))
 
CRHDMIEN=$O(^CRHD(183.2,"C",+CRHDDFN,+CRHDIEN,0))
 
Q:'CRHDMIEN
 
+^CRHD(183.2,CRHDIEN,1,CRHDMIEN):10 '$T S CRHDRTN=1      ;_"^0^Another user is editing this task"
 
-^CRHD(183.2,CRHDIEN,1,CRHDMIEN)
 
Q