[613] | 1 | SDVWHLI2 ;ENHANCED HL7 RECEIVE APPLICATION DRIVER (CONTINUED) FOR SDAPI and MAKE AN APPOINTMENT API 11/18/06
|
---|
| 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 | ;
|
---|
| 19 | OVERX ;
|
---|
| 20 | ;PROCESS COMPLETE MESSAGE NOW
|
---|
| 21 | ;
|
---|
| 22 | ;DETERMINE IF SDAPI REQUEST OR MAKE APPOINTMENT API REQUEST
|
---|
| 23 | ;
|
---|
| 24 | ;
|
---|
| 25 | ; SDAPI PROCESSING HERE BELOW AFTER REQUEST DATA RECEIVED
|
---|
| 26 | ;
|
---|
| 27 | ;
|
---|
| 28 | ;;
|
---|
| 29 | I (IEVN=0)!(IEVN="A19") D ; SDAPI REQUEST THEN DO APPLICATION ACK WITH "A19" PATIENT INQUIRY APPLICATION ACK
|
---|
| 30 | .I FLDS="" S ERROR=ERROR_"NO FLDS ARRAY ELEMENT PROVIDED"
|
---|
| 31 | .;RESTABLISH SDARRAY(1) TO INTERNAL FM DATES
|
---|
| 32 | .S SDARRAY(1)=STARTIM_";"_ENDTIME
|
---|
| 33 | .;
|
---|
| 34 | .I ERROR'="HOSPLOC NOT DEFINED" I $D(SDARRAY(2)) I CLINIEN'="" S SDARRAY(2)=CLINIEN ; HOSP LOCATION
|
---|
| 35 | .I $D(SDARRAY(4)) D
|
---|
| 36 | ..S PATIENID=SDARRAY(4)
|
---|
| 37 | ..;
|
---|
| 38 | ..;PATIENT ID AS SSN. TEST PATIENT NEEDS AT LEAST LEADING NON-ZERO DIGIT
|
---|
| 39 | ..S IDX=0
|
---|
| 40 | ..S IFLAG=0
|
---|
| 41 | ..F S IDX=$O(^DPT("SSN",IDX)) Q:(IDX="")!(IFLAG=1) D
|
---|
| 42 | ...I IDX=PATIENID S IFLAG=1
|
---|
| 43 | ..I IFLAG=1 D
|
---|
| 44 | ...S DFN=0
|
---|
| 45 | ...S DFN=$O(^DPT("SSN",PATIENID,DFN))
|
---|
| 46 | ...S SDARRAY(4)=DFN
|
---|
| 47 | ...;
|
---|
| 48 | ..E D
|
---|
| 49 | ...S ERROR=PATIENID_"PATIENTID NOT DEFINED"
|
---|
| 50 | .I ERROR'="" G OVER
|
---|
| 51 | .;NOW CALL SDAM301 ROUTINE TO GET APPOINTMENTS
|
---|
| 52 | .;
|
---|
| 53 | .S AJJ3CNT1=0
|
---|
| 54 | .F S AJJ3CNT1=$O(SDARRAY1(AJJ3CNT1)) Q:AJJ3CNT1="" D
|
---|
| 55 | ..;
|
---|
| 56 | .I $D(SDARRAY("MAX")) D
|
---|
| 57 | ..;;;I SDARRAY("MAX")>2 S SDARRAY("MAX")=2
|
---|
| 58 | .S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
|
---|
| 59 | .;
|
---|
| 60 | .I SDCOUNT>0 D
|
---|
| 61 | ..;
|
---|
| 62 | ..;get patient,or clinic arrays depending on sort by patient or clinic .
|
---|
| 63 | ..I (DFN'="")&(CLINIEN="") S ORDRSORT="P,C,D"
|
---|
| 64 | ..I (CLINIEN'="")&(DFN="") S ORDRSORT="C,P,D"
|
---|
| 65 | ..I (DFN'="")&(CLINIEN'="") S ORDRSORT="PS,CS,D"
|
---|
| 66 | ..I (DFN="")&(CLINIEN="") S ORDRSORT="CN,PN,D"
|
---|
| 67 | .E D
|
---|
| 68 | ..; ERROR CONDITION OR NO ELEMENTS RETURNED
|
---|
| 69 | OVER .;
|
---|
| 70 | .;DETERMINE IF AN APPLICATION ACK HAS BEEN REQUESTED
|
---|
| 71 | .;I HDR("APP ACK TYPE")="AL" D SDAPIACK
|
---|
| 72 | .D SDAPIACK^SDVWHLI1
|
---|
| 73 | ;
|
---|
| 74 | ; MAKE APPOINTMENT API PROCESSING AFTER REQUEST DATA RECEIVED
|
---|
| 75 | ;
|
---|
| 76 | ;
|
---|
| 77 | I IEVN="A08" D ;MAKE APPOINTMENT API . NOW DO APPLICATION ACK
|
---|
| 78 | .;CHECK FIRST IF STYP IS DEFINED (NOT "")
|
---|
| 79 | .;
|
---|
| 80 | .;
|
---|
| 81 | .I STYP="" S ERRROR=ERROR_"UNDEFINED STYP"
|
---|
| 82 | .;ALSO CHECK SDLOCATE IS DEFINED (NOT="")
|
---|
| 83 | .I SDLOCATE="" S ERROR=ERROR_"UNDEFINED SDLOCATE"
|
---|
| 84 | .I SDLOCATE'="" D ; CONVERT TO INTERNAL FORMAT
|
---|
| 85 | ..; CHECK FIRST IF SDLOCATE IN B CROSS-REF
|
---|
| 86 | ..S IDX=""
|
---|
| 87 | ..S IFLAG=0
|
---|
| 88 | ..F S IDX=$O(^SC("B",IDX)) Q:(IDX="")!(IFLAG=1) D
|
---|
| 89 | ...I IDX=SDLOCATE S IFLAG=1
|
---|
| 90 | ..I IFLAG=1 D
|
---|
| 91 | ...S CLINIEN=0
|
---|
| 92 | ...S CLINIEN=$O(^SC("B",SDLOCATE,CLINIEN))
|
---|
| 93 | ..E D
|
---|
| 94 | ...S ERROR=ERROR_"^"_"SDLOCATE NOT DEFINED"
|
---|
| 95 | .;ALSO CHECK FOR SDARRAY("DATA ENTRY CLERK") AND CONVERT TO DUZ
|
---|
| 96 | .I $D(SDARRAY("DATA ENTRY CLERK"))>0 S TEMP=SDARRAY("DATA ENTRY CLERK") D
|
---|
| 97 | ..S TEMPC=0
|
---|
| 98 | ..S IFLAG=0
|
---|
| 99 | ..F S TEMPC=$O(^VA(200,"B",TEMPC)) Q:(TEMPC="")!(IFLAG=1) D
|
---|
| 100 | ...I TEMPC=TEMP S IFLAG=1
|
---|
| 101 | ..I IFLAG=1 D
|
---|
| 102 | ...S PCIEN=0
|
---|
| 103 | ...S PCIEN=$O(^VA(200,"B",TEMP,PCIEN))
|
---|
| 104 | ...S SDARRAY("DATA ENTRY CLERK")=PCIEN
|
---|
| 105 | ..E D
|
---|
| 106 | ...S ERROR=ERROR_"^"_"DATA CLERK UNDEFINED"
|
---|
| 107 | .;PATIENT ID AS SSN. TEST PATIENT NEEDS AT LEAST LEADING NON-ZERO DIGIT
|
---|
| 108 | .;
|
---|
| 109 | .;
|
---|
| 110 | .S IDX=0
|
---|
| 111 | .S IFLAG=0
|
---|
| 112 | .F S IDX=$O(^DPT("SSN",IDX)) Q:(IDX="")!(IFLAG=1) D
|
---|
| 113 | ..I IDX=PATIENID S IFLAG=1
|
---|
| 114 | .I IFLAG=1 D
|
---|
| 115 | ..S DFN=0
|
---|
| 116 | ..S DFN=$O(^DPT("SSN",PATIENID,DFN))
|
---|
| 117 | .E D
|
---|
| 118 | ..S ERROR=ERROR_"^"_"PATIENTID NOT DEFINED"
|
---|
| 119 | .;CONVERT ALL DATE/TIMES TO INTERNAL FM FORMAT
|
---|
| 120 | .I $D(SDARRAY("DATE NOW"))>0 S X=SDARRAY("DATE NOW") D ^%DT S INTE=Y S SDARRAY("DATE NOW")=INTE
|
---|
| 121 | .I $D(SDARRAY("LAB DATE TIME ASSOCIATED"))>0 S X=SDARRAY("LAB DATE TIME ASSOCIATED") S %DT="T" D ^%DT S INTE=Y S SDARRAY("LAB DATE TIME ASSOCIATED")=INTE
|
---|
| 122 | .I $D(SDARRAY("X-RAY DATE TIME ASSOCIATED"))>0 S X=SDARRAY("X-RAY DATE TIME ASSOCIATED") S %DT="T" D ^%DT S INTE=Y S SDARRAY("X-RAY DATE TIME ASSOCIATED")=INTE
|
---|
| 123 | .I $D(SDARRAY("EKG DATE TIME ASSOCIATED"))>0 S X=SDARRAY("EKG DATE TIME ASSOCIATED") S %DT="T" D ^%DT S INTE=Y S SDARRAY("EKG DATE TIME ASSOCIATED")=INTE
|
---|
| 124 | .I $D(SDARRAY("DESIRED DATE TIME OF APPOINTMENT"))>0 S X=SDARRAY("DESIRED DATE TIME OF APPOINTMENT") S %DT="T" D ^%DT S INTE=Y S SDARRAY("DESIRED DATE TIME OF APPOINTMENT")=INTE
|
---|
| 125 | .;
|
---|
| 126 | .I ERROR'="" G OVER1
|
---|
| 127 | .;ALSO UNDERSTAND THAT OPTIONAL SDVWNVAI COULD HAVE BEEN PASSED IN ($D(SDVWNVAI)>0)
|
---|
| 128 | .S XQORMUTE=1 ;SILENT MODE FOR NON-INTERACTIVE MODE W/O WRITE IN XQOR ROUTINES
|
---|
| 129 | .;
|
---|
| 130 | .; MAKE SDVWMKPI CALL HERE
|
---|
| 131 | .S SC=CLINIEN
|
---|
| 132 | .S SD1=$G(SDDATE) ;FROM PV1
|
---|
| 133 | .;S DFN= ;FROM PID AND CONVERTED SSN TO DFN ABOVE
|
---|
| 134 | .;STYP SHOULD BE SET BY NOW
|
---|
| 135 | .;AS MINIMALLY BELOW EXAMPLE
|
---|
| 136 | .;S DFN=1 S SD1=3070123.0930 S SC=3 S STYP=3
|
---|
| 137 | .;D NOW^%DTC S X2=X\1 S SDARRAY("DATE NOW")=X2
|
---|
| 138 | .;S SDARRAY("APPT TYPE")=9
|
---|
| 139 | .;S SDARRAY("SCHED_REQ_TYPE")="O"
|
---|
| 140 | .;S SDARRAY("NEXT APPT IND")=0
|
---|
| 141 | .;S SDARRAY("FOLLOWUP VISIT INDICATOR")=0 ; 0 FOR NO
|
---|
| 142 | .;
|
---|
| 143 | .;Q
|
---|
| 144 | .S IER=$$EN^SDVWMKPI(DFN,SD1,SC,STYP,.SDARRAY)
|
---|
| 145 | .;W "IER=",IER
|
---|
| 146 | .S MAKEAPPT=1
|
---|
| 147 | .; GET RETURNS
|
---|
| 148 | OVER1 .;
|
---|
| 149 | .;DETERMINE IF AN APPLICATION ACK HAS BEEN REQUESTED
|
---|
| 150 | .;I HDR("APP ACK TYPE")="AL" D MPKIACK
|
---|
| 151 | .;I HDR("ACCEPT ACK TYPE")="AL" D MPKIACK
|
---|
| 152 | .D SDAPIACK^SDVWHLI1 ; SHARE PARTS OF , NOT USE MPKIACK ;
|
---|
| 153 | ;
|
---|
| 154 | ;GO TO NEXT MESSAGE FOR THIS TEST
|
---|
| 155 | ;
|
---|
| 156 | ;
|
---|
| 157 | Q
|
---|
| 158 | ;;;;;OVER2 I (IEVN=0)!(IEVN="A19") K ^TMP($J,"SDAMA301")
|
---|
| 159 | ;;;;Q
|
---|
| 160 | ;;;;H 1 I $$NEXTMSG^HLOPRS(.HLMSTATE,HLMSGIEN,.HDR) G MSG1
|
---|
| 161 | ;;;;S AJJ3CNT=AJJ3CNT+1
|
---|
| 162 | ;;;;I AJJ3CNT>0 Q ; GET OUT EVENTUALLY AS NON-PERSISTANT TASK
|
---|
| 163 | ;;;;G OVER2
|
---|
| 164 | ;
|
---|
| 165 | ;
|
---|
| 166 | ;
|
---|
| 167 | ;
|
---|
| 168 | Q
|
---|
| 169 | MPKIACK ; APPLICATION ACKNOWLEDGE TO MAKE APPOINTMENT API REQUEST
|
---|
| 170 | N EXTRET
|
---|
| 171 | S EXTRET=0
|
---|
| 172 | ;;
|
---|
| 173 | S APPARMS("ACK CODE")="AA"
|
---|
| 174 | S APPARMS("MESSAGE TYPE")="ACK"
|
---|
| 175 | S APPARMS("SECURITY")=MSGCTRL
|
---|
| 176 | ;START THE APPLICATION ACKNOWLEDGE MESSAGE
|
---|
| 177 | ;
|
---|
| 178 | ;Q
|
---|
| 179 | S ERROR1=""
|
---|
| 180 | I (ERETURN'=0)!(ERROR'="")!(IER'=1)!(ERROR1'="") S APPARMS("ACK CODE")="AE"
|
---|
| 181 | I '$$ACK^HLOAPI2(.HLMSTATE,.APPARMS,.ACK,.ERROR1) S ERETURN="START ACK MESSAGE"
|
---|
| 182 | ;
|
---|
| 183 | ;
|
---|
| 184 | ; ADD ERR SEGMENT IF NEEDED
|
---|
| 185 | ;
|
---|
| 186 | I (ERETURN'=0)!(ERROR'="")!(IER'=1)!(ERROR1'="") S EXTRET=$$ERRORW^SDVWHLI1()
|
---|
| 187 | ;
|
---|
| 188 | I (ERETURN'=0)!(ERROR'="")!(EXTRET'=0)!(IER'=1)!(ERROR1'="") S APPARMS("ACK CODE")="AE"
|
---|
| 189 | ;
|
---|
| 190 | ; SEND APPLICATION ACKNOWLEDGEMENT
|
---|
| 191 | ;
|
---|
| 192 | I '$$SENDACK^HLOAPI2(.ACK,.ERROR1) S ERETURN="SENDAPPACK"
|
---|
| 193 | ;
|
---|
| 194 | Q
|
---|
| 195 | MSGPROC ; ACK PROCESSING ROUTINE FOR NO RECEIVE ACKS, ETC FOR SDAPI AND MAKE APPOINTMENT API RETURN DATA
|
---|
| 196 | Q
|
---|
| 197 | APPACKRR ;MAIN APPLICATION ACK RESPONSE FOR SDAPI AND MAKE APPOINTMENT API RETURN DATA
|
---|
| 198 | Q
|
---|