| 1 | DGWPT ; SLC/KCM/REV - Patient Lookup Functions ;3/20/02
|
|---|
| 2 | ;;5.3;Registration;**447**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | SELCHK(REC,DFN) ; Check for sensitive pt
|
|---|
| 5 | ; SENSITIVE
|
|---|
| 6 | S REC=$$EN1^DGQPT2(DFN)
|
|---|
| 7 | Q
|
|---|
| 8 | DIEDON(VAL,DFN) ; Check for a date of death
|
|---|
| 9 | S VAL=+$G(^DPT(DFN,.35))
|
|---|
| 10 | Q
|
|---|
| 11 | BYWARD(LST,WARD) ; Return a list of patients in a ward
|
|---|
| 12 | N ILST,DFN
|
|---|
| 13 | I +$G(WARD)<1 S LST(1)="^No ward identified" Q
|
|---|
| 14 | S (ILST,DFN)=0
|
|---|
| 15 | S WARD=$P(^DIC(42,WARD,0),"^") ;DBIA #36
|
|---|
| 16 | F S DFN=$O(^DPT("CN",WARD,DFN)) Q:DFN'>0 D
|
|---|
| 17 | . S ILST=ILST+1,LST(ILST)=+DFN_U_$P(^DPT(+DFN,0),U)_U_$G(^DPT(+DFN,.101))
|
|---|
| 18 | I ILST<1 S LST(1)="^No patients found."
|
|---|
| 19 | Q
|
|---|
| 20 | TOP(LST) ; Return top for all patients list (last selected for now)
|
|---|
| 21 | N IEN
|
|---|
| 22 | S IEN=$G(^DISV(DUZ,"^DPT("))
|
|---|
| 23 | I IEN S LST(1)=IEN_U_$P($G(^DPT(IEN,0)),U)
|
|---|
| 24 | Q
|
|---|
| 25 | CLINRNG(LST) ; return date ranges for clinic appointments
|
|---|
| 26 | S LST(1)="T;T^Today"
|
|---|
| 27 | S LST(2)="T+1;T+1^Tomorrow"
|
|---|
| 28 | S LST(3)="T-1;T-1^Yesterday"
|
|---|
| 29 | S LST(4)="T-7;T^Past Week"
|
|---|
| 30 | S LST(5)="T-31;T^Past Month"
|
|---|
| 31 | S LST(6)="S^Specify Date Range..."
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | N %,%H,X,SUNDAY,START
|
|---|
| 35 | S LST(1)=DT_";"_DT_"^Today",X=$$HTFM^XLFDT($H+1,1)
|
|---|
| 36 | S LST(2)=X_";"_X_"^Tomorrow"
|
|---|
| 37 | S X=+$H F Q:X#7=3 S X=X-1 ; $H#7=3 is Sunday
|
|---|
| 38 | S LST(3)=$$HTFM^XLFDT(X)_";"_$$HTFM^XLFDT(X+6)_"^This Week"
|
|---|
| 39 | S LST(4)=$$HTFM^XLFDT(X+7)_";"_$$HTFM^XLFDT(X+13)_"^Next Week"
|
|---|
| 40 | S LST(5)=$E(DT,1,5)_"01;"_$E(DT,1,5)_"31^This Month"
|
|---|
| 41 | S X=$E(DT,4,5)+1 S:X=13 X=1 S X=$E(DT,1,3)_$TR($J(X,2)," ",0)
|
|---|
| 42 | S LST(6)=X_"01;"_X_"31^Next Month"
|
|---|
| 43 | S LST(7)="^Specify Dates"
|
|---|
| 44 | Q
|
|---|
| 45 | DFLTSRC(VAL) ; return default patient list source (T, W, C, P, S)
|
|---|
| 46 | N SRV S SRV=+$G(^VA(200,DUZ,5))
|
|---|
| 47 | S VAL=$$GET^XPAR("ALL^SRV.`"_SRV,"ORLP DEFAULT LIST SOURCE")
|
|---|
| 48 | Q
|
|---|
| 49 | SAVDFLT(OK,X) ; save new default patient list settings (X=type^ien^sdt;edt)
|
|---|
| 50 | G SAVDFLT^DGWPT1
|
|---|
| 51 | ;
|
|---|
| 52 | SELECT(REC,DFN) ; Selects patient & returns key information
|
|---|
| 53 | ; 1 2 3 4 5 6 7 8 9 10 11 12
|
|---|
| 54 | ; NAME^SEX^DOB^SSN^LOCIEN^LOCNM^RMBD^CWAD^SENSITIVE^ADMITTED^CONV^SC^
|
|---|
| 55 | ; 13 14 15 16
|
|---|
| 56 | ; SC%^ICN^AGE^TS
|
|---|
| 57 | N X
|
|---|
| 58 | K ^TMP("DGWPCE",$J) ; delete PCE 'cache' when switching patients
|
|---|
| 59 | S X=^DPT(DFN,0),REC=$P(X,U,1,3)_U_$P(X,U,9)_U_U_$G(^(.1))_U_$G(^(.101))
|
|---|
| 60 | S X=$P(REC,U,6) I $L(X) S $P(REC,U,5)=+$G(^DIC(42,+$O(^DIC(42,"B",X,0)),44))
|
|---|
| 61 | S $P(REC,U,8)=$$CWAD^DGQPT2(DFN)_U_$$EN1^DGQPT2(DFN)
|
|---|
| 62 | ; I $P(REC,U,9) D EN2^DGQPT2(DFN) ;update DG security log ; DG249
|
|---|
| 63 | S X=$G(^DPT(DFN,.105)) I X S $P(REC,U,10)=$P($G(^DGPM(X,0)),U)
|
|---|
| 64 | S:'$D(IOST) IOST="P-OTHER"
|
|---|
| 65 | S $P(REC,U,11)=$$OTF^OR3CONV(DFN,1)
|
|---|
| 66 | D ELIG^VADPT S $P(REC,U,12)=$G(VAEL(3)) ;two pieces: SC^SC%
|
|---|
| 67 | I $L($T(GETICN^MPIF001)) S X=+$$GETICN^MPIF001(DFN) S:X>0 $P(REC,U,14)=X
|
|---|
| 68 | S $P(REC,U,15)=$$AGE(DFN,$P(REC,U,3))
|
|---|
| 69 | S $P(REC,U,16)=+$G(^DPT(DFN,.103)) ; treating specialty
|
|---|
| 70 | K VAEL,VAERR ;VADPT call to kill?
|
|---|
| 71 | S ^DISV(DUZ,"^DPT(")=DFN
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | AGE(DFN,BEG) ; returns age based on date of birth and date of death (or DT)
|
|---|
| 75 | N END,X
|
|---|
| 76 | S END=+$G(^DPT(DFN,.35)),END=$S(END:END,1:DT)
|
|---|
| 77 | S X=$E(END,1,3)-$E(BEG,1,3)-($E(END,4,7)<$E(BEG,4,7))
|
|---|
| 78 | Q X
|
|---|
