source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDVWAPP.m

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

initial load of WorldVistAEHR
File size: 6.2 KB
Line 
1SDVWAPP ; VWSD VOE APP FOR SDAPI AND MAKE APPOINTMENT RPC routines
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 ;
19SDAPI(RESULTS,SDARRAY) ;;
20 ; SDAPI APP TEST PROGRAM ( RETURN LIST OF APPOINTMENTS)
21 ; VERSION 3.1
22 N FIRST,SSN,SDDATE,SDLOCATE,PATIENTN,SSNPATN,AJJ3VIS,SDARRAY2,COUNTER
23 N MSGCTRL,IER,RETURN,ORDRSORT,SSN,SDLOCATE,SDDATE,SDCOUNT,ACKCODE
24 S MSGCTRL=0
25 ;;;;S SDARRAY(1)="Nov 6,2006;Nov 9,2006"
26 I $G(SDARRAY(1))="" S RESULTS(0)="UNDEFINED DATE RANGE ELEMENT" Q
27 ;;;;;;S SDARRAY(3)="R;I"
28 I $G(SDARRAY(3))="" S RESULTS(0)="UNDEFINED ELEMENT 3 = "_"R;I" Q
29 ;;;;;;S SDARRAY(2)="VWVOE RADIOLOGY CLINIC" ;EXTERNAL NAME
30 I ($G(SDARRAY(2))="")&($G(SDARRAY(4))="") S RESULTS(0)="UNDEFINED ELEMENTS 2 AND 4 TOGETHER" Q
31 ;AS WELL AS S SDARRAY(4)="100001298" ;EXTERNAL PATIENT ID AS SSN
32 ;;;;;;S SDARRAY("MAX")=3
33 I $G(SDARRAY("MAX"))="" S RESULTS(0)="UNDEFINED MAX RETURN ELEMENT" Q
34 ;;;;;;;S SDARRAY("FLDS")="1;2;3"
35 I $G(SDARRAY("FLDS"))="" S RESULTS(0)="UNDEFINED FLDS ELEMENT" Q
36 S RESULTS(0)="UP TO HERE SDAPI"
37 ;Q
38 S IER=$$TRNSDAPI^SDVWHLE2(.SDARRAY,.MSGCTRL)
39 I (IER="OK")&(MSGCTRL'=0) D
40 .S AJJ3CNT=0
41CHKAGAIN .I AJJ3CNT>27 Q
42 .I $D(^XTMP(MSGCTRL,"RETURN"))=0 H 3 S AJJ3CNT=AJJ3CNT+1 G CHKAGAIN
43 .;W !,"HERE"
44 .S RETURN=^XTMP(MSGCTRL,"RETURN") ; THIS INCLUDES ACK CODE AS AA OR AE
45 .S ACKCODE=$P(RETURN,"^",1)
46 .I ACKCODE="OK" D
47 ..;
48 ..S ORDRSORT=$P(RETURN,"^",2)
49 ..S SDCOUNT=$P(RETURN,"^",3)
50 ..I SDCOUNT>0 D
51 ...D
52 ....I $E(ORDRSORT,1,1)="P" D
53 .....S AJJ3VIS=0
54 .....F S AJJ3VIS=$O(^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)) Q:AJJ3VIS="" D
55 ......S SDARRAY2=^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)
56 ......S SSNPATN=$P(SDARRAY2,"^",1)
57 ......S SDLOCATE=$P(SDARRAY2,"^",2)
58 ......S SDDATE=$P(SDARRAY2,"^",3)
59 ......S FIRST=SSNPATN_"^"_SDLOCATE_"^"_SDDATE_"^"
60 ......S SDARRAY2=$P(SDARRAY2,FIRST,2)
61 ......S PATIENTN=$P(SSNPATN,"#",2)
62 ......S SSN=$P(SSNPATN,"#",1)
63 ......S COUNTER=(AJJ3VIS-1)*2
64 ......S RESULTS(COUNTER+1)="APPT/UNSCHED VISIT, PATIENT="_PATIENTN_" SSN="_SSN_" HOSP LOCATION="_SDLOCATE_" DATE/TIME="_SDDATE
65 ......S RESULTS(COUNTER+2)=" DATA FIELDS="_SDARRAY2
66 ....I $E(ORDRSORT,1,1)="C" D
67 .....S AJJ3VIS=0
68 .....F S AJJ3VIS=$O(^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)) Q:AJJ3VIS="" D
69 ......S SDARRAY2=^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)
70 ......S SSNPATN=$P(SDARRAY2,"^",2)
71 ......S SDLOCATE=$P(SDARRAY2,"^",1)
72 ......S SDDATE=$P(SDARRAY2,"^",3)
73 ......S FIRST=SDLOCATE_"^"_SSNPATN_"^"_SDDATE_"^"
74 ......S SDARRAY2=$P(SDARRAY2,FIRST,2)
75 ......S PATIENTN=$P(SSNPATN,"#",2)
76 ......S SSN=$P(SSNPATN,"#",1)
77 ......S COUNTER=(AJJ3VIS-1)*2
78 ......S RESULTS(COUNTER+1)="APPT/UNSCHED VISIT, HOSP LOCATION="_SDLOCATE_" PATIENT="_PATIENTN_" SSN="_SSN_" DATE/TIME="_SDDATE
79 ......S RESULTS(COUNTER+2)=" DATA FIELDS="_SDARRAY2
80 ..E D
81 ...S RESULTS(1)="SDCOUNT="_SDCOUNT ;LOOK AT ERRORS IN API CALL, ETC
82 E D
83 . S RESULTS(1)=RETURN ; APP ACK CODE="AE". SOME OTHER ERRORS IN TRANSMISSION IN OTHER PIECES OF RETURN
84 S RESULTS(0)="MSGCTRL="_MSGCTRL ;;;;;;;;;W !,"MSGCTRL=",MSGCTRL
85 I (MSGCTRL'=0) K ^XTMP(MSGCTRL)
86 Q
87MKPI(RESULTS,SDARRAY1) ;
88 ;MAKE Appointment APP TEST PROGRAM
89 ;
90 N MSGCTRL,IER,RETURN,DUZ1
91 N PATIENTN,SSN,SD1,SC,STYP,OUTIN,SDVWNVAI,X,Y,X2,ACKCODE,SDARRAY
92 N AJJ3CNT
93 N VXSDNVAI
94 S MSGCTRL=0 ;
95 ;N DFN(SSN AND PATIENT NAME INSTEAD),SD1,SC(HOSP LOCATION (CLINIC) EXT FORMAT NAME INSTEAD,STYP,
96 ;N SDARRAY (DATE/TIMES IN EXTERNAL FORMAT),IER
97 I $G(SDARRAY1("PATIENTN"))="" S RESULTS(0)="NO DEFINED PATIENTN ELEMENT" Q
98 S PATIENTN=SDARRAY1("PATIENTN") ; S PATIENTN="ZZ PATIENT,TEST ONE"
99 S SDVWNVAI="D" ; NON-VA TESTING HERE WITH DISABLING THE NEED FOR ICN
100 I $G(SDARRAY1("SSN"))="" S RESULTS(0)="NO DEFINED SSN ELEMENT" Q
101 S SSN=SDARRAY1("SSN") ; S SSN=100001298 ; DFN=1 NON TEST PATRIENT FOR PFSS EVENT GENERATION
102 I $G(SDARRAY1("SD1"))="" S RESULTS(0)="NO DEFINED SD1 APPT DATE ELEMENT"
103 S SD1=SDARRAY1("SD1") ; S SD1="JAN 24,2007@11:30" ; SD1=3070123.1130
104 ;S X=SD1 D ^%DT S SD1=Y
105 I $G(SDARRAY1("SC"))="" S RESULTS(0)="NO DEFINED APPOINTMENT CLINIC ELEMENT" Q
106 S SC=SDARRAY1("SC") ; "VWVOE RADIOLOGY CLINIC" ; S SC=3
107 S STYP=3 ;SCHEDULED APPT
108 S OUTIN="O" ;for outpatient clinic
109 ;
110 D NOW^%DTC S X2=X\1 S Y=X2 D DD^%DT S SDARRAY("DATE NOW")=Y
111 ;D NOW^%DTC S X2=X\1 S Y=X2 D DD^%DT S SDARRAY("DATE NOW")=Y
112 S SDARRAY("APPT TYPE")=9
113 S SDARRAY("SCHED_REQ_TYPE")="O" ;'OTHER THAN NEXT AVAIABLE
114 S SDARRAY("NEXT APPT IND")=0 ;0 FOR NO
115 S SDARRAY("FOLLOWUP VISIT INDICATOR")=0 ; 0 FOR NO
116 ;CHECK FOR DUZ IN SDARRAY1("DUZ") FOR DATA ENTRY CLERK
117 I $G(SDARRAY1("DUZ"))="" S RESULTS(0)="NO DUZ ELEMENT RETURNED" Q
118 S DUZ1=SDARRAY1("DUZ")
119 ;GET NAME FOR DUZ IN NEW PERSON FILE
120 S SDARRAY("DATA ENTRY CLERK")=$P($G(^VA(200,DUZ1,0)),"^",1)
121 ;;;;;;;;;S SDARRAY("DATA ENTRY CLERK")="SCHLEHUBER,CAMERON" ; PERSON ON MACHINE MAKING APPT REMOTELY
122 ;THEN PARAMETERS CONVERTED TO INTERNAL VALUE
123 S RESULTS(0)="UP TO HERE MAKE APPT"
124 ;Q
125 S IER=$$TRNSMKPI^SDVWHLE1(PATIENTN,SSN,SD1,SC,STYP,.SDARRAY,OUTIN,.MSGCTRL,SDVWNVAI)
126 ;SDVWNVAI AS LAST PARAMETER PASSED
127 I (IER="OK")&(MSGCTRL'=0) D
128 .S AJJ3CNT=0
129CHKGAIN .I AJJ3CNT>8 Q
130 .I $D(^XTMP(MSGCTRL,"RETURN"))=0 H 3 S AJJ3CNT=AJJ3CNT+1 G CHKGAIN
131 .S RETURN=^XTMP(MSGCTRL,"RETURN") ; THIS INCLUDES ACK CODE AS AA OR AE
132 .S ACKCODE=$P(RETURN,"^",1)
133 .I ACKCODE="AA" D
134 ..S RESULTS(1)=ACKCODE_" MAKE APPT GOOD RETURN"
135 .E D
136 ..;ACKCODE="AE". LOOK AT SOME OTHER ERRORS IN TRNSMISSION IN OTHER PIECES OF RETURN
137 ..S RESULTS(1)=ACKCODE_" RETURN="_RETURN
138 S RESULTS(0)="MSGCTRL="_MSGCTRL
139 I (MSGCTRL'=0) K ^XTMP(MSGCTRL,"RETURN")
140 Q
Note: See TracBrowser for help on using the repository browser.