CRHDUT2 ; CAIRO/CLC - GET THE PATIENT DATA ELEMENTS FOR HANDOFF LIST CONTINUED;04-Mar-2008 16:00;CLC
;;1.0;CRHD;****;Jan 28, 2008;Build 19
;=================================================================
PATDEMO(CRHDDATA,CRHDSTR) ;GET PATIENTS DEMOGRAPHICS
;DFN - patient internal entry number to the Patient file
;P - pieces to return from retrieve data string
;CRHDLEN - max length of returned items, defaults to 18
;LABELS - 0 or 1
;Output
;CRHDRTN
;DFN - Piece 1 NAME Piece 2
;SSN 3 (full ssn) DOB 4
;SSN 5 (last 4ssn) AGE 6
;SEX 7 RM 8
;TSP 9 ATN 10
;PCP 11 LOC 12
;ADMDT 13 (adm date) DAY w/i ADM 14
;ADMDX 15 (admission Diagnosis)
;
N VAIN,VAIP,VADM,CRHDNAME,CRHDSSN,CRHDDOB,CRHDAGE,CRHDSEX,CRHDRM,CRHDTSP,CRHDATTN,CRHDRTN,CRHDLEN,CRHDLBLS
N CRHDPCP,CRHDWARD,CRHDADMD,CRHDADAY,CRHDADX,CRHDI,CRHDTRG,CRHDNUM,CRHDP,DFN
K CRHDDATA
S CRHDTRG="^TMP(""CRHD_ORDATA"",$J)"
K @CRHDTRG,CRHDRTN
S CRHDNUM=0
S DFN=+CRHDSTR
S CRHDP=$P(CRHDSTR,U,2)
I CRHDP=""!(CRHDP="ALL") S CRHDP="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15"
S CRHDLEN=$P(CRHDSTR,U,3)
I 'CRHDLEN S CRHDLEN=18
S CRHDLBLS=$P(CRHDSTR,U,4)
Q:'DFN
D DEM^VADPT
S CRHDNAME=VADM(1),CRHDSSN=$P(VADM(2),U,1),CRHDDOB=$P(VADM(3),U,2)
S CRHDAGE=VADM(4),CRHDSEX=$P(VADM(5),U,1)
D INP^VADPT
S CRHDRM=$G(VAIN(5)) ;Room/Bed
S CRHDTSP=$P($G(VAIN(3)),U,2) ;Team (Treating Specialty)
S CRHDATTN=$P($G(VAIN(11)),U,2) ;Attending Physicial
S CRHDPCP=$P($$OUTPTPR^SDUTL3(DFN,DT),U,2) ;Primary Care Provider
S CRHDWARD=$P($G(VAIN(4)),U,2) ;Ward Location
S CRHDADMD=$P($G(VAIN(7)),U,2) ;Admission Date
S:+$G(VAIN(7))>0 CRHDADAY=$$FMDIFF^XLFDT(+$$DT^XLFDT,+$G(VAIN(7)),1) ;Day within Admission
S CRHDADX=$G(VAIN(9)) ;Admission Diagnosis
I $G(CRHDLBLS) D
.S CRHDRTN=DFN_U_$E(CRHDNAME,1,CRHDLEN)_U_"SSN: "_CRHDSSN_U_"DOB: "_CRHDDOB
.S CRHDRTN=CRHDRTN_U_"SSN: "_$E(CRHDSSN,6,9)_U_"AGE: "_CRHDAGE_U_"SEX: "_CRHDSEX
.S CRHDRTN=CRHDRTN_U_"RM : "_CRHDRM_U_"TM: "_$E(CRHDTSP,1,CRHDLEN-4)
.S CRHDRTN=CRHDRTN_U_"ATN: "_$E(CRHDATTN,1,CRHDLEN-5)_U_"PCP: "_$E(CRHDPCP,1,CRHDLEN-5)
.S CRHDRTN=CRHDRTN_U_"LOC: "_CRHDWARD_U_CRHDADMD_U_"DAY OF ADM: "_$G(CRHDADAY)_U_"ADM DX: "_$E(CRHDADX,1,CRHDLEN)
.F CRHDI=1:1:$L(CRHDP,",") I $P(CRHDRTN,"^",$P(CRHDP,",",CRHDI))'="" S CRHDDATA=$G(CRHDDATA)_$P(CRHDRTN,"^",$P(CRHDP,",",CRHDI)) S:CRHDI<$L(CRHDP,",") CRHDDATA=CRHDDATA_"^"
E D
.S CRHDRTN=DFN_U_$E(CRHDNAME,1,CRHDLEN)_U_CRHDSSN_U_CRHDDOB_U_$E(CRHDSSN,6,9)_U_CRHDAGE_U_CRHDSEX_U_CRHDRM_U_$E(CRHDTSP,1,CRHDLEN)_U_$E(CRHDATTN,1,CRHDLEN-5)_U_$E(CRHDPCP,1,CRHDLEN-5)_U_CRHDWARD_U_CRHDADMD_U_$G(CRHDADAY)_U_$E(CRHDADX,1,CRHDLEN)
.F CRHDI=1:1:$L(CRHDP,",") S CRHDDATA=$G(CRHDDATA)_$P(CRHDRTN,"^",$P(CRHDP,",",CRHDI)) S:CRHDI<$L(CRHDP,",") CRHDDATA=CRHDDATA_"^"
Q
AUSRINFO(CRHDRTN,CRHDUSR) ;retrieve additional user information
N X,Y
K CRHDRTN
S CRHDRTN(1)=0
S CRHDRTN(1)=$$GET1^DIQ(200,CRHDUSR_",",.132,"E")_"^"_$$GET1^DIQ(200,CRHDUSR_",",.138,"E")_"^"_$$GET^XPAR("USR.`"_CRHDUSR,"ORLP DEFAULT TEAM",1,"I")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HCRHDUT2 3343 printed Apr 09, 2024@21:40:16 Page 2
CRHDUT2 ; CAIRO/CLC - GET THE PATIENT DATA ELEMENTS FOR HANDOFF LIST CONTINUED;04-Mar-2008 16:00;CLC
+1 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
+2 ;=================================================================
PATDEMO(CRHDDATA,CRHDSTR) ;GET PATIENTS DEMOGRAPHICS
+1 ;DFN - patient internal entry number to the Patient file
+2 ;P - pieces to return from retrieve data string
+3 ;CRHDLEN - max length of returned items, defaults to 18
+4 ;LABELS - 0 or 1
+5 ;Output
+6 ;CRHDRTN
+7 ;DFN - Piece 1 NAME Piece 2
+8 ;SSN 3 (full ssn) DOB 4
+9 ;SSN 5 (last 4ssn) AGE 6
+10 ;SEX 7 RM 8
+11 ;TSP 9 ATN 10
+12 ;PCP 11 LOC 12
+13 ;ADMDT 13 (adm date) DAY w/i ADM 14
+14 ;ADMDX 15 (admission Diagnosis)
+15 ;
+16 NEW VAIN,VAIP,VADM,CRHDNAME,CRHDSSN,CRHDDOB,CRHDAGE,CRHDSEX,CRHDRM,CRHDTSP,CRHDATTN,CRHDRTN,CRHDLEN,CRHDLBLS
+17 NEW CRHDPCP,CRHDWARD,CRHDADMD,CRHDADAY,CRHDADX,CRHDI,CRHDTRG,CRHDNUM,CRHDP,DFN
+18 KILL CRHDDATA
+19 SET CRHDTRG="^TMP(""CRHD_ORDATA"",$J)"
+20 KILL @CRHDTRG,CRHDRTN
+21 SET CRHDNUM=0
+22 SET DFN=+CRHDSTR
+23 SET CRHDP=$PIECE(CRHDSTR,U,2)
+24 IF CRHDP=""!(CRHDP="ALL")
SET CRHDP="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15"
+25 SET CRHDLEN=$PIECE(CRHDSTR,U,3)
+26 IF 'CRHDLEN
SET CRHDLEN=18
+27 SET CRHDLBLS=$PIECE(CRHDSTR,U,4)
+28 if 'DFN
QUIT
+29 DO DEM^VADPT
+30 SET CRHDNAME=VADM(1)
SET CRHDSSN=$PIECE(VADM(2),U,1)
SET CRHDDOB=$PIECE(VADM(3),U,2)
+31 SET CRHDAGE=VADM(4)
SET CRHDSEX=$PIECE(VADM(5),U,1)
+32 DO INP^VADPT
+33 ;Room/Bed
SET CRHDRM=$GET(VAIN(5))
+34 ;Team (Treating Specialty)
SET CRHDTSP=$PIECE($GET(VAIN(3)),U,2)
+35 ;Attending Physicial
SET CRHDATTN=$PIECE($GET(VAIN(11)),U,2)
+36 ;Primary Care Provider
SET CRHDPCP=$PIECE($$OUTPTPR^SDUTL3(DFN,DT),U,2)
+37 ;Ward Location
SET CRHDWARD=$PIECE($GET(VAIN(4)),U,2)
+38 ;Admission Date
SET CRHDADMD=$PIECE($GET(VAIN(7)),U,2)
+39 ;Day within Admission
if +$GET(VAIN(7))>0
SET CRHDADAY=$$FMDIFF^XLFDT(+$$DT^XLFDT,+$GET(VAIN(7)),1)
+40 ;Admission Diagnosis
SET CRHDADX=$GET(VAIN(9))
+41 IF $GET(CRHDLBLS)
Begin DoDot:1
+42 SET CRHDRTN=DFN_U_$EXTRACT(CRHDNAME,1,CRHDLEN)_U_"SSN: "_CRHDSSN_U_"DOB: "_CRHDDOB
+43 SET CRHDRTN=CRHDRTN_U_"SSN: "_$EXTRACT(CRHDSSN,6,9)_U_"AGE: "_CRHDAGE_U_"SEX: "_CRHDSEX
+44 SET CRHDRTN=CRHDRTN_U_"RM : "_CRHDRM_U_"TM: "_$EXTRACT(CRHDTSP,1,CRHDLEN-4)
+45 SET CRHDRTN=CRHDRTN_U_"ATN: "_$EXTRACT(CRHDATTN,1,CRHDLEN-5)_U_"PCP: "_$EXTRACT(CRHDPCP,1,CRHDLEN-5)
+46 SET CRHDRTN=CRHDRTN_U_"LOC: "_CRHDWARD_U_CRHDADMD_U_"DAY OF ADM: "_$GET(CRHDADAY)_U_"ADM DX: "_$EXTRACT(CRHDADX,1,CRHDLEN)
+47 FOR CRHDI=1:1:$LENGTH(CRHDP,",")
IF $PIECE(CRHDRTN,"^",$PIECE(CRHDP,",",CRHDI))'=""
SET CRHDDATA=$GET(CRHDDATA)_$PIECE(CRHDRTN,"^",$PIECE(CRHDP,",",CRHDI))
if CRHDI<$LENGTH(CRHDP,",")
SET CRHDDATA=CRHDDATA_"^"
End DoDot:1
+48 IF '$TEST
Begin DoDot:1
+49 SET CRHDRTN=DFN_U_$EXTRACT(CRHDNAME,1,CRHDLEN)_U_CRHDSSN_U_CRHDDOB_U_...
... $EXTRACT(CRHDSSN,6,9)_U_CRHDAGE_U_CRHDSEX_U_CRHDRM_U_$EXTRACT(CRHDTSP,1,CRHDLEN)_U_$EXTRACT(CRHDATTN,1,CRHDLEN-5)_U_$EXTRACT(CRHDPCP,1,CRHDLEN-5)_U_CRHDWARD_U_CRHDADMD_U_$GET(CRHDADAY)_U_$EXTRACT(CRHDADX,1,CRHDLEN)
+50 FOR CRHDI=1:1:$LENGTH(CRHDP,",")
SET CRHDDATA=$GET(CRHDDATA)_$PIECE(CRHDRTN,"^",$PIECE(CRHDP,",",CRHDI))
if CRHDI<$LENGTH(CRHDP,",")
SET CRHDDATA=CRHDDATA_"^"
End DoDot:1
+51 QUIT
AUSRINFO(CRHDRTN,CRHDUSR) ;retrieve additional user information
+1 NEW X,Y
+2 KILL CRHDRTN
+3 SET CRHDRTN(1)=0
+4 SET CRHDRTN(1)=$$GET1^DIQ(200,CRHDUSR_",",.132,"E")_"^"_$$GET1^DIQ(200,CRHDUSR_",",.138,"E")_"^"_$$GET^XPAR("USR.`"_CRHDUSR,"ORLP DEFAULT TEAM",1,"I")
+5 QUIT
