| 1 | ORWPT ; SLC/KCM/REV - Patient Lookup Functions ;11/23/06 10:50
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,149,206,187,190,215,269**;Dec 17, 1997 LOCAL ;Build 28
|
|---|
| 3 | ; Modified from FOIA VISTA,
|
|---|
| 4 | ; Copyright (C) 2007 WorldVistA
|
|---|
| 5 | ;
|
|---|
| 6 | ; This program is free software; you can redistribute it and/or modify
|
|---|
| 7 | ; it under the terms of the GNU General Public License
|
|---|
| 8 | ;;VOE VWPT PACKAGE ENHANCEMENT UPDATES ADDED 11/14/06
|
|---|
| 9 | ;
|
|---|
| 10 | Q
|
|---|
| 11 | IDINFO(REC,DFN) ; Return identifying information for a patient
|
|---|
| 12 | ;VWPT BELOW ADD HRN AND ALT HRN
|
|---|
| 13 | ; PID^DOB^SEX^VET^SC%^WARD^RM-BED^NAME^HRN^ALTHRN
|
|---|
| 14 | ; PID^DOB^SEX^VET^SC%^WARD^RM-BED^NAME
|
|---|
| 15 | N X0,X1,X101,X3,XV ; name/dob/sex/ssn, ward, room-bed, sc%, vet
|
|---|
| 16 | S X0=$G(^DPT(DFN,0)),X1=$G(^(.1)),X101=$G(^(.101)),X3=$G(^(.3)),XV=$G(^("VET"))
|
|---|
| 17 | ;VWPT ENHANCED
|
|---|
| 18 | N HRN,ID
|
|---|
| 19 | S HRN=$$HRN^DGLBPID(DFN)
|
|---|
| 20 | S ID=$$ID^DGLBPID(DFN)
|
|---|
| 21 | I (ID=HRN)&(HRN'="") D
|
|---|
| 22 | .S REC=U_$$DOB^DPTLK1(DFN,2)_U_$P(X0,U,2)_U_$P(XV,U)_U_$P(X3,U,2)_U_$P(X1,U)_U_$P(X101,U)_U_$P(X0,U)_U_$$HRNRET(DFN)_U_$$ALTHRN^ORWPT2(DFN) ;DG249
|
|---|
| 23 | E D
|
|---|
| 24 | .S REC=$$ID^DGLBPID(DFN)_U_$$DOB^DPTLK1(DFN,2)_U_$P(X0,U,2)_U_$P(XV,U)_U_$P(X3,U,2)_U_$P(X1,U)_U_$P(X101,U)_U_$P(X0,U)_U_$$HRNRET(DFN)_U_$$ALTHRN^ORWPT2(DFN) ;DG249
|
|---|
| 25 | ;S REC=$$SSN^DPTLK1(DFN)_U_$$DOB^DPTLK1(DFN,2)_U_$P(X0,U,2)_U_$P(XV,U)_U_$P(X3,U,2)_U_$P(X1,U)_U_$P(X101,U)_U_$P(X0,U) ;DG249
|
|---|
| 26 | ;END VWPT
|
|---|
| 27 | Q
|
|---|
| 28 | ;VWPT RETURN HRN .CHECK FOR "sensitive" patients
|
|---|
| 29 | HRNRET(DFN) ;
|
|---|
| 30 | N IRET
|
|---|
| 31 | S IRET=$$HRN^DGLBPID(DFN) ;$$HRN^VWVOEDPT(DFN)
|
|---|
| 32 | ;I (IRET'="")&$$SCREEN^DPTLK1(DFN) Q "*SENSITIVE*" ;"HRN SENSITIVE"
|
|---|
| 33 | I (IRET'="") Q "'"_IRET_"'" ;"HRN:"_"'"_IRET_"'"
|
|---|
| 34 | Q ""
|
|---|
| 35 | ; END VWPT
|
|---|
| 36 | PTINQ(REF,DFN) ; Return formatted pt inquiry report
|
|---|
| 37 | K ^TMP("ORDATA",$J,1)
|
|---|
| 38 | D DGINQ^ORCXPND1(DFN)
|
|---|
| 39 | S REF=$NA(^TMP("ORDATA",$J,1))
|
|---|
| 40 | Q
|
|---|
| 41 | SCDIS(LST,DFN) ; Return service connected % and rated disabilities
|
|---|
| 42 | N VAEL,VAERR,I,ILST,DIS,SC,X
|
|---|
| 43 | D ELIG^VADPT
|
|---|
| 44 | S LST(1)="Service Connected: "_$S(+VAEL(3):$P(VAEL(3),U,2)_"%",1:"NO")
|
|---|
| 45 | I 'VAEL(4),'$P($G(^DG(391,+VAEL(6),0)),U,2) S LST(2)="NOT A VETERAN." Q
|
|---|
| 46 | S I=0,ILST=1 F S I=$O(^DPT(DFN,.372,I)) Q:'I S X=^(I,0) D
|
|---|
| 47 | . S DIS=$P($G(^DIC(31,+X,0)),U) Q:DIS=""
|
|---|
| 48 | . S SC=$S($P(X,U,3):"SC",$P(X,U,3)']"":"not specified",1:"NSC")
|
|---|
| 49 | . S ILST=ILST+1,LST(ILST)=DIS_" ("_$P(X,U,2)_"% "_SC_")"
|
|---|
| 50 | I ILST=1 S LST(2)="Rated Disabilities: NONE STATED"
|
|---|
| 51 | Q
|
|---|
| 52 | SHOW ; temporary - show patient inquiry screen
|
|---|
| 53 | N I,Y,DIC S DIC=2,DIC(0)="AEMQ" D ^DIC Q:'Y
|
|---|
| 54 | K ^TMP("ORDATA",$J,1)
|
|---|
| 55 | D DGINQ^ORCXPND1(+Y)
|
|---|
| 56 | S I=0 F S I=$O(^TMP("ORDATA",$J,1,I)) Q:'I W !,^(I)
|
|---|
| 57 | K ^TMP("ORDATA",$J,1)
|
|---|
| 58 | Q
|
|---|
| 59 | SELCHK(REC,DFN) ; Check for sensitive pt
|
|---|
| 60 | ; SENSITIVE
|
|---|
| 61 | S REC=$$EN1^ORQPT2(DFN)
|
|---|
| 62 | Q
|
|---|
| 63 | DIEDON(VAL,DFN) ; Check for a date of death
|
|---|
| 64 | S VAL=+$G(^DPT(DFN,.35))
|
|---|
| 65 | Q
|
|---|
| 66 | SELECT(REC,DFN) ; Selects patient & returns key information
|
|---|
| 67 | ; 1 2 3 4 5 6 7 8 9 10 11 12
|
|---|
| 68 | ; NAME^SEX^DOB^SSN^LOCIEN^LOCNM^RMBD^CWAD^SENSITIVE^ADMITTED^CONV^SC^
|
|---|
| 69 | ;VWPT HRN , ALTERNATE HRN
|
|---|
| 70 | ; 13 14 15 16 17 18
|
|---|
| 71 | ; SC%^ICN^AGE^TS^HRN^AltHRN
|
|---|
| 72 | ; ;
|
|---|
| 73 | ; ;end vwpt
|
|---|
| 74 | ;
|
|---|
| 75 | ;
|
|---|
| 76 | ; for CCOW (RV - 2/27/03) name="-1", location=error message
|
|---|
| 77 | I '$D(^DPT(DFN,0)) S REC="-1^^^^^Patient is unknown to CPRS." Q
|
|---|
| 78 | ;
|
|---|
| 79 | N X,ID,HRN
|
|---|
| 80 | K ^TMP("ORWPCE",$J) ; delete PCE 'cache' when switching patients
|
|---|
| 81 | D VWPT1^ORWPT2 ;moved code to ORWPT2 to save space
|
|---|
| 82 | S $P(REC,U,15)=$$AGE(DFN,$P(REC,U,3))
|
|---|
| 83 | S $P(REC,U,16)=+$G(^DPT(DFN,.103)) ; treating specialty
|
|---|
| 84 | D VWPT2^ORWPT2
|
|---|
| 85 | Q
|
|---|
| 86 | SHARE(VAL,IP,HWND,DFN) ; Set global to share DFN with other applications
|
|---|
| 87 | K ^TMP("ORWCHART",$J),^TMP("ORECALL",$J),^TMP("ORWORD",$J)
|
|---|
| 88 | K ^TMP("ORWDXMQ",$J)
|
|---|
| 89 | S ^TMP("ORWCHART",$J,IP,HWND)=DFN
|
|---|
| 90 | Q
|
|---|
| 91 | BYWARD(LST,WARD) ; Return a list of patients in a ward
|
|---|
| 92 | N ILST,DFN
|
|---|
| 93 | I +$G(WARD)<1 S LST(1)="^No ward identified" Q
|
|---|
| 94 | S (ILST,DFN)=0
|
|---|
| 95 | S WARD=$P(^DIC(42,WARD,0),"^") ;DBIA #36
|
|---|
| 96 | F S DFN=$O(^DPT("CN",WARD,DFN)) Q:DFN'>0 D
|
|---|
| 97 | . S ILST=ILST+1,LST(ILST)=+DFN_U_$P(^DPT(+DFN,0),U)_U_$G(^DPT(+DFN,.101))
|
|---|
| 98 | I ILST<1 S LST(1)="^No patients found."
|
|---|
| 99 | Q
|
|---|
| 100 | LAST5(LST,ID) ; Return a list of patients matching A9999 identifiers
|
|---|
| 101 | N I,IEN,XREF
|
|---|
| 102 | S (I,IEN)=0,XREF=$S($L(ID)=5:"BS5",1:"BS")
|
|---|
| 103 | F S IEN=$O(^DPT(XREF,ID,IEN)) Q:'IEN D
|
|---|
| 104 | . S I=I+1,LST(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$ID^DGLBPID(IEN) ;$$SSN^DPTLK1(IEN) ; DG249
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | LAST5RPL(LST,ID) ; ; Return list matching A9999 id's, but from RPL only.
|
|---|
| 108 | N ORRPL,ORCNT,ORPT,ORPIEN
|
|---|
| 109 | ; IA ____ allows read access to NEW PERSON file node 101:
|
|---|
| 110 | S ORRPL=$G(^VA(200,DUZ,101))
|
|---|
| 111 | S ORRPL=$P(ORRPL,U,2)
|
|---|
| 112 | I (('ORRPL)!(ORRPL="")) S LST(0)="" Q
|
|---|
| 113 | ;
|
|---|
| 114 | S (ORCNT,ORPT)=0
|
|---|
| 115 | F S ORPT=$O(^OR(100.21,ORRPL,10,ORPT)) Q:'ORPT D
|
|---|
| 116 | .S ORPIEN=+$G(^OR(100.21,ORRPL,10,ORPT,0))
|
|---|
| 117 | .I ((ORPIEN<0)!(ORPIEN="")) Q
|
|---|
| 118 | .S ORCNT=ORCNT+1
|
|---|
| 119 | .S LST(ORCNT)=ORPIEN_U_$P(^DPT(ORPIEN,0),U)_U_$$DOB^DPTLK1(ORPIEN,2)_U_$$ID^DGLBPID(ORPIEN) ;$$SSN^DPTLK1(ORPIEN) ; DG249.
|
|---|
| 120 | ;
|
|---|
| 121 | Q
|
|---|
| 122 | ;
|
|---|
| 123 | FULLSSN(LST,ID) ; Return a list of patients matching full SSN entered
|
|---|
| 124 | N I,IEN
|
|---|
| 125 | S (I,IEN)=0
|
|---|
| 126 | F S IEN=$O(^DPT("SSN",ID,IEN)) Q:'IEN D
|
|---|
| 127 | . S I=I+1,LST(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$ID^DGLBPID(IEN) ;$$SSN^DPTLK1(IEN) ; DG249
|
|---|
| 128 | Q
|
|---|
| 129 | ;
|
|---|
| 130 | FSSNRPL(LST,ID) ; Return list matching Full SSN, but from RPL only.
|
|---|
| 131 | N ORRPL,ORCNT,ORPT,ORLPT,ORPIEN
|
|---|
| 132 | ; IA ____ allows read access to NEW PERSON file node 101:
|
|---|
| 133 | S ORRPL=$G(^VA(200,DUZ,101))
|
|---|
| 134 | S ORRPL=$P(ORRPL,U,2)
|
|---|
| 135 | I (('ORRPL)!(ORRPL="")) S LST(0)="" Q
|
|---|
| 136 | ;
|
|---|
| 137 | S (ORCNT,ORPT)=0
|
|---|
| 138 | F S ORPT=$O(^DPT("SSN",ID,ORPT)) Q:'ORPT D
|
|---|
| 139 | .S ORLPT=0
|
|---|
| 140 | .F S ORLPT=$O(^OR(100.21,ORRPL,10,ORLPT)) Q:'ORLPT D
|
|---|
| 141 | ..S ORPIEN=+$G(^OR(100.21,ORRPL,10,ORLPT,0))
|
|---|
| 142 | ..I ((ORPIEN<0)!(ORPIEN="")) Q
|
|---|
| 143 | ..I (ORPIEN'=ORPT) Q
|
|---|
| 144 | ..S ORCNT=ORCNT+1
|
|---|
| 145 | ..S LST(ORCNT)=ORPIEN_U_$P(^DPT(ORPIEN,0),U)_U_$$DOB^DPTLK1(ORPIEN,2)_U_$$ID^DGLBPID(ORPIEN) ;SSN^DPTLK1(ORPIEN) ; DG249.
|
|---|
| 146 | ;
|
|---|
| 147 | Q
|
|---|
| 148 | ;
|
|---|
| 149 | TOP(LST) ; Return top for all patients list (last selected for now)
|
|---|
| 150 | N IEN
|
|---|
| 151 | S IEN=$G(^DISV(DUZ,"^DPT("))
|
|---|
| 152 | I IEN S LST(1)=IEN_U_$P($G(^DPT(IEN,0)),U)
|
|---|
| 153 | Q
|
|---|
| 154 | ENCTITL(REC,DFN,LOC,PROV) ; Return external values for encounter
|
|---|
| 155 | ; LOCNAME^LOCABBR^ROOMBED^PROVNAME
|
|---|
| 156 | S $P(REC,U,1)=$P($G(^SC(+LOC,0)),U,1,2)
|
|---|
| 157 | S $P(REC,U,3)=$P($G(^DPT(DFN,.101)),U)
|
|---|
| 158 | S $P(REC,U,4)=$P($G(^VA(200,+PROV,0)),U)
|
|---|
| 159 | Q
|
|---|
| 160 | LISTALL(Y,FROM,DIR) ; Return a bolus of patient names. From is either Name or IEN^Name.
|
|---|
| 161 | N I,IEN,CNT,FROMIEN,ORIDNAME S CNT=44,I=0,FROMIEN=0
|
|---|
| 162 | I $P(FROM,U,2)'="" S FROMIEN=$P(FROM,U,1),FROM=$O(^DPT("B",$P(FROM,U,2)),-DIR)
|
|---|
| 163 | F S FROM=$O(^DPT("B",FROM),DIR) Q:FROM="" D Q:I=CNT
|
|---|
| 164 | . S IEN=FROMIEN,FROMIEN=0 F S IEN=$O(^DPT("B",FROM,IEN)) Q:'IEN D Q:I=CNT
|
|---|
| 165 | . . S ORIDNAME=""
|
|---|
| 166 | . . S ORIDNAME=$G(^DPT(IEN,0)) ; Get zero node name.
|
|---|
| 167 | . . ; S X1=$G(^DPT(IEN,.1))_" "_$G(^DPT(IEN,.101))
|
|---|
| 168 | . . S I=I+1 S Y(I)=IEN_U_FROM_U_U_U_U_$P(ORIDNAME,U) ;_"^"_X ; _"^"_X1 ;" ("_X_")"
|
|---|
| 169 | Q
|
|---|
| 170 | APPTLST(LST,DFN) ; return a list of appointments
|
|---|
| 171 | ; APPTTIME^LOCIEN^LOCNAME^EXTSTATUS
|
|---|
| 172 | N ERR,ERRMSG,VASD,VAERR K ^UTILITY("VASD",$J) ;IA 10061
|
|---|
| 173 | S VASD("F")=$$HTFM^XLFDT($H-30,1)
|
|---|
| 174 | S VASD("T")=$$HTFM^XLFDT($H+1,1)_".2359"
|
|---|
| 175 | S VASD("W")="123456789"
|
|---|
| 176 | D SDA^ORQRY01(.ERR,.ERRMSG)
|
|---|
| 177 | I ERR K ^UTILITY("VASD",$J) K LST S LST(1)=ERRMSG Q
|
|---|
| 178 | S I=0 F S I=$O(^UTILITY("VASD",$J,I)) Q:'I D
|
|---|
| 179 | . S LST(I)=$P(^UTILITY("VASD",$J,I,"I"),U,1,2)_U_$P(^("E"),U,2,3)
|
|---|
| 180 | K ^UTILITY("VASD",$J)
|
|---|
| 181 | Q
|
|---|
| 182 | ADMITLST(LST,DFN) ; return a list of admissions
|
|---|
| 183 | ; MOVETIME^LOCIEN^LOCNAME^TYPE
|
|---|
| 184 | N TIM,MOV,X0,Y,MTIM,XTYP,XLOC,HLOC,ILST S ILST=0
|
|---|
| 185 | S TIM="" F S TIM=$O(^DGPM("ATID1",DFN,TIM)) Q:TIM'>0 D
|
|---|
| 186 | . S MOV=0 F S MOV=$O(^DGPM("ATID1",DFN,TIM,MOV)) Q:MOV'>0 D
|
|---|
| 187 | . . N VSTR,TIUDA
|
|---|
| 188 | . . S X0=$G(^DGPM(MOV,0)) I X0']"" Q
|
|---|
| 189 | . . S MTIM=$P(X0,U)
|
|---|
| 190 | . . S XTYP=$P($G(^DG(405.1,+$P(X0,U,4),0)),U,1)
|
|---|
| 191 | . . S XLOC=$P($G(^DIC(42,+$P(X0,U,6),0)),U,1),HLOC=+$G(^(44))
|
|---|
| 192 | . . S VSTR=HLOC_";"_MTIM_";H",TIUDA=$$HASDS^TIULX(DFN,VSTR)
|
|---|
| 193 | . . S ILST=ILST+1,LST(ILST)=MTIM_U_HLOC_U_XLOC_U_XTYP_U_MOV_U_TIUDA
|
|---|
| 194 | Q
|
|---|
| 195 | CLINRNG(LST) ; return date ranges for clinic appointments
|
|---|
| 196 | S LST(1)="T;T^Today"
|
|---|
| 197 | S LST(2)="T+1;T+1^Tomorrow"
|
|---|
| 198 | S LST(3)="T-1;T-1^Yesterday"
|
|---|
| 199 | S LST(4)="T-7;T^Past Week"
|
|---|
| 200 | S LST(5)="T-31;T^Past Month"
|
|---|
| 201 | S LST(6)="S^Specify Date Range..."
|
|---|
| 202 | Q
|
|---|
| 203 | ;
|
|---|
| 204 | N %,%H,X,SUNDAY,START
|
|---|
| 205 | S LST(1)=DT_";"_DT_"^Today",X=$$HTFM^XLFDT($H+1,1)
|
|---|
| 206 | S LST(2)=X_";"_X_"^Tomorrow"
|
|---|
| 207 | S X=+$H F Q:X#7=3 S X=X-1 ; $H#7=3 is Sunday
|
|---|
| 208 | S LST(3)=$$HTFM^XLFDT(X)_";"_$$HTFM^XLFDT(X+6)_"^This Week"
|
|---|
| 209 | S LST(4)=$$HTFM^XLFDT(X+7)_";"_$$HTFM^XLFDT(X+13)_"^Next Week"
|
|---|
| 210 | S LST(5)=$E(DT,1,5)_"01;"_$E(DT,1,5)_"31^This Month"
|
|---|
| 211 | S X=$E(DT,4,5)+1 S:X=13 X=1 S X=$E(DT,1,3)_$TR($J(X,2)," ",0)
|
|---|
| 212 | S LST(6)=X_"01;"_X_"31^Next Month"
|
|---|
| 213 | S LST(7)="^Specify Dates"
|
|---|
| 214 | Q
|
|---|
| 215 | DFLTSRC(VAL) ; return default patient list source (T, W, C, P, S)
|
|---|
| 216 | N SRV S SRV=+$G(^VA(200,DUZ,5))
|
|---|
| 217 | S VAL=$$GET^XPAR("ALL^SRV.`"_SRV,"ORLP DEFAULT LIST SOURCE")
|
|---|
| 218 | Q
|
|---|
| 219 | SAVDFLT(OK,X) ; save new default patient list settings (X=type^ien^sdt;edt)
|
|---|
| 220 | G SAVDFLT^ORWPT1
|
|---|
| 221 | ;
|
|---|
| 222 | DISCHRG(Y,DFN,ADMITDT) ; Get discharge movement information
|
|---|
| 223 | N VAIP
|
|---|
| 224 | I +$G(ADMITDT)=0 S Y=DT Q
|
|---|
| 225 | S VAIP("D")=ADMITDT D 52^VADPT
|
|---|
| 226 | I +VAIP(17)=0 S Y=DT Q
|
|---|
| 227 | S Y=+VAIP(17,1)
|
|---|
| 228 | Q
|
|---|
| 229 | CWAD(Y,DFN) ; returns CWAD flags for a patient
|
|---|
| 230 | S Y=$$CWAD^ORQPT2(DFN)
|
|---|
| 231 | Q
|
|---|
| 232 | LEGACY(ORLST,DFN) ; return message if data on the legacy system
|
|---|
| 233 | ; ORLST(0)=1 if data, ORLST(n)=display message if data
|
|---|
| 234 | S ORLST(0)=0
|
|---|
| 235 | I $L($T(HXDATA^A7RDPAGU)) D
|
|---|
| 236 | . D HXDATA^A7RDPAGU(.ORLST,DFN)
|
|---|
| 237 | . I $O(ORLST(0)) S ORLST(0)=1
|
|---|
| 238 | Q
|
|---|
| 239 | INPLOC(REC,DFN) ; Return a patient's current location
|
|---|
| 240 | N X
|
|---|
| 241 | S X=$G(^DPT(DFN,.102)),REC=0
|
|---|
| 242 | I X S X=$P($G(^DGPM(X,0)),U,6)
|
|---|
| 243 | I X S REC=+$G(^DIC(42,X,44))
|
|---|
| 244 | I X S $P(REC,U,2)=$P($G(^DIC(42,X,0)),U,1)
|
|---|
| 245 | I X S X=$P($G(^DIC(42,X,0)),U,3)
|
|---|
| 246 | S $P(REC,U,3)=X
|
|---|
| 247 | Q
|
|---|
| 248 | AGE(DFN,BEG) ; returns age based on date of birth and date of death (or DT)
|
|---|
| 249 | N END,X
|
|---|
| 250 | S END=+$G(^DPT(DFN,.35)),END=$S(END:END,1:DT)
|
|---|
| 251 | S X=$E(END,1,3)-$E(BEG,1,3)-($E(END,4,7)<$E(BEG,4,7))
|
|---|
| 252 | Q X
|
|---|
| 253 | ROK(X) ; Routine OK (in UCI) (NDBI)
|
|---|
| 254 | S X=$G(X) Q:'$L(X) 0 Q:$L(X)>8 0 X ^%ZOSF("TEST") Q:$T 1 Q 0
|
|---|
| 255 | ;
|
|---|
| 256 | ;NDBI(X) ; National Database Integration site 1 = yes 0 = no
|
|---|
| 257 | ; N R,G S X="A7RDUP" X ^%ZOSF("TEST") S R=$T,G=$S($D(^A7RCP):1,1:0),X=R+G,X=$S(X=2:1,1:0) Q X
|
|---|
| 258 | ;
|
|---|
