source: cprs/branches/tmg-cprs/m_files/TMGSDAM1.m@ 861

Last change on this file since 861 was 796, checked in by Kevin Toppenberg, 15 years ago

Initial upload
File size: 7.7 KB
RevLine 
[796]1TMGSDAM1 ;TMG/kst/APP For SDAPI AND MAKE APPOINTMENT RPC routines;1/9/09
2 ;;1.0;TMG-LIB;**1**;1/9/09
3 ;
4 ;"NOTE: Original header:
5 ;"SDVWAPP ; VWSD VOE APP FOR SDAPI AND MAKE APPOINTMENT RPC routines
6 ;" ; 1/1/07 SDVW*3*2;;;;;Build 8
7 ;"
8 ;"Moved to this namespace for customization
9 ;
10 ;"=======================================================================
11 ;" API -- Public Functions.
12 ;"=======================================================================
13 ;"SDAPI(RESULTS,SDARRAY)
14 ;
15 ;"=======================================================================
16 ;"Dependancies
17 ;"=======================================================================
18 ;
19 ;"=======================================================================
20 ;
21SDAPI(RESULTS,SDARRAY) ;;
22 ;"Purpose: SDAPI APP TEST PROGRAM ( RETURN LIST OF APPOINTMENTS)
23 ;"VERSION 3.1
24 ;"Input: RESULTS -- PASS BY REFERENCE. An OUT PARAMETER.
25 ;" SDARRAY -- PASS BY REFERENCE. Example input:
26 ;" SDARRAY(1)="Nov 6,2006;Nov 9,2006"
27 ;" SDARRAY(2)="VWVOE RADIOLOGY CLINIC" (External Format)
28 ;" SDARRAY(3)="R;I"
29 ;" SDARRAY(4)="100001298" (EXTERNAL PATIENT ID AS SSN)
30 ;" SDARRAY("MAX")=3
31 ;" SDARRAY("FLDS")="1;2;3"
32 ;"Result: None (output placed in RESULTS var above)
33 ;
34 NEW FIRST,SSN,SDDATE,SDLOCATE,PATIENTN,SSNPATN,AJJ3VIS,SDARRAY2,COUNTER
35 NEW MSGCTRL,IER,RETURN,ORDRSORT,SSN,SDLOCATE,SDDATE,SDCOUNT,ACKCODE
36 ;
37 SET MSGCTRL=0
38 IF $GET(SDARRAY(1))="" SET RESULTS(0)="UNDEFINED DATE RANGE ELEMENT" QUIT
39 IF $GET(SDARRAY(3))="" SET RESULTS(0)="UNDEFINED ELEMENT 3 = "_"R;I" QUIT
40 IF ($GET(SDARRAY(2))="")&($GET(SDARRAY(4))="") SET RESULTS(0)="UNDEFINED ELEMENTS 2 AND 4 TOGETHER" QUIT
41 IF $GET(SDARRAY("MAX"))="" SET RESULTS(0)="UNDEFINED MAX RETURN ELEMENT" QUIT
42 IF $GET(SDARRAY("FLDS"))="" SET RESULTS(0)="UNDEFINED FLDS ELEMENT" QUIT
43 ;
44 SET IER=$$TRNSDAPI^SDVWHLE2(.SDARRAY,.MSGCTRL)
45 IF (IER="OK")&(MSGCTRL'=0) DO
46 . SET AJJ3CNT=0
47CHKAGAIN ;
48 . IF AJJ3CNT>27 QUIT
49 . IF $D(^XTMP(MSGCTRL,"RETURN"))=0 HANG 3 SET AJJ3CNT=AJJ3CNT+1 G CHKAGAIN
50 . SET RETURN=^XTMP(MSGCTRL,"RETURN") ;" THIS INCLUDES ACK CODE AS AA OR AE
51 . SET ACKCODE=$P(RETURN,"^",1)
52 . IF ACKCODE="OK" DO
53 . . SET ORDRSORT=$P(RETURN,"^",2)
54 . . SET SDCOUNT=$P(RETURN,"^",3)
55 . . IF SDCOUNT>0 DO
56 . . . IF $E(ORDRSORT,1,1)="P" DO
57 . . . . SET AJJ3VIS=0
58 . . . . FOR SET AJJ3VIS=$O(^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)) QUIT:AJJ3VIS="" DO
59 . . . . . SET SDARRAY2=^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)
60 . . . . . SET SSNPATN=$P(SDARRAY2,"^",1)
61 . . . . . SET SDLOCATE=$P(SDARRAY2,"^",2)
62 . . . . . SET SDDATE=$P(SDARRAY2,"^",3)
63 . . . . . SET FIRST=SSNPATN_"^"_SDLOCATE_"^"_SDDATE_"^"
64 . . . . . SET SDARRAY2=$P(SDARRAY2,FIRST,2)
65 . . . . . SET PATIENTN=$P(SSNPATN,"#",2)
66 . . . . . SET SSN=$P(SSNPATN,"#",1)
67 . . . . . SET COUNTER=(AJJ3VIS-1)*2
68 . . . . . SET RESULTS(COUNTER+1)="APPT/UNSCHED VISIT, PATIENT="_PATIENTN_" SSN="_SSN_" HOSP LOCATION="_SDLOCATE_" DATE/TIME="_SDDATE
69 . . . . . SET RESULTS(COUNTER+2)=" DATA FIELDS="_SDARRAY2
70 . . . IF $E(ORDRSORT,1,1)="C" DO
71 . . . . SET AJJ3VIS=0
72 . . . . FOR SET AJJ3VIS=$O(^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)) QUIT:AJJ3VIS="" DO
73 . . . . . SET SDARRAY2=^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)
74 . . . . . SET SSNPATN=$P(SDARRAY2,"^",2)
75 . . . . . SET SDLOCATE=$P(SDARRAY2,"^",1)
76 . . . . . SET SDDATE=$P(SDARRAY2,"^",3)
77 . . . . . SET FIRST=SDLOCATE_"^"_SSNPATN_"^"_SDDATE_"^"
78 . . . . . SET SDARRAY2=$P(SDARRAY2,FIRST,2)
79 . . . . . SET PATIENTN=$P(SSNPATN,"#",2)
80 . . . . . SET SSN=$P(SSNPATN,"#",1)
81 . . . . . SET COUNTER=(AJJ3VIS-1)*2
82 . . . . . SET RESULTS(COUNTER+1)="APPT/UNSCHED VISIT, HOSP LOCATION="_SDLOCATE_" PATIENT="_PATIENTN_" SSN="_SSN_" DATE/TIME="_SDDATE
83 . . . . . SET RESULTS(COUNTER+2)=" DATA FIELDS="_SDARRAY2
84 . . ELSE DO
85 . . .SET RESULTS(1)="SDCOUNT="_SDCOUNT ;LOOK AT ERRORS IN API CALL, ETC
86 ELSE DO
87 . SET RESULTS(1)=RETURN ;" APP ACK CODE="AE". SOME OTHER ERRORS IN TRANSMISSION IN OTHER PIECES OF RETURN
88 SET RESULTS(0)="MSGCTRL="_MSGCTRL
89 IF (MSGCTRL'=0) KILL ^XTMP(MSGCTRL)
90 ;
91 QUIT
92 ;
93MKPI(RESULTS,SDARRAY1) ;
94 ;"Purpose: MAKE Appointment APP TEST PROGRAM
95 ;"Input: RESULTS -- PASS BY REFERENCE. An OUT PARAMETER.
96 ;" SDARRAY1 -- PASS BY REFERENCE. Example input:
97 ;" SDARRAY1("PATIENTN")="ZZ PATIENT,TEST ONE"
98 ;" SDARRAY1("SSN")="100001298"
99 ;" SDARRAY1("SD1")="JAN 24,2007@11:30" vs. "3070123.1130" ??Which one??
100 ;" SDARRAY1("SC")="VWVOE RADIOLOGY CLINIC" vs "3" ??Which One??
101 ;" SDARRAY1("DUZ")="SCHLEHUBER,CAMERON"
102 ;
103 NEW MSGCTRL,IER,RETURN,DUZ1
104 NEW PATIENTN,SSN,SD1,SC,STYP,OUTIN,SDVWNVAI,X,Y,X2,ACKCODE,SDARRAY
105 NEW AJJ3CNT
106 NEW VXSDNVAI
107 SET MSGCTRL=0 ;
108 ;"NEW DFN(SSN AND PATIENT NAME INSTEAD),SD1,SC(HOSP LOCATION (CLINIC) EXT FORMAT NAME INSTEAD,STYP,
109 ;"NEW SDARRAY (DATE/TIMES IN EXTERNAL FORMAT),IER
110 IF $GET(SDARRAY1("PATIENTN"))="" SET RESULTS(0)="NO DEFINED PATIENTN ELEMENT" QUIT
111 SET PATIENTN=SDARRAY1("PATIENTN") ;" e.g. ZZ PATIENT,TEST ONE
112 SET SDVWNVAI="D" ;" NON-VA TESTING HERE WITH DISABLING THE NEED FOR ICN
113 IF $GET(SDARRAY1("SSN"))="" SET RESULTS(0)="NO DEFINED SSN ELEMENT" QUIT
114 SET SSN=SDARRAY1("SSN") ;" SET SSN=100001298 ; DFN=1 NON TEST PATRIENT FOR PFSS EVENT GENERATION
115 IF $GET(SDARRAY1("SD1"))="" SET RESULTS(0)="NO DEFINED SD1 APPT DATE ELEMENT"
116 SET SD1=SDARRAY1("SD1") ;" e.g. "JAN 24,2007@11:30" ; SD1=3070123.1130
117 ;SET X=SD1 DO ^%DT SET SD1=Y
118 IF $GET(SDARRAY1("SC"))="" SET RESULTS(0)="NO DEFINED APPOINTMENT CLINIC ELEMENT" QUIT
119 SET SC=SDARRAY1("SC") ; "VWVOE RADIOLOGY CLINIC ; SET SC=3
120 SET STYP=3 ;SCHEDULED APPT
121 SET OUTIN="O" ;for outpatient clinic
122 ;
123 DO NOW^%DTC SET X2=X\1 SET Y=X2 DO DD^%DT SET SDARRAY("DATE NOW")=Y
124 SET SDARRAY("APPT TYPE")=9
125 SET SDARRAY("SCHED_REQ_TYPE")="O" ;"OTHER THAN NEXT AVAIABLE
126 SET SDARRAY("NEXT APPT IND")=0 ;"0 FOR NO
127 SET SDARRAY("FOLLOWUP VISIT INDICATOR")=0 ;" 0 FOR NO
128 ;"CHECK FOR DUZ IN SDARRAY1("DUZ") FOR DATA ENTRY CLERK
129 IF $GET(SDARRAY1("DUZ"))="" SET RESULTS(0)="NO DUZ ELEMENT RETURNED" QUIT
130 SET DUZ1=SDARRAY1("DUZ")
131 ;"GET NAME FOR DUZ IN NEW PERSON FILE, e.g. "SCHLEHUBER,CAMERON" ; PERSON ON MACHINE MAKING APPT REMOTELY
132 SET SDARRAY("DATA ENTRY CLERK")=$P($GET(^VA(200,DUZ1,0)),"^",1)
133 ;"THEN PARAMETERS CONVERTED TO INTERNAL VALUE
134 ;
135 SET IER=$$TRNSMKPI^SDVWHLE1(PATIENTN,SSN,SD1,SC,STYP,.SDARRAY,OUTIN,.MSGCTRL,SDVWNVAI)
136 ;"SDVWNVAI AS LAST PARAMETER PASSED
137 IF (IER="OK")&(MSGCTRL'=0) DO
138 . SET AJJ3CNT=0
139CHKGAIN . IF AJJ3CNT>8 QUIT
140 . IF $D(^XTMP(MSGCTRL,"RETURN"))=0 H 3 SET AJJ3CNT=AJJ3CNT+1 G CHKGAIN
141 . SET RETURN=^XTMP(MSGCTRL,"RETURN") ;" THIS INCLUDES ACK CODE AS AA OR AE
142 . SET ACKCODE=$P(RETURN,"^",1)
143 . IF ACKCODE="AA" DO
144 . . SET RESULTS(1)=ACKCODE_" MAKE APPT GOOD RETURN"
145 . ELSE DO
146 . . ;"ACKCODE="AE". LOOK AT SOME OTHER ERRORS IN TRNSMISSION IN OTHER PIECES OF RETURN
147 . . SET RESULTS(1)=ACKCODE_" RETURN="_RETURN
148 SET RESULTS(0)="MSGCTRL="_MSGCTRL
149 IF (MSGCTRL'=0) K ^XTMP(MSGCTRL,"RETURN")
150MKDONE ;
151 QUIT
Note: See TracBrowser for help on using the repository browser.