source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQPTQ2.m@ 1619

Last change on this file since 1619 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.1 KB
Line 
1ORQPTQ2 ; 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 ;
7CLIN(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 ;
15CLINPTS(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 ;
61CDATRANG(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
69PTAPPTS(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
98PROV(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
105PROVPTS(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
112SPEC(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
118SPECPTS(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
125WARD(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
133WARDPTS(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
155NLIST(ORQY) ; return a null list
156 S ORQY(1)=""
157 Q
Note: See TracBrowser for help on using the repository browser.