1 | ORQPTQ2 ; slc/CLA - Functions which return patient lists and list sources pt 2 ;3/14/05 10:50
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,10,85,187,190,195,215**;Dec 17, 1997
|
---|
3 | ;
|
---|
4 | ; Ref. to ^UTILITY via IA 10061
|
---|
5 | ; DBIA 3869 GETPLIST^SDAMA202 ^TMP($J,"SDAMA202")
|
---|
6 | ;
|
---|
7 | CLIN(Y) ; RETURN LIST OF CLINICS
|
---|
8 | N ORLST,IEN,I
|
---|
9 | D GETLST^XPAR(.ORLST,"ALL","ORWD COMMON CLINIC")
|
---|
10 | S I=0 F S I=$O(ORLST(I)) Q:'I D
|
---|
11 | . S IEN=$P(ORLST(I),U,2) I $$ACTLOC^ORWU(IEN)=1 D
|
---|
12 | .. S Y(I)=IEN_U_$P(^SC(IEN,0),U,1)
|
---|
13 | Q
|
---|
14 | ;
|
---|
15 | CLINPTS(Y,CLIN,ORBDATE,OREDATE) ; RETURN LIST OF PTS W/CLINIC APPT W/IN BEGINNING AND END DATES
|
---|
16 | ; PKS-8/2003: Modified for new scheduling pkg APIs.
|
---|
17 | I +$G(CLIN)<1 S Y(1)="^No clinic identified" Q
|
---|
18 | I $$ACTLOC^ORWU(CLIN)'=1 S Y(1)="^Clinic is inactive or Occasion Of Service" Q
|
---|
19 | N DFN,NAME,I,J,X,ORJ,ORSRV,ORNOWDT,CHKX,CHKIN,MAXAPPTS,ORC,CLNAM,ORFLDS,ORCLIN,ORRESULT,ORSTART,OREND,ORSTAT,ORASTAT,ORERR,ORI,ORPT,ORPTSTAT,ORMAX,ORHOLD
|
---|
20 | S MAXAPPTS=200
|
---|
21 | S ORNOWDT=$$NOW^XLFDT
|
---|
22 | S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
|
---|
23 | S DFN=0,I=1
|
---|
24 | I ORBDATE="" S ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
|
---|
25 | I OREDATE="" S OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
|
---|
26 | ;
|
---|
27 | ; Convert ORBDATE, OREDATE to FM Date/Time:
|
---|
28 | D DT^DILF("T",ORBDATE,.ORBDATE,"","")
|
---|
29 | D DT^DILF("T",OREDATE,.OREDATE,"","")
|
---|
30 | I (ORBDATE=-1)!(OREDATE=-1) S Y(1)="^Error in date range." Q
|
---|
31 | S OREDATE=$P(OREDATE,".")_.5 ; Add 1/2 day to end date.
|
---|
32 | ; IA# 3869:
|
---|
33 | K ^TMP($J,"SDAMA202","GETPLIST") ; Clean house before starting.
|
---|
34 | S ORRESULT=""
|
---|
35 | S ORCLIN=+CLIN,ORFLDS="1;3;4;12",ORASTAT="R;NT",ORSTART=ORBDATE,OREND=OREDATE,ORSTAT="" ; Assign parameters.
|
---|
36 | ; ORFLDS: 1;3;4;12 = ApptDateTime;ApptStatus;IEN^PtName;PtStatus.
|
---|
37 | D GETPLIST^SDAMA202(ORCLIN,ORFLDS,ORASTAT,ORSTART,OREND,.ORRESULT,ORSTAT) ; DBIA 3869.
|
---|
38 | ;
|
---|
39 | ; Deal with server errors:
|
---|
40 | S ORERR=$$CLINERR^ORQRY01
|
---|
41 | I $L(ORERR) S Y(1)=U_ORERR Q
|
---|
42 | ;
|
---|
43 | ; Reassign ^TMP array to local array:
|
---|
44 | S (ORPT,ORI)=0,ORMAX=MAXAPPTS
|
---|
45 | I ORRESULT'>0 S Y(1)="^No appointments." Q
|
---|
46 | F S ORPT=$O(^TMP($J,"SDAMA202","GETPLIST",ORPT)) Q:ORPT=""!(ORI>ORMAX) D ;DBIA 3869
|
---|
47 | .S ORI=ORI+1
|
---|
48 | .S Y(ORI)=$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,4)) ; IEN^Name.
|
---|
49 | .S Y(ORI)=Y(ORI)_U_ORCLIN ; ^Clinic IEN.
|
---|
50 | .S Y(ORI)=Y(ORI)_U_$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,1)) ; App't.
|
---|
51 | .S ORPTSTAT=$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,12)) ; Pt Status.
|
---|
52 | .S ORPTSTAT=$S(ORPTSTAT="I":"IPT",ORPTSTAT="O":"OPT",1:"")
|
---|
53 | .S ORHOLD=$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,3)) ; Appt Status.
|
---|
54 | .I ORPTSTAT=""&(ORHOLD="NT") S ORPTSTAT="NT" ; "No Action Taken."
|
---|
55 | .S Y(ORI)=Y(ORI)_U_U_U_U_U_ORPTSTAT ; Pt I or O status (or "NT").
|
---|
56 | ;
|
---|
57 | K ^TMP($J,"SDAMA202","GETPLIST") ; Clean house after finishing.
|
---|
58 | ;
|
---|
59 | Q
|
---|
60 | ;
|
---|
61 | CDATRANG(ORY) ; return default start and stop dates for clinics in form start^stop
|
---|
62 | N ORBDATE,OREDATE,ORSRV
|
---|
63 | S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
|
---|
64 | S ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
|
---|
65 | S OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
|
---|
66 | S ORBDATE=$S($L($G(ORBDATE)):ORBDATE,1:""),OREDATE=$S($L($G(OREDATE)):OREDATE,1:"")
|
---|
67 | S ORY=$$UP^XLFSTR(ORBDATE)_"^"_$$UP^XLFSTR(OREDATE)
|
---|
68 | Q
|
---|
69 | PTAPPTS(Y,DFN,ORBDATE,OREDATE,CLIN) ; return appts for a patient between beginning and end dates for a clinic, if no clinic return all appointments
|
---|
70 | ;I +$G(CLIN)<1 S Y(1)="^No clinic identified" Q
|
---|
71 | I +$G(CLIN)>0,$$ACTLOC^ORWU(CLIN)'=1 S Y(1)="^Clinic is inactive or Occasion Of Service" Q
|
---|
72 | N ERR,ERRMSG,VASD,NUM,CNT,INVDT,INT,EXT,ORSRV,VAERR K ^UTILITY("VASD",$J) S NUM=0,CNT=1 ;IA 10061
|
---|
73 | I (ORBDATE="")!(OREDATE="") D ;get user's service and set up entities:
|
---|
74 | .S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
|
---|
75 | I ORBDATE="" D
|
---|
76 | .I '$L(CLIN) S ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQEAPT ENC APPT START",1,"E"))
|
---|
77 | .S:ORBDATE="" ORBDATE="T" ;default start date across all clinics is today
|
---|
78 | I OREDATE="" D
|
---|
79 | .I '$L(CLIN) S OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQEAPT ENC APPT STOP",1,"E"))
|
---|
80 | .S:OREDATE="" OREDATE="T" ;default end date across all clinics is today
|
---|
81 | ;CONVERT ORBDATE AND OREDATE INTO FILEMAN DATE/TIME
|
---|
82 | D DT^DILF("T",ORBDATE,.ORBDATE,"","")
|
---|
83 | D DT^DILF("T",OREDATE,.OREDATE,"","")
|
---|
84 | I (ORBDATE=-1)!(OREDATE=-1) S Y(1)="^Error in date range." Q
|
---|
85 | S VASD("F")=ORBDATE
|
---|
86 | S VASD("T")=$P(OREDATE,".")_.5 ;ADD 1/2 DAY TO END DATE
|
---|
87 | I $L($G(CLIN)) S VASD("C",CLIN)=""
|
---|
88 | D SDA^ORQRY01(.ERR,.ERRMSG)
|
---|
89 | I ERR K ^UTILITY("VASD",$J) S Y(1)=ERRMSG Q
|
---|
90 | F S NUM=$O(^UTILITY("VASD",$J,NUM)) Q:'NUM D
|
---|
91 | .S INT=^UTILITY("VASD",$J,NUM,"I"),INVDT=9999999-$P(INT,U)
|
---|
92 | .S EXT=^UTILITY("VASD",$J,NUM,"E")
|
---|
93 | .S Y(CNT)=$P(INT,U)_U_$P(EXT,U,2)_U_$P(EXT,U,3)_U_$P(EXT,U,4)_U_INVDT
|
---|
94 | .S CNT=CNT+1
|
---|
95 | S:+$G(Y(1))<1 Y(1)="^No appointments."
|
---|
96 | K ^UTILITY("VASD",$J)
|
---|
97 | Q
|
---|
98 | PROV(Y) ; RETURN LIST OF PROVIDERS
|
---|
99 | N I,IEN,NAME,TDATE
|
---|
100 | S I=1,NAME=""
|
---|
101 | F S NAME=$O(^VA(200,"B",NAME)) Q:NAME="" S IEN=0,IEN=$O(^(NAME,IEN)) D
|
---|
102 | .Q:$E(NAME)="*"
|
---|
103 | .I $D(^XUSEC("PROVIDER",IEN)),$$ACTIVE^XUSER(IEN) S Y(I)=IEN_"^"_NAME,I=I+1
|
---|
104 | Q
|
---|
105 | PROVPTS(Y,PROV) ; RETURN LIST OF PATIENTS LINKED TO A PRIMARY PROVIDER
|
---|
106 | I +$G(PROV)<1 S Y(1)="^No provider identified" Q
|
---|
107 | N ORI,DFN
|
---|
108 | S ORI=1,DFN=0
|
---|
109 | F S DFN=$O(^DPT("APR",PROV,DFN)) Q:DFN'>0 S Y(ORI)=+DFN_"^"_$P(^DPT(+DFN,0),"^"),ORI=ORI+1
|
---|
110 | S:+$G(Y(1))<1 Y(1)="^No patients found."
|
---|
111 | Q
|
---|
112 | SPEC(Y) ; RETURN LIST OF TREATING SPECIALTIES
|
---|
113 | N I,NAME,IEN
|
---|
114 | S I=1,NAME=""
|
---|
115 | ;access to DIC(45.7 global granted under DBIA #519:
|
---|
116 | F S NAME=$O(^DIC(45.7,"B",NAME)) Q:NAME="" S IEN=0,IEN=$O(^(NAME,IEN)) I $$ACTIVE^DGACT(45.7,IEN) S Y(I)=IEN_"^"_NAME,I=I+1
|
---|
117 | Q
|
---|
118 | SPECPTS(Y,SPEC) ; RETURN LIST OF PATIENTS LINKED TO A TREATING SPECIALTY
|
---|
119 | I +$G(SPEC)<1 S Y(1)="^No specialty identified" Q
|
---|
120 | N ORI,DFN
|
---|
121 | S ORI=1,DFN=0
|
---|
122 | F S DFN=$O(^DPT("ATR",SPEC,DFN)) Q:DFN'>0 S Y(ORI)=+DFN_"^"_$P(^DPT(+DFN,0),"^"),ORI=ORI+1
|
---|
123 | S:+$G(Y(1))<1 Y(1)="^No patients found."
|
---|
124 | Q
|
---|
125 | WARD(Y) ; RETURN LIST OF ACTIVE WARDS
|
---|
126 | N I,IEN,NAME,D0
|
---|
127 | S I=1,NAME=""
|
---|
128 | ;access to DIC(42 global granted under DBIA #36:
|
---|
129 | F S NAME=$O(^DIC(42,"B",NAME)) Q:NAME="" S IEN=$O(^(NAME,0)) D
|
---|
130 | . S D0=IEN D WIN^DGPMDDCF
|
---|
131 | . I X=0 S Y(I)=IEN_"^"_NAME,I=I+1
|
---|
132 | Q
|
---|
133 | WARDPTS(Y,WARD) ; RETURN LIST OF PATIENTS IN A WARD
|
---|
134 | ; SLC/PKS - Modifications for Room/Bed data on 1/19/2001.
|
---|
135 | I +$G(WARD)<1 S Y(1)="^No ward identified" Q
|
---|
136 | N ORI,DFN,RBDAT
|
---|
137 | S ORI=1,DFN=0
|
---|
138 | ; Access to DIC(42 global granted under DBIA #36:
|
---|
139 | S WARD=$P(^DIC(42,WARD,0),"^") ;GET WARD NAME FOR "CN" LOOKUP
|
---|
140 | ; Next section modified 1/19/2001 by PKS:
|
---|
141 | F D Q:DFN'>0
|
---|
142 | .S DFN=$O(^DPT("CN",WARD,DFN)) Q:DFN'>0
|
---|
143 | .S Y(ORI)=+DFN_"^"_$P(^DPT(+DFN,0),"^")
|
---|
144 | .S RBDAT=""
|
---|
145 | .; Add patient room/bed information where data exists:
|
---|
146 | .S RBDAT=$P($G(^DPT(+DFN,.101)),U)
|
---|
147 | .I RBDAT'="" D ; Any R/B data?
|
---|
148 | ..I $L(RBDAT)<4 S RBDAT=RBDAT_" " ; Add if < 4 chars.
|
---|
149 | ..S RBDAT=$E(RBDAT,1,4) ; Get first 4 only.
|
---|
150 | .S Y(ORI)=Y(ORI)_U_RBDAT ; Add R/B to string
|
---|
151 | .S ORI=ORI+1 ; Increment counter.
|
---|
152 | ;
|
---|
153 | S:+$G(Y(1))<1 Y(1)="^No patients found."
|
---|
154 | Q
|
---|
155 | NLIST(ORQY) ; return a null list
|
---|
156 | S ORQY(1)=""
|
---|
157 | Q
|
---|