SDVWHLI2 ;ENHANCED HL7 RECEIVE APPLICATION DRIVER (CONTINUED) FOR SDAPI and MAKE AN APPOINTMENT API 11/18/06 ;;5.3;Scheduling;**502**;Aug 13, 1993 ;Build 14 ; Copyright (C) 2007 WorldVistA ; ; This program is free software; you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation; either version 2 of the License, or ; (at your option) any later version. ; ; This program is distributed in the hope that it will be useful, ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; GNU General Public License for more details. ; ; You should have received a copy of the GNU General Public License ; along with this program; if not, write to the Free Software ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ; OVERX ; ;PROCESS COMPLETE MESSAGE NOW ; ;DETERMINE IF SDAPI REQUEST OR MAKE APPOINTMENT API REQUEST ; ; ; SDAPI PROCESSING HERE BELOW AFTER REQUEST DATA RECEIVED ; ; ;; I (IEVN=0)!(IEVN="A19") D ; SDAPI REQUEST THEN DO APPLICATION ACK WITH "A19" PATIENT INQUIRY APPLICATION ACK .I FLDS="" S ERROR=ERROR_"NO FLDS ARRAY ELEMENT PROVIDED" .;RESTABLISH SDARRAY(1) TO INTERNAL FM DATES .S SDARRAY(1)=STARTIM_";"_ENDTIME .; .I ERROR'="HOSPLOC NOT DEFINED" I $D(SDARRAY(2)) I CLINIEN'="" S SDARRAY(2)=CLINIEN ; HOSP LOCATION .I $D(SDARRAY(4)) D ..S PATIENID=SDARRAY(4) ..; ..;PATIENT ID AS SSN. TEST PATIENT NEEDS AT LEAST LEADING NON-ZERO DIGIT ..S IDX=0 ..S IFLAG=0 ..F S IDX=$O(^DPT("SSN",IDX)) Q:(IDX="")!(IFLAG=1) D ...I IDX=PATIENID S IFLAG=1 ..I IFLAG=1 D ...S DFN=0 ...S DFN=$O(^DPT("SSN",PATIENID,DFN)) ...S SDARRAY(4)=DFN ...; ..E D ...S ERROR=PATIENID_"PATIENTID NOT DEFINED" .I ERROR'="" G OVER .;NOW CALL SDAM301 ROUTINE TO GET APPOINTMENTS .; .S AJJ3CNT1=0 .F S AJJ3CNT1=$O(SDARRAY1(AJJ3CNT1)) Q:AJJ3CNT1="" D ..; .I $D(SDARRAY("MAX")) D ..;;;I SDARRAY("MAX")>2 S SDARRAY("MAX")=2 .S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY) .; .I SDCOUNT>0 D ..; ..;get patient,or clinic arrays depending on sort by patient or clinic . ..I (DFN'="")&(CLINIEN="") S ORDRSORT="P,C,D" ..I (CLINIEN'="")&(DFN="") S ORDRSORT="C,P,D" ..I (DFN'="")&(CLINIEN'="") S ORDRSORT="PS,CS,D" ..I (DFN="")&(CLINIEN="") S ORDRSORT="CN,PN,D" .E D ..; ERROR CONDITION OR NO ELEMENTS RETURNED OVER .; .;DETERMINE IF AN APPLICATION ACK HAS BEEN REQUESTED .;I HDR("APP ACK TYPE")="AL" D SDAPIACK .D SDAPIACK^SDVWHLI1 ; ; MAKE APPOINTMENT API PROCESSING AFTER REQUEST DATA RECEIVED ; ; I IEVN="A08" D ;MAKE APPOINTMENT API . NOW DO APPLICATION ACK .;CHECK FIRST IF STYP IS DEFINED (NOT "") .; .; .I STYP="" S ERRROR=ERROR_"UNDEFINED STYP" .;ALSO CHECK SDLOCATE IS DEFINED (NOT="") .I SDLOCATE="" S ERROR=ERROR_"UNDEFINED SDLOCATE" .I SDLOCATE'="" D ; CONVERT TO INTERNAL FORMAT ..; CHECK FIRST IF SDLOCATE IN B CROSS-REF ..S IDX="" ..S IFLAG=0 ..F S IDX=$O(^SC("B",IDX)) Q:(IDX="")!(IFLAG=1) D ...I IDX=SDLOCATE S IFLAG=1 ..I IFLAG=1 D ...S CLINIEN=0 ...S CLINIEN=$O(^SC("B",SDLOCATE,CLINIEN)) ..E D ...S ERROR=ERROR_"^"_"SDLOCATE NOT DEFINED" .;ALSO CHECK FOR SDARRAY("DATA ENTRY CLERK") AND CONVERT TO DUZ .I $D(SDARRAY("DATA ENTRY CLERK"))>0 S TEMP=SDARRAY("DATA ENTRY CLERK") D ..S TEMPC=0 ..S IFLAG=0 ..F S TEMPC=$O(^VA(200,"B",TEMPC)) Q:(TEMPC="")!(IFLAG=1) D ...I TEMPC=TEMP S IFLAG=1 ..I IFLAG=1 D ...S PCIEN=0 ...S PCIEN=$O(^VA(200,"B",TEMP,PCIEN)) ...S SDARRAY("DATA ENTRY CLERK")=PCIEN ..E D ...S ERROR=ERROR_"^"_"DATA CLERK UNDEFINED" .;PATIENT ID AS SSN. TEST PATIENT NEEDS AT LEAST LEADING NON-ZERO DIGIT .; .; .S IDX=0 .S IFLAG=0 .F S IDX=$O(^DPT("SSN",IDX)) Q:(IDX="")!(IFLAG=1) D ..I IDX=PATIENID S IFLAG=1 .I IFLAG=1 D ..S DFN=0 ..S DFN=$O(^DPT("SSN",PATIENID,DFN)) .E D ..S ERROR=ERROR_"^"_"PATIENTID NOT DEFINED" .;CONVERT ALL DATE/TIMES TO INTERNAL FM FORMAT .I $D(SDARRAY("DATE NOW"))>0 S X=SDARRAY("DATE NOW") D ^%DT S INTE=Y S SDARRAY("DATE NOW")=INTE .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 .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 .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 .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 .; .I ERROR'="" G OVER1 .;ALSO UNDERSTAND THAT OPTIONAL SDVWNVAI COULD HAVE BEEN PASSED IN ($D(SDVWNVAI)>0) .S XQORMUTE=1 ;SILENT MODE FOR NON-INTERACTIVE MODE W/O WRITE IN XQOR ROUTINES .; .; MAKE SDVWMKPI CALL HERE .S SC=CLINIEN .S SD1=$G(SDDATE) ;FROM PV1 .;S DFN= ;FROM PID AND CONVERTED SSN TO DFN ABOVE .;STYP SHOULD BE SET BY NOW .;AS MINIMALLY BELOW EXAMPLE .;S DFN=1 S SD1=3070123.0930 S SC=3 S STYP=3 .;D NOW^%DTC S X2=X\1 S SDARRAY("DATE NOW")=X2 .;S SDARRAY("APPT TYPE")=9 .;S SDARRAY("SCHED_REQ_TYPE")="O" .;S SDARRAY("NEXT APPT IND")=0 .;S SDARRAY("FOLLOWUP VISIT INDICATOR")=0 ; 0 FOR NO .; .;Q .S IER=$$EN^SDVWMKPI(DFN,SD1,SC,STYP,.SDARRAY) .;W "IER=",IER .S MAKEAPPT=1 .; GET RETURNS OVER1 .; .;DETERMINE IF AN APPLICATION ACK HAS BEEN REQUESTED .;I HDR("APP ACK TYPE")="AL" D MPKIACK .;I HDR("ACCEPT ACK TYPE")="AL" D MPKIACK .D SDAPIACK^SDVWHLI1 ; SHARE PARTS OF , NOT USE MPKIACK ; ; ;GO TO NEXT MESSAGE FOR THIS TEST ; ; Q ;;;;;OVER2 I (IEVN=0)!(IEVN="A19") K ^TMP($J,"SDAMA301") ;;;;Q ;;;;H 1 I $$NEXTMSG^HLOPRS(.HLMSTATE,HLMSGIEN,.HDR) G MSG1 ;;;;S AJJ3CNT=AJJ3CNT+1 ;;;;I AJJ3CNT>0 Q ; GET OUT EVENTUALLY AS NON-PERSISTANT TASK ;;;;G OVER2 ; ; ; ; Q MPKIACK ; APPLICATION ACKNOWLEDGE TO MAKE APPOINTMENT API REQUEST N EXTRET S EXTRET=0 ;; S APPARMS("ACK CODE")="AA" S APPARMS("MESSAGE TYPE")="ACK" S APPARMS("SECURITY")=MSGCTRL ;START THE APPLICATION ACKNOWLEDGE MESSAGE ; ;Q S ERROR1="" I (ERETURN'=0)!(ERROR'="")!(IER'=1)!(ERROR1'="") S APPARMS("ACK CODE")="AE" I '$$ACK^HLOAPI2(.HLMSTATE,.APPARMS,.ACK,.ERROR1) S ERETURN="START ACK MESSAGE" ; ; ; ADD ERR SEGMENT IF NEEDED ; I (ERETURN'=0)!(ERROR'="")!(IER'=1)!(ERROR1'="") S EXTRET=$$ERRORW^SDVWHLI1() ; I (ERETURN'=0)!(ERROR'="")!(EXTRET'=0)!(IER'=1)!(ERROR1'="") S APPARMS("ACK CODE")="AE" ; ; SEND APPLICATION ACKNOWLEDGEMENT ; I '$$SENDACK^HLOAPI2(.ACK,.ERROR1) S ERETURN="SENDAPPACK" ; Q MSGPROC ; ACK PROCESSING ROUTINE FOR NO RECEIVE ACKS, ETC FOR SDAPI AND MAKE APPOINTMENT API RETURN DATA Q APPACKRR ;MAIN APPLICATION ACK RESPONSE FOR SDAPI AND MAKE APPOINTMENT API RETURN DATA Q