Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGWPT

DGWPT.m

Go to the documentation of this file.
  1. DGWPT ; SLC/KCM/REV - Patient Lookup Functions ;3/20/02
  1. ;;5.3;Registration;**447,796**;Aug 13, 1993;Build 6
  1. ;
  1. SELCHK(REC,DFN) ; Check for sensitive pt
  1. ; SENSITIVE
  1. S REC=$$EN1^DGQPT2(DFN)
  1. Q
  1. DIEDON(VAL,DFN) ; Check for a date of death
  1. S VAL=+$G(^DPT(DFN,.35))
  1. Q
  1. BYWARD(LST,WARD) ; Return a list of patients in a ward
  1. N ILST,DFN
  1. I +$G(WARD)<1 S LST(1)="^No ward identified" Q
  1. S (ILST,DFN)=0
  1. S WARD=$P(^DIC(42,WARD,0),"^") ;DBIA #36
  1. F S DFN=$O(^DPT("CN",WARD,DFN)) Q:DFN'>0 D
  1. . S ILST=ILST+1,LST(ILST)=+DFN_U_$P(^DPT(+DFN,0),U)_U_$G(^DPT(+DFN,.101))
  1. I ILST<1 S LST(1)="^No patients found."
  1. Q
  1. TOP(LST) ; Return top for all patients list (last selected for now)
  1. N IEN
  1. S IEN=$G(^DISV(DUZ,"^DPT("))
  1. I IEN S LST(1)=IEN_U_$P($G(^DPT(IEN,0)),U)
  1. Q
  1. CLINRNG(LST) ; return date ranges for clinic appointments
  1. S LST(1)="T;T^Today"
  1. S LST(2)="T+1;T+1^Tomorrow"
  1. S LST(3)="T-1;T-1^Yesterday"
  1. S LST(4)="T-7;T^Past Week"
  1. S LST(5)="T-31;T^Past Month"
  1. S LST(6)="S^Specify Date Range..."
  1. Q
  1. ;
  1. N %,%H,X,SUNDAY,START
  1. S LST(1)=DT_";"_DT_"^Today",X=$$HTFM^XLFDT($H+1,1)
  1. S LST(2)=X_";"_X_"^Tomorrow"
  1. S X=+$H F Q:X#7=3 S X=X-1 ; $H#7=3 is Sunday
  1. S LST(3)=$$HTFM^XLFDT(X)_";"_$$HTFM^XLFDT(X+6)_"^This Week"
  1. S LST(4)=$$HTFM^XLFDT(X+7)_";"_$$HTFM^XLFDT(X+13)_"^Next Week"
  1. S LST(5)=$E(DT,1,5)_"01;"_$E(DT,1,5)_"31^This Month"
  1. S X=$E(DT,4,5)+1 S:X=13 X=1 S X=$E(DT,1,3)_$TR($J(X,2)," ",0)
  1. S LST(6)=X_"01;"_X_"31^Next Month"
  1. S LST(7)="^Specify Dates"
  1. Q
  1. DFLTSRC(VAL) ; return default patient list source (T, W, C, P, S)
  1. N SRV S SRV=+$G(^VA(200,DUZ,5))
  1. S VAL=$$GET^XPAR("ALL^SRV.`"_SRV,"ORLP DEFAULT LIST SOURCE")
  1. Q
  1. SAVDFLT(OK,X) ; save new default patient list settings (X=type^ien^sdt;edt)
  1. G SAVDFLT^DGWPT1
  1. ;
  1. SELECT(REC,DFN) ; Selects patient & returns key information
  1. ; 1 2 3 4 5 6 7 8 9 10 11 12
  1. ; NAME^SEX^DOB^SSN^LOCIEN^LOCNM^RMBD^CWAD^SENSITIVE^ADMITTED^CONV^SC^
  1. ; 13 14 15 16
  1. ; SC%^ICN^AGE^TS
  1. N X
  1. K ^TMP("DGWPCE",$J) ; delete PCE 'cache' when switching patients
  1. S X=^DPT(DFN,0),REC=$P(X,U,1,3)_U_$P(X,U,9)_U_U_$G(^(.1))_U_$G(^(.101))
  1. S X=$P(REC,U,6) I $L(X) S $P(REC,U,5)=+$G(^DIC(42,+$O(^DIC(42,"B",X,0)),44))
  1. S $P(REC,U,8)=$$CWAD^DGQPT2(DFN)_U_$$EN1^DGQPT2(DFN)
  1. ; I $P(REC,U,9) D EN2^DGQPT2(DFN) ;update DG security log ; DG249
  1. S X=$G(^DPT(DFN,.105)) I X S $P(REC,U,10)=$P($G(^DGPM(X,0)),U)
  1. S:'$D(IOST) IOST="P-OTHER"
  1. S $P(REC,U,11)=0
  1. D ELIG^VADPT S $P(REC,U,12)=$G(VAEL(3)) ;two pieces: SC^SC%
  1. I $L($T(GETICN^MPIF001)) S X=+$$GETICN^MPIF001(DFN) S:X>0 $P(REC,U,14)=X
  1. S $P(REC,U,15)=$$AGE(DFN,$P(REC,U,3))
  1. S $P(REC,U,16)=+$G(^DPT(DFN,.103)) ; treating specialty
  1. K VAEL,VAERR ;VADPT call to kill?
  1. S ^DISV(DUZ,"^DPT(")=DFN
  1. Q
  1. ;
  1. AGE(DFN,BEG) ; returns age based on date of birth and date of death (or DT)
  1. N END,X
  1. S END=+$G(^DPT(DFN,.35)),END=$S(END:END,1:DT)
  1. S X=$E(END,1,3)-$E(BEG,1,3)-($E(END,4,7)<$E(BEG,4,7))
  1. Q X