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

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