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
	;
	N CRHDDFN,CRHDDNRT,CRHDDIV,CRHDLEN,CRHDX,CRHDY,CRHDCT,CRHDMDNR,CRHDQQFG
	N CRHDDTFG,CRHDOCT,CRHDSR,CRHDO,CRHDT,CRHDQ,CRHDQ1,CRHDQX,CRHDTMP,CRHDQY,CRHDFLG
	K CRHDRTN
	S CRHDDFN=+CRHDSTR
	S CRHDDNRT=$P(CRHDSTR,U,2)
	S CRHDDIV=$P(CRHDSTR,U,3)
	S CRHDLEN=$P(CRHDSTR,U,4)
	I 'CRHDLEN S CRHDLEN=18
	S CRHDDTFG=$P(CRHDSTR,U,5)
	I CRHDDTFG="" S CRHDDTFG=1
	S CRHDMDNR=+$P(CRHDSTR,U,6)
	D ENT^CRHDDR(.CRHDO,CRHDDFN,.CRHDDNRT,.CRHDDIV,CRHDMDNR)
	D ENT^CRHDDNR(.CRHDT,CRHDDFN,.CRHDDNRT,.CRHDDIV,CRHDMDNR)
	S CRHDQ=0 F  S CRHDQ=$O(CRHDO(CRHDQ)) Q:'CRHDQ  I $P(CRHDO(CRHDQ),"~",1)&(CRHDO(CRHDQ)["~") S CRHDTMP($P(CRHDO(CRHDQ),"~",1),$P(CRHDO(CRHDQ),"~",2))="CRHDO^"_CRHDQ
	S CRHDQ=0 F  S CRHDQ=$O(CRHDT(CRHDQ)) Q:'CRHDQ  I $P(CRHDT(CRHDQ),"~",1)&(CRHDT(CRHDQ)["~")  S CRHDTMP($P(CRHDT(CRHDQ),"~",1),$P(CRHDT(CRHDQ),"~",2))="CRHDT^"_CRHDQ
	S (CRHDCT,CRHDQQFG)=0
	S CRHDQ=0 F CRHDI=1:1 S CRHDQ=$O(CRHDTMP(CRHDQ)) Q:'CRHDQ!(CRHDQQFG)  S CRHDQ1=0 F  S CRHDQ1=$O(CRHDTMP(CRHDQ,CRHDQ1)) Q:'CRHDQ1  D
	.S CRHDQFLG=0
	.I 'CRHDMDNR S CRHDQQFG=1
	.S CRHDQX=$P(CRHDTMP(CRHDQ,CRHDQ1),"^",1),CRHDQY=$P(CRHDTMP(CRHDQ,CRHDQ1),"^",2)
	.S CRHDQ2=CRHDQY-1,CRHDQFLG=0 F  S CRHDQ2=$O(@CRHDQX@(CRHDQ2)) Q:'CRHDQ2!(CRHDQFLG)  D
	..I (CRHDQ2'=CRHDQY)&(@CRHDQX@(CRHDQ2)["~") S CRHDQFLG=1 S:('CRHDMDNR)&(CRHDI>1) CRHDQQFG=1 Q
	..I (CRHDQ2'=CRHDQY)&(@CRHDQX@(CRHDQ2)["~") S CRHDQFLG=1 Q
	..S CRHDCT=CRHDCT+1
	..I @CRHDQX@(CRHDQ2)["~" S CRHDRTN(CRHDCT)=$P(@CRHDQX@(CRHDQ2),"~",3)
	..E  S CRHDRTN(CRHDCT)=@CRHDQX@(CRHDQ2)
	I $D(CRHDRTN) D
	.S 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  S CRHDCT=CRHDCT+1,CRHDY(CRHDCT)=$E(CRHDRTN(CRHDX),1,CRHDLEN),CRHDRTN(CRHDX)=$E(CRHDRTN(CRHDX),CRHDLEN+1,9999)
	..E  D
	...I CRHDRTN(CRHDX)["Stop Date" S CRHDY(CRHDCT)=CRHDY(CRHDCT)_"  "_CRHDRTN(CRHDX) D
	....I $L(CRHDY(CRHDCT))>CRHDLEN S CRHDOCT=CRHDCT,CRHDSR=CRHDY(CRHDCT) F  Q:$L(CRHDSR)=0  S CRHDY(CRHDCT)=$E(CRHDSR,1,CRHDLEN),CRHDSR=$E(CRHDSR,CRHDLEN+1,9999),CRHDOCT=CRHDOCT+1
	...E  S CRHDCT=CRHDCT+1,CRHDY(CRHDCT)=CRHDRTN(CRHDX)
	K CRHDRTN
	M CRHDRTN=CRHDY
	I CRHDCT>1 S CRHDRTN(1)=CRHDCT-1
	I $G(CRHDRTN(2))="" S 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
	N CRHDP1,CRHDP2,CRHDPP1,CRHDPP2,CRHDCT,CRHDN2,CRHDN3,CRHDRTN,CRHDSORT
	N CRHDN
	S CRHDCT=0
	D COVER^ORWPS(.CRHDRTN,CRHDDFN)
	I '$D(CRHDRTN) Q
	S CRHDN=0
	F  S CRHDN=$O(CRHDRTN(CRHDN)) Q:'CRHDN  D
	.S CRHDP1=$P(CRHDRTN(CRHDN),"^",1)
	.S CRHDPP1=$P(CRHDP1,";",1)
	.S CRHDPP2=$P(CRHDP1,";",2)
	.I CRHDCAT="O"&(CRHDPP2="O") D SORT
	.I CRHDCAT="I"&(CRHDPP2="I") D SORT
	D OUTPUT Q
	Q
SORT	;
	I $P(CRHDRTN(CRHDN),"^",4)'["ACTIVE" Q
	S CRHDSORT($E(CRHDPP1,$L(CRHDPP1)),$P(CRHDRTN(CRHDN),"^",2),CRHDPP1)=""
	Q
OUTPUT	;
	S CRHDN=""
	F  S CRHDN=$O(CRHDSORT(CRHDN)) Q:CRHDN=""  D
	.S CRHDN2="" F  S CRHDN2=$O(CRHDSORT(CRHDN,CRHDN2)) Q:CRHDN2=""  D
	..S CRHDN3="" F  S CRHDN3=$O(CRHDSORT(CRHDN,CRHDN2,CRHDN3)) Q:CRHDN3=""  D
	...S CRHDCT=CRHDCT+1
	...I CRHDCAT="O"&(CRHDN="N") S CRHDY(CRHDN,CRHDCT)="NON-VA "_CRHDN2 Q
	...S CRHDY(CRHDN,CRHDCT)=CRHDN2
	S 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
	N CRHDFDA,CRHDOUT,CRHDERR,CRHDFN,CRHDUPZ,CRHDUPZZ,CRHDPZZZ
	K CRHDRTN,CRHDUPY
	S CRHDFLDN=$$UP^XLFSTR(CRHDFLDN)
	S CRHDUPY=$$CHK(CRHDFLDN,CRHDUSER,CRHDDFN)
	S CRHDUPZ=$P(CRHDUPY,"^",2)
	I CRHDUPZ="+1," S CRHDUPZZ="?+1,",CRHDPZZZ="?+2,"
	E  S CRHDUPZZ="?+2,"
	I CRHDUPZ="+1," S CRHDUPZ=CRHDUPZZ,CRHDUPZZ=CRHDPZZZ D NEW
	E  D UPDATE(CRHDFLDN,CRHDUSER,CRHDDFN,.CRHDTXT)
	I $D(CRHDERR) D  Q
	.S ^CRHDER($$NOW^XLFDT,"ERROR-UPDATING DATA")=CRHDFLDN_U_CRHDUSER_U_CRHDDFN
	.M ^CRHDER($$NOW^XLFDT,"ERROR-UPDATING DATA")=CRHDTXT Q
	.K CRHDERR,CRHDOUT,CRHDFDA
	.S CRHDRTN(1)=0_"^ERROR SAVING DATA..."
	E  S CRHDRTN(1)=1_"^SAVE SUCCESSFUL..."
	Q
NEW	S CRHDFDA(183.21,CRHDUPZZ_CRHDUPZ,1)=CRHDUSER
	S CRHDFDA(183.21,CRHDUPZZ_CRHDUPZ,2)=$$NOW^XLFDT
	S CRHDFDA(183.21,CRHDUPZZ_CRHDUPZ,5)=0
	D UPDATE(CRHDFLDN,CRHDUSER,CRHDDFN,.CRHDTXT)
	I $D(CRHDERR) D
	.S ^CRHDER($$NOW^XLFDT,"ERROR-ADDING DATA")=CRHDFLDN_U_CRHDUSER_U_CRHDDFN
	.M ^CRHDER($$NOW^XLFDT,"ERROR-ADDING DATA")=CRHDTXT Q
	.K CRHDERR,CRHDOUT,CRHDFDA
	Q
UPDATE(CRHDFLD,CRHDUSER,CRHDDFN,CRHDTXT)	;
	;SEE NEWDATA
	S CRHDFDA(183.2,"?+1,",.01)=CRHDFLD
	S CRHDFDA(183.21,CRHDUPZZ_CRHDUPZ,.01)=CRHDDFN
	S CRHDFDA(183.21,CRHDUPZZ_CRHDUPZ,3)=CRHDUSER
	S CRHDFDA(183.21,CRHDUPZZ_CRHDUPZ,4)=$$NOW^XLFDT
	D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
	S CRHDIEN=$G(CRHDOUT(1)),CRHDMIEN=$G(CRHDOUT(2))
	L +^CRHD(183.2,CRHDIEN,1,CRHDMIEN):1 I '$T Q
	I '$D(CRHDERR) D STORETXT(CRHDIEN,CRHDMIEN,.CRHDTXT)
	L -^CRHD(183.2,CRHDIEN,1,CRHDMIEN)
	Q
STORETXT(CRHDIEN,CRHDMIEN,CRHDTARY)	;store text to file
	N CRHDTRG,CRHDFG,CRHDX,CRHDCT,CRHDLINE
	Q:'CRHDIEN&('CRHDMIEN)
	S CRHDTRG="CRHDTARY"
	Q:'$D(@CRHDTRG)
	;D SAVEOLD(CRHDIEN,CRHDMIEN)
	K ^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT")
	S ^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT",0)="^^^^"_$$DT^XLFDT
	S CRHDX=0 F CRHDLINE=0:1 S CRHDX=$O(@CRHDTRG@(CRHDX)) Q:'CRHDX
	S (CRHDFG,CRHDX,CRHDCT)=0
	F  S CRHDX=$O(@CRHDTRG@(CRHDX)) Q:'CRHDX!(CRHDFG)  D
	.I $D(@CRHDTRG@(CRHDX,0)) D  Q
	..M ^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT")=@CRHDTRG
	..S $P(^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT",0),"^",3,4)=CRHDLINE_"^"_CRHDLINE
	..S CRHDFG=1
	.I $G(@CRHDTRG@(CRHDX))'="" D
	..S CRHDCT=CRHDCT+1
	..S ^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
	.K ^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"ZOLD_TEXT")
	.M ^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"ZOLD_TEXT")=^CRHD(183.2,CRHDIEN,1,CRHDMIEN,"TEXT")
	Q
CHK(CRHDFLDN,CRHDUSER,CRHDDFN)	;
	N CRHDFLG,CRHDX,CRHDP  ;FLG = 1 if record already exist
	S CRHDFLG=0
	S CRHDFN=183.2
	S CRHDFLD=$O(^CRHD(CRHDFN,"B",CRHDFLDN,0))
	I $D(^CRHD(CRHDFN,"C",+CRHDDFN,+CRHDFLD)) D
	.S:CRHDFLD CRHDFLG=1
	I CRHDFLG S CRHDFLG=CRHDFLG_"^"_CRHDFLD_","
	E  S CRHDFLG=CRHDFLG_"^"_"+1,"
	Q CRHDFLG
XREF(CRHDIEN,CRHDMIEN)	;SET THE XREF FOR SPECIALTY AND TEAM
	N CRHDTM,CRHDTSP,CRHDAUTH,CRHDPAT
	S CRHDAUTH=$P($G(^CRHD(183.2,CRHDIEN,1,CRHDMIEN,0)),"^",2)
	Q:'CRHDAUTH
	S 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)
	S CRHDTM=$$GET^XPAR("USR.`"_CRHDAUTH,"ORLP DEFAULT TEAM",1,"I")
	S 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
	N CRHDTM,CRHDTSP,CRHDAUTH,CRHDPAT
	S CRHDAUTH=$P($G(^CRHD(183.2,CRHDIEN,1,CRHDMIEN,0)),"^",2)
	Q:'CRHDAUTH
	S CRHDPAT=$P($G(^CRHD(183.2,CRHDIEN,1,CRHDMIEN,0)),"^",1)
	S CRHDTM=$$GET^XPAR("USR.`"_CRHDAUTH,"ORLP DEFAULT TEAM",1,"I")
	S 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
	I 'CRHDPRIV D XREF(CRHDIEN,CRHDMIEN)
	I +CRHDPRIV D KILXREF(CRHDIEN,CRHDMIEN)
	Q
LOCK(CRHDRTN,CRHDDFN,CRHDFLDM)	;
	N CRHDIEN,CRHDMIEN
	S CRHDRTN=0
	S CRHDFLDM=$$UP^XLFSTR(CRHDFLDM)
	S CRHDIEN=$O(^CRHD(183.2,"B",CRHDFLDM,0))
	S CRHDMIEN=$O(^CRHD(183.2,"C",+CRHDDFN,+CRHDIEN,0))
	Q:'CRHDMIEN
	L +^CRHD(183.2,CRHDIEN,1,CRHDMIEN):10 I '$T S CRHDRTN=1      ;_"^0^Another user is editing this task"
	L -^CRHD(183.2,CRHDIEN,1,CRHDMIEN)
	Q