source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDVWTES1.m@ 1361

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

initial load of WorldVistAEHR
File size: 6.3 KB
RevLine 
[613]1SDVWTES1 ; VWSD VOE SDAPI AND MAKE APPOINTMENT (CONTINUED) 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 ;
19HL7SDAPI ;;
20 ; HL7 SDAPI TEST PROGRAM ( RETURN LIST OF APPOINTMENTS)
21 ;
22 N FIRST,SSN,SDDATE,SDLOCATE,SDARRAY,PATIENTN,SSNPATN,AJJ3VIS,SDARRAY2
23 N MSGCTRL,IER,RETURN,ORDRSORT,SSN,SDLOCATE,SDDATE,SDCOUNT,ACKCODE
24 S MSGCTRL=0
25 S SDARRAY(1)="Nov 6,2006;Nov 10,2006" ;"FEB 5,2007;FEB 6,2007" ;"Nov 6,2006;JAN 29,2007" ;"Nov 6,2006;Nov 10,2006"
26 S SDARRAY(3)="R;I"
27 S SDARRAY(2)="VWVOE RADIOLOGY CLINIC" ;"VWVOE DRPHYSICIAN CLINIC" ;"VWVOE RADIOLOGY CLINIC" ;"VWVOE DRPHYSICIAN CLINIC"
28 ;"VWVOE RADIOLOGY CLINIC"
29 ;"VWVOE DR. PHYSICIAN CLINIC"
30 ;"VWVOE RADIOLOGY CLINIC"
31 ;"VWVOE DR. PHYSICIAN CLINIC" ;"VWVOE RADIOLOGY CLINIC" ;"VWVOE DR. PHYSICIAN CLINIC" ;"VWVOE RADIOLOGY CLINIC" ;EXTERNAL NAME
32 ;S SDARRAY(4)="100001298" ;EXTERNAL PATIENT ID AS SSN
33 S SDARRAY("MAX")=2
34 S SDARRAY("FLDS")="1;2;3"
35 S IER=$$TRNSDAPI^SDVWHLE2(.SDARRAY,.MSGCTRL)
36 I (IER="OK")&(MSGCTRL'=0) D
37 .S AJJ3CNT=0
38CHKAGAIN .I AJJ3CNT>27 Q
39 .I $D(^XTMP(MSGCTRL,"RETURN"))=0 H 3 S AJJ3CNT=AJJ3CNT+1 G CHKAGAIN
40 .;W !,"HERE"
41 .S RETURN=^XTMP(MSGCTRL,"RETURN") ; THIS INCLUDES ACK CODE AS AA OR AE
42 .S ACKCODE=$P(RETURN,"^",1)
43 .I ACKCODE="OK" D
44 ..;
45 ..S ORDRSORT=$P(RETURN,"^",2)
46 ..S SDCOUNT=$P(RETURN,"^",3)
47 ..I SDCOUNT>0 D
48 ...D
49 ....I $E(ORDRSORT,1,1)="P" D
50 .....S AJJ3VIS=0
51 .....F S AJJ3VIS=$O(^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)) Q:AJJ3VIS="" D
52 ......S SDARRAY2=^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)
53 ......S SSNPATN=$P(SDARRAY2,"^",1)
54 ......S SDLOCATE=$P(SDARRAY2,"^",2)
55 ......S SDDATE=$P(SDARRAY2,"^",3)
56 ......S FIRST=SSNPATN_"^"_SDLOCATE_"^"_SDDATE_"^"
57 ......S SDARRAY2=$P(SDARRAY2,FIRST,2)
58 ......S PATIENTN=$P(SSNPATN,"#",2)
59 ......S SSN=$P(SSNPATN,"#",1)
60 ......W !,"APPT/UNSCHED VISIT, PATIENT=",PATIENTN," SSN=",SSN," HOSP LOCATION=",SDLOCATE," DATE/TIME=",SDDATE
61 ......W !," DATA FIELDS=",SDARRAY2
62 ....I $E(ORDRSORT,1,1)="C" D
63 .....S AJJ3VIS=0
64 .....F S AJJ3VIS=$O(^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)) Q:AJJ3VIS="" D
65 ......S SDARRAY2=^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)
66 ......S SSNPATN=$P(SDARRAY2,"^",2)
67 ......S SDLOCATE=$P(SDARRAY2,"^",1)
68 ......S SDDATE=$P(SDARRAY2,"^",3)
69 ......S FIRST=SDLOCATE_"^"_SSNPATN_"^"_SDDATE_"^"
70 ......S SDARRAY2=$P(SDARRAY2,FIRST,2)
71 ......S PATIENTN=$P(SSNPATN,"#",2)
72 ......S SSN=$P(SSNPATN,"#",1)
73 ......W !,"APPT/UNSCHED VISIT, HOSP LOCATION=",SDLOCATE," PATIENT=",PATIENTN," SSN=",SSN," DATE/TIME=",SDDATE
74 ......W !," DATA FIELDS=",SDARRAY2
75 ...;I $E(ORDRSORT,1,1)="C" D
76 ...;.W !,"APPT/UNSCHED VISIT=",^XTMP(MSGCTRL,"SDAMA301",SDLOCATE,SSN,SDDATE)=SDARRAY
77 ...;ANSWERS IN ORDERED ARRAYS ^XTMP(MSGCTRL,"SDAM301").
78 ...;BELOW ORDRSORT IS 1ST PIECE RETURNED IN RETURN
79 ...;I ($E(ORDRSORT,1,1)="P")&(SDCOUNT>0)
80 ...;.S ^XTMP(MSGCTRL,"SDAMA301",SSN,SDLOCATE,SDDATE)=SDARRAY OR
81 ...;.S ^XTMP(MSGCTRL,"SDAMA301",SDLOCATE,SDDATE)=SDARRAY IF S SDARRAY("SORT")="C" WITH SDARRAY(4) SPECIFIED (PATIENT)
82 ...;I ($E(ORDRSORT,1,1)="C")&(SDCOUNT>0)
83 ...;.S ^XTMP(MSGCTRL,"SDAMA301",SDLOCATE,SSN,SDDATE)=SDARRAY OR
84 ...;.S ^XTMP(MSGCTRL,"SDAMA301",SSN,SDDATE)=SDARRAY IF S SDARRAY("SORT")="P" WITH SDARRAY(2) SPECIFIED (CLINIC)
85 ..E D
86 ...;LOOK AT ERRORS IN API CALL, ETC
87 E D
88 . ; APP ACK CODE="AE". SOME OTHER ERRORS IN TRANSMISSION IN OTHER PIECES OF RETURN
89 W !,"MSGCTRL=",MSGCTRL
90 Q
91HL7MKPI ;
92 ;MAke Appointment HL7 TEST PROGRAM
93 ;
94 N MSGCTRL,IER,RETURN
95 N PATIENTN,SSN,SD1,SC,STYP,SDARRAY,OUTIN,SDVWNVAI,X,Y,X2,ACKCODE
96 N AJJ3CNT
97 ;N VXSDNVAI
98 S MSGCTRL=0 ;
99 ;N DFN(SSN AND PATIENT NAME INSTEAD),SD1,SC(HOSP LOCATION (CLINIC) EXT FORMAT NAME INSTEAD,STYP,
100 ;N SDARRAY (DATE/TIMES IN EXTERNAL FORMAT),IER
101 S PATIENTN="ZZ PATIENT,TEST TWO"
102 S SDVWNVAI="D" ; NON-VA TESTING HERE WITH DISABLING THE NEED FOR ICN
103 S SSN=100001298 ; DFN=1 NON TEST PATRIENT FOR PFSS EVENT GENERATION
104 S SD1="JUN 4,2007@09:00" ;"JAN 29,2007@09:00" ; SD1=3070123.1130
105 S SC="VWVOE RADIOLOGY CLINIC" ; S SC=3
106 S STYP=3 ;SCHEDULED APPT
107 S OUTIN="O" ;for outpatient clinic
108 ;
109 D NOW^%DTC S X2=X\1 S Y=X2 D DD^%DT S SDARRAY("DATE NOW")=Y
110 S SDARRAY("APPT TYPE")=9
111 S SDARRAY("SCHED_REQ_TYPE")="O" ;'OTHER THAN NEXT AVAIABLE
112 S SDARRAY("NEXT APPT IND")=0 ;0 FOR NO
113 S SDARRAY("FOLLOWUP VISIT INDICATOR")=0 ; 0 FOR NO
114 S SDARRAY("DATA ENTRY CLERK")="SCHLEHUBER,CAMERON" ; PERSON ON MACHINE MAKING APPT REMOTELY
115 ;THEN PARAMETERS CONVERTED TO INTERNAL VALUE
116 ;
117 S IER=$$TRNSMKPI^SDVWHLE1(PATIENTN,SSN,SD1,SC,STYP,.SDARRAY,OUTIN,.MSGCTRL,SDVWNVAI)
118 ;VWSDNVAI AS OPTIONAL LAST PARAMETER PASSED
119 I (IER="OK")&(MSGCTRL'=0) D
120 .S AJJ3CNT=0
121CHKGAIN .I AJJ3CNT>8 Q
122 .I $D(^XTMP(MSGCTRL,"RETURN"))=0 H 3 S AJJ3CNT=AJJ3CNT+1 G CHKGAIN
123 .S RETURN=^XTMP(MSGCTRL,"RETURN") ; THIS INCLUDES ACK CODE AS AA OR AE
124 .S ACKCODE=$P(RETURN,"^",1)
125 .I ACKCODE="AA" D
126 ..W !,"MAKE APPT GOOD RETURN"
127 .E D
128 ..;ACKCODE="AE". LOOK AT SOME OTHER ERRORS IN TRNSMISSION IN OTHER PIECES OF RETURN
129 ..W !,"RETURN=",RETURN
130 W !,"MSGCTRL=",MSGCTRL
131 Q
132QUICK ;
133 D
134 . D
135 . . ;S TEMP="S SDARRAY(1)="_""""_"Nov 6,2006;Nov 9,2006"_""""_""
136 . . S TEMP="S SDARRAY(1)="_3 ;
137 . . ;ZW TEMP
138 . . ;X TEMP
139 . . S AJJ3CNT1=0
140 . . S IFLAG2=0
141 . . S TEMP1=""
142 . . F S AJJ3CNT1=AJJ3CNT1+1 S AJJ3PIEC=$P(TEMP,"""",AJJ3CNT1) Q:(IFLAG2=1) D
143 . . .I AJJ3PIEC'="" S AJJ3CNT2=AJJ3CNT1+1 S AJJ3PIE2=$P(TEMP,"""",AJJ3CNT2) I AJJ3PIE2="" D
144 . . . .S ILENX=$L(TEMP) I $E(TEMP,ILENX,ILENX)="""" D
145 . . . . .S TEMP1=TEMP1_AJJ3PIEC_""""
146 . . . .E D
147 . . . . .S TEMP1=TEMP1_AJJ3PIEC
148 . . .I AJJ3PIEC="" S ILENX=$L(TEMP) I $E(TEMP,ILENX,ILENX)="""" D
149 . . . . S TEMP1=TEMP1_"" S IFLAG2=1
150 . . .E D
151 . . . . S IFLAG2=1
152 . . X TEMP1
153 Q
Note: See TracBrowser for help on using the repository browser.