source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDVWTEST.m@ 1639

Last change on this file since 1639 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 8.4 KB
RevLine 
[613]1SDVWTEST ; VWSD VOE SDAPI AND MAKE APPOINTMENT Test Exercises
2 ;;5.3;Scheduling;**502**;Aug 13, 1993 ;Build 14
3 ; Copyright (C) 2007 WorldVistA
4 ;
5 ; This program is free software; you can redistribute it and/or modify
6 ; it under the terms of the GNU General Public License as published by
7 ; the Free Software Foundation; either version 2 of the License, or
8 ; (at your option) any later version.
9 ;
10 ; This program is distributed in the hope that it will be useful,
11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ; GNU General Public License for more details.
14 ;
15 ; You should have received a copy of the GNU General Public License
16 ; along with this program; if not, write to the Free Software
17 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
18 ;
19EN1 N SDARRAY,SDCOUNT,SDDFN,SDDATE,SDAPPT,SDPAT,SDPATNAM,SDSTATUS
20 N SDDATEP
21 S SDARRAY(1)="3061106;3061109"
22 S SDARRAY(2)=6 ;"VWVOE RADIOLOGY CLINIC"
23 S SDARRAY("FLDS")="4;3"
24 S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
25 I SDCOUNT>0 D
26 . ;get patient
27 . S SDDFN=0 F S SDDFN=$O(^TMP($J,"SDAMA301",6,SDDFN)) Q:SDDFN="" D
28 .. ;get appointment date/time
29 .. S SDDATE=0
30 ..F S SDDATE=$O(^TMP($J,"SDAMA301",6,SDDFN,SDDATE)) Q:SDDATE="" D
31 ...S SDAPPT=$G(^TMP($J,"SDAMA301",6,SDDFN,SDDATE)) ;appointment data
32 ...S SDSTATUS=$P($G(SDAPPT),"^",3) ;appointment status
33 ...S SDPAT=$P($G(SDAPPT),"^",4) ;patient DFN and Name
34 ...S SDPATNAM=$P($G(SDPAT),";",2) ;patient Name only
35 ...;continue processing this appointment as needed
36 ...S Y=SDDATE X ^DD("DD") S SDDATEP=Y
37 ...W !,"RADIOLOGY CLINIC ","PATIENT: ",SDPATNAM," DATE/TIME: ",SDDATEP," STATUS=",SDSTATUS
38 I SDCOUNT<0 D
39 . W !,"SDCOUNT=",SDCOUNT ; do processing for errors 101 and 116
40 ; when finished with all processing, kill the output array
41 I SDCOUNT'=0 K ^TMP($J,"SDAMA301")
42 Q
43EN2 ;
44 N SDARRAY,SDCOUNT,SDCLIEN,SDDATE,SDAPPT,SDSTATUS,SDCLINFO,SDCLNAME
45 N SDDATEP
46 S SDARRAY(1)="3061105;3061114"
47 S SDARRAY(3)="R;I"
48 S SDARRAY(4)=1 ;ZZ PATIENT,TEST ONE
49 S SDARRAY("MAX")=3
50 S SDARRAY("FLDS")="1;2;3"
51 S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
52 I SDCOUNT>0 D
53 . ;get clinic
54 . S SDCLIEN=0 F S SDCLIEN=$O(^TMP($J,"SDAMA301",1,SDCLIEN)) Q:SDCLIEN="" D
55 .. ;get appointment date/time
56 .. S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",1,SDCLIEN,SDDATE)) Q:SDDATE="" D
57 ... S SDAPPT=$G(^TMP($J,"SDAMA301",1,SDCLIEN,SDDATE)) ;appointment data
58 ... S SDSTATUS=$P(SDAPPT,"^",3) ;appt status
59 ... S SDCLINFO=$P(SDAPPT,"^",2) ;clinic IEN and Name
60 ... S SDCLNAME=$P(SDCLINFO,";",2) ;clinic Name only
61 ... S Y=SDDATE X ^DD("DD") S SDDATEP=Y
62 ... ;continue processing this appointment as needed
63 ... W !,"ZZ PATIENT,TEST ONE ","CLINIC: ",SDCLNAME," DATE/TIME: ",SDDATEP," STATUS=",SDSTATUS
64 I SDCOUNT<0 D
65 .W !,"SDCOUNT=",SDCOUNT ; ;do processing for errors 101 and 116
66 ; when finished with all processing, kill output array
67 I SDCOUNT'=0 K ^TMP($J,"SDAMA301")
68 Q
69EN3 ;
70 N SDARRAY,SDCOUNT,SDDATE,SDAPPT,SDCRSTOP
71 N SDATEP,SDCREDIN,SDCREDIT
72 S SDARRAY(1)="3061101;3061130"
73 S SDARRAY(2)=3 ;VWVOE DR. PHYSICIAN CLINIC
74 S SDARRAY(4)=1 ;ZZ PATIENT,TEST ONE
75 S SDARRAY("FLDS")="1;14;16"
76 S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
77 I SDCOUNT>0 D
78 . ; GET APPOINTMENT DATA
79 . S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",1,3,SDDATE)) Q:SDDATE="" D
80 .. S SDAPPT=$G(^TMP($J,"SDAMA301",1,3,SDDATE)) ;appointment data
81 .. S SDCREDIT=$P(SDAPPT,"^",14) ;credit stop code IEN
82 .. S SDCREDIT=$P(SDCREDIT,";",1)
83 .. S SDCREDIN=$P($G(^DIC(40.7,SDCREDIT,0)),"^",1)
84 .. I $G(SDCREDIT)'=";" S SDCRIEN=$P(SDCREDIT,";",1) ;credit stop code IEN only
85 .. S Y=SDDATE X ^DD("DD") S SDDATEP=Y
86 .. W !,"ZZ PATIENT,TEST ONE ","CLINIC: ","VWVOE DR. PHYSICIAN CLINIC"," DATE/TIME: ",SDDATEP," CREDIT STOP=",SDCREDIN
87 .. ;continue processing this appointment as needed
88 I SDCOUNT<0 D
89 . W !,"SDCOUNT=",SDCOUNT ; ;do processing for errors 101 and 116
90 ; when finished with all processing, kill output array
91 I SDCOUNT'=0 K ^TMP($J,"SDAMA301")
92 Q
93EN4 ;
94 N SDARRAY,SDCOUNT,SDCLIEN,SDDFN,SDDATE,SDAPPT,SDSTATUS
95 N SDATEP,SDCREDIN,SDCREDIT
96 S SDARRAY(1)="3061101;3061130"
97 S SDARRAY(13)=323
98 S SDARRAY("FLDS")="3;13;16"
99 S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
100 I SDCOUNT>0 D
101 . ;get clinic
102 . S SDCLIEN=0 F S SDCLIEN=$O(^TMP($J,"SDAMA301",SDCLIEN)) Q:SDCLIEN="" D
103 .. ;get patient
104 .. S SDDFN=0 F S SDDFN=$O(^TMP($J,"SDAMA301",SDCLIEN,SDDFN)) Q:SDDFN="" D
105 ... ;get appointment date/time
106 ... S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",SDCLIEN,SDDFN,SDDATE)) Q:SDDATE="" D
107 ....S SDSTATUS=$P($G(^TMP($J,"SDAMA301",SDCLIEN,SDDFN,SDDATE)),"^",3) ;appointment status
108 ....S SDAPPT=$G(^TMP($J,"SDAMA301",SDCLIEN,SDDFN,SDDATE)) ;appointment data
109 ....S SDCREDIT=$P(SDAPPT,"^",13) ;credit stop code IEN
110 .... S SDCREDIT=$P(SDCREDIT,";",1)
111 .... S SDCREDIN=$P($G(^DIC(40.7,SDCREDIT,0)),"^",1)
112 .... I $G(SDCREDIT)'=";" S SDCRIEN=$P(SDCREDIT,";",1) ;credit stop code IEN only
113 .... S Y=SDDATE X ^DD("DD") S SDDATEP=Y
114 .... ;continue processing this appointment as needed
115 .... W !,"CLINIC: ",$P($G(^SC(SDCLIEN,0)),"^",1)," PATIENT: ",$P($G(^DPT(SDDFN,0)),"^",1)," DATE/TIME: ",SDDATEP," STATUS: ",SDSTATUS," STOP CODE=",SDCREDIN
116 I SDCOUNT<0 D
117 . ;do processing for errors 101 and 116
118 . W !,"SDCOUNT=",SDCOUNT ;
119 ; when finished with all processing, kill output array
120 I SDCOUNT'=0 K ^TMP($J,"SDAMA301")
121 Q
122EN5 ;
123 N SDARRAY,SDCOUNT,SDDFN,SDDATE,SDAPPT,SDPAT,SDPATNAM,SDSTATUS
124 N SDATEP
125 S SDARRAY(1)="3061107;3061107"
126 S SDARRAY(2)=4 ; VWVOE PSYCHIATRIC CLINIC
127 S SDARRAY("SORT")="P"
128 S SDARRAY("FLDS")="4;3" ;order is irrelevant
129 S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
130 I SDCOUNT>0 D
131 . ;get patient
132 . S SDDFN=0 F S SDDFN=$O(^TMP($J,"SDAMA301",SDDFN)) Q:SDDFN="" D
133 .. ;get appointment date/time
134 .. S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",SDDFN,SDDATE)) Q:SDDATE="" D
135 ... S SDAPPT=$G(^TMP($J,"SDAMA301",SDDFN,SDDATE)) ;appointment data
136 ... S SDSTATUS=$P($G(SDAPPT),"^",3) ;appointment status
137 ... S SDPAT=$P($G(SDAPPT),"^",4) ;patient DFN and Name
138 ... S SDPATNAM=$P($G(SDPAT),";",2) ;patient Name only
139 ... S Y=SDDATE X ^DD("DD") S SDDATEP=Y
140 ... ;continue processing this appointment as needed
141 ... W !,"CLINIC: ","VWVOE PSYCHIATRIC CLINIC"," PATIENT: ",SDPATNAM," DATE/TIME: ",SDDATEP," STATUS: ",SDSTATUS
142 I SDCOUNT<0 D
143 . W !,"SDCOUNT=",SDCOUNT ;
144 . ;do processing for errors 101 and 116
145 ; when finished with all processing, kill the output array
146 I SDCOUNT'=0 K ^TMP($J,"SDAMA301")
147 Q
148EN6 ;
149 N SDARRAY,SDCOUNT,SDCLIEN
150 N SDDFN
151 N SDDATE,SDAPPT,SDSTATUS
152 N SDDATEP,SDAPPM
153 S SDARRAY(1)="3061101;3061130"
154 S SDARRAY(13)=323
155 S ^SDDFN(1)=""
156 S ^SDDFN(2)=""
157 S ^SDDFN(3)=""
158 S SDARRAY(4)="^SDDFN("
159 S SDARRAY("FLDS")="3;16"
160 S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
161 I SDCOUNT>0 D
162 . ;get clinic
163 . S SDCLIEN=0 F S SDCLIEN=$O(^TMP($J,"SDAMA301",SDCLIEN)) Q:SDCLIEN="" D
164 .. ;get patient
165 .. S SDDFN=0 F S SDDFN=$O(^TMP($J,"SDAMA301",SDCLIEN,SDDFN)) Q:SDDFN="" D
166 ... ;get appointment date/time
167 ... S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",SDCLIEN,SDDFN,SDDATE)) Q:SDDATE="" D
168 .... S SDSTATUS=$P($G(^TMP($J,"SDAMA301",SDCLIEN,SDDFN,SDDATE)),"^",3) ;appointment status
169 .... S SDAPPM=$P($G(^TMP($J,"SDAMA301",SDCLIEN,SDDFN,SDDATE)),"^",16) ;date appointment made
170 .... S Y=SDAPPM X ^DD("DD") S SDAPPM=Y
171 .... S Y=SDDATE X ^DD("DD") S SDDATEP=Y
172 .... ;continue processing this appointment as needed
173 ... W !,"CLINIC: ",$P($G(^SC(SDCLIEN,0)),"^",1)," PATIENT: ",$P($G(^DPT(SDDFN,0)),"^",1)," DATE/TIME: ",SDDATEP," STATUS: ",SDSTATUS," DATE APPT MADE: ",SDAPPM
174 I SDCOUNT<0 D
175 . ;do processing for errors 101 and 116
176 . W !,"SDCOUNT=",SDCOUNT ;
177 ; when finished with all processing, kill output array and user-defined patient list
178 I SDCOUNT'=0 K ^TMP($J,"SDAMA301")
179 ;K ^SDDFN
180 Q
181MKPITEST ;
182 N DFN,SD1,SC,STYP,X2,X,X1,SDARRAY,IER
183 N XQORMUTE ; EXIST AS NON-INTERACTIVE SILENT NODE W/O WRITE FOR XQOR ROUTINES
184 N SDVWNVAI ; EXIST AS NON-VA RELATED PFSS EVENT MODE
185 ; = "D" DISABLING THE NEED FOR ICN
186 ; = "O" AS OTHER NON-VA ICN SYSTEM ( FUTURE)
187 S XQORMUTE=1 ;SILENT MODE FOR NON-INTERACTIVE MODE W/O WRITE
188 S SDVWNVAI="D" ; NON-VA TESTING HERE WITH DISABLING THE NEED FOR ICN
189 S DFN=3 S SD1=3070123.10 S SC=3 S STYP=3
190 D NOW^%DTC S X2=X\1 S SDARRAY("DATE NOW")=X2
191 S SDARRAY("APPT TYPE")=9
192 S SDARRAY("SCHED_REQ_TYPE")="O"
193 S SDARRAY("NEXT APPT IND")=0
194 S SDARRAY("FOLLOWUP VISIT INDICATOR")=0 ; 0 FOR NO
195 S SDARRAY("DATA ENTRY CLERK")=DUZ
196 S IER=$$EN^SDVWMKPI(DFN,SD1,SC,STYP,.SDARRAY)
197 W "IER=",IER
198 Q
Note: See TracBrowser for help on using the repository browser.