SDVWHLIN ;ENHANCED HL7 RECEIVE APPLICATION DRIVER 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
 ;
RECEIVE ;MAIN RECEIVE APPLICATION FOR SDAPI API OR MAKE APPOINTMENT API REQUESTS 
 ; AND MAKE APPT API ACK 
 N APPARMS,ERROR,HLMSGIEN,WHO,SEG,QRDSORT,SORTORDR,OVERAPPT ;
 N HLMSTATE,HDR
 N HLVWNOVA
 N SEGTYPE,IRECAPP,ISNDFAC,IEVN,IFLAGA19,IFLAGACK,POSITION
 N PATIENID,PATIENT,SSN,PATIENTC,SDLOCATI,PRIMCRED,PRIMSTOP
 N SDATE,ELIGIB,EXPECTDT,APPTST,DATEAPTM
 N PIDVALUE,PV1VALUE,PV2VALUE,IFLAG2
 N SDARRAY,SDCOUNT
 N SDLOCATE,HOSPLOC,ORDRSORT,MSGMAKAP,COMMENT,EXTER
 N MAKEAPPT
 N STARTIM,ENDTIME,CLINIEN,IDX,IFLAG,CLINIEN,FLDS,ACK,ERROR1,XQORMUTE,PCIEN,TEMPC,IER,SD1,SC
 N SDCLIEN,SDDFN,SDDATE,SDAPPT,STYP,TEMP,VESD,AJJ3CNT,HLMSGTMP,FLDS
 N AJJ3CNT1,IFLAG2,TEMP1,AJJ3PIEC,AJJ3PIE2,AJJ3CNT2,ERETURN
 N ILOCATE,SDFNSSN,SDFNNAME
 ;RECEIVE APPLICATION
 ;      FIRST RECEIVE
 ;      THEN PROCESS
 ;      THEN SEND APPLICATION ACK
 ;
 ;FOR SDAPI APPLICATION ACK BELOW
 ;INPUT
 ;           
 ;OUTPUT IF NO ERRORS AND SDCOUNT RETURNED NOT =0
 ;RETURN PID,PV1,PV2,NTE, AND NTE SEGMENTS TO DESCRIBE PATIENT,CLINIC,DATES 
 ;FOR APPPOINTMENS/UNSCHEDULED VISITS FOUND
 ;
 ;
 ;
 ;AS EXPLAINED IN CODE BELOW
 ;
 ; 
 ;RETURN  HDR("APP ACK TYPE")_"^"_POSITION_"^"_SDCOUNT_"^"_ERRORS 
 ;                            POSITION IS NUMBER OF RETURNED APPOINTMENTS/VISITS
 ;                            SDCOUNT IS SAME UNLESS ERROR 
 ;                            AND ERROR RETURNES AS IS
 ;                            FROM $$SDAPI^SDAM301
 ;                            APP ACK TYPE ACTUALLY RETURNED, IE "AA"
 ;                                            
 ;        "STARTMSG" 
 ;        "ERR"_$$GET^HLOPRS(.SEQ,1)
 ;        "NOTRETURNED ACK"
 ;        "NOT A19 EVENT"
 ;        "HOSPLOC"
 ;         VWSD
 ;PARSE ACK MESSAGE TYPE WITH REPEATING ADR RESPONSE
 ;EMBEDDED WITH EVENT TYPE A19
 ;
 ;FOR MAKE APPT API 
 ;
 ; INPUT
 ;
 ;
 ;OUTPUT IF NO ERRORS
 ;RETURN ACK SEGMENT, ACK CODE AS "AA" OR "AE" , ERROR IN COMMENTS OF ERR SEGMENT IF ANY
 ;
 ;
 ;RETURN   HDR("APP ACK TYPE")_"^"_ERRORS 
 ;                 WHERE COMMENT IS AS RETURNED FROM SDVWMKPI CALL RETURN
 ;
 ;
 ;
 ;PASS THE HEADER AND RETURN INDIVIDUAL VALUES
 ;
 S AJJ3CNT=0
 S HLVWNOVA=1  ; ALLOW NON-VA STATION NODE WITH ASSOCIATED INSTITUTION 
 ; FOR DETERMINING FACILITY LINK WHEN SENDING APPLICATION BECOMES RECEIVING 
 ; APPLICATION, AND TO FIGURE "SENDING FACILITY LINK" 
 ;
 S HLMSGTMP="AC" ;200000000000  
 ;^HLB("AC","HL7.VWSD INTERNAL MULTILISTENER:5026VWSD HLO EXT100 XXXXX",200000000XXX)
 S HLMSGIEN=$O(^HLB(HLMSGTMP),-1)
 S HDR="" S HLMSTATE=""
 ;
 ;
 I '$$STARTMSG^HLOPRS(.HLMSTATE,HLMSGIEN,.HDR) G OVER2 ;Q "STARTMSG"
 ;
MSG1 ;CHECK RECEIVING APPLICATION
 ;;;;;S IRECAPP=HDR("RECEIVING APPLICATION")
 ;W !,"IRECAPP=",IRECAPP
 ;;;;;;S ISNDFAC=HDR("FACILITY LINK NAME")
 S MSGCTRL=HDR("MESSAGE CONTROL ID") ;HLMSTATE("HDR","MESSAGE CONTROL ID") ;HDR("MESSAGE CONTROL ID") ;OR HLMSTATE(:ID")
 ;
 S IFLAGA19=0
 S POSITION=0
 ;
 S IEVN=0 ;0
 S SDCOUNT=""
 S SDLOCATE=""
 S ORDRSORT=""
 S MSGMAKAP=0 ;
 S COMMENT="" ;
 ;
 ;K SDARRAY
 ;S SDARRAY=""
 S FLDS=""
 ;
 K SDARRAY
 ;
 S SDARRAY=""
 S ERROR=""
 S CLINIEN=""
 S STYP=""
 S IER=1
 K SDVWNVAI
 K ^TMP($J,"SDAMA301")
 S SEG=""
 S APPARMS=""
 S DFN=""
 S ERETURN=0
 S ACK=""
 S MAKEAPPT=0
 ; ADVANCE TO EACH SEGMENT IN THE MESSAGE
SEQ I '$$NEXTSEG^HLOPRS(.HLMSTATE,.SEG) G EXIT
 ;
 S SEGTYPE=$$GET^HLOPRS(.SEG,0)
 ;
 I SEGTYPE="QRF" D
 .S STARTIM=$$GET^HLOPRS(.SEG,2) ; START TIME
    .S STARTIM=$$FMDATE^HLFNC(STARTIM) ; TS TO FM
 .S ENDTIME=$$GET^HLOPRS(.SEG,3) ; END TIME
 .S ENDTIME=$$FMDATE^HLFNC(ENDTIME)
 ;
 I SEGTYPE="EVN" D
 . S IEVN=$$GET^HLOPRS(.SEG,1) ; FOR SDAPI REQUEST AS EITHER NONE OR "A19" ,MAKE APPOINTMENT API REQUEST AS "A08"
 ;
 ;
 ;BELOW PID, PV1,PV2 FOR RECEIVE MAKE APPOINTMENT API REQUEST PARTICULARS
 ;
 I SEGTYPE="PID" D
 . S POSITION=POSITION+1
 . S SDARRAY=""
 . ;GET PATIENT INTERNAL ID
 . S PATIENID=$$GET^HLOPRS(.SEG,3)
 . S PATIENT=$$GET^HLOPRS(.SEG,5)
 . S SSN=$$GET^HLOPRS(.SEG,19)
 . S PIDVALUE=PATIENID_"^"_PATIENT_"^"_SSN
 . ;
 I SEGTYPE="PV1" D
 . ;GET PATIENT INTERNAL ID
 . S PATIENTC=$$GET^HLOPRS(.SEG,2)  ; PATIENT CLASS
 . ;S SDLOCID=$$GET^HLOPRS(.SEG,3) ; NOT RECEIVED FROM MAKE APPT REQUEST AS UNKNOWN ( SDLOCATE SENT IN NTE SEGMENT)
 . S PURPVISI=$$GET^HLOPRS(.SEG,10) ; HOSPITAL SERVICE (PURPOSE OF VISIT)
 . S PRIMSTOP=$$GET^HLOPRS(.SEG,18) ; PATIENT TYPE (PRIME STOP CODE)
 . S PRIMCRED=$$GET^HLOPRS(.SEG,41) ; ACCOUNT STATUS (CREDIT STOP CODE)
 . S SDDATE=$$GET^HLOPRS(.SEG,44) ; ADMIT-VISIT DATE/TIME
 . ;CONVERT TO FM DATE
 . S SDDATE=$$FMDATE^HLFNC(SDDATE)
 . ; S XXXX=$$GET^HLOPRS(.SEG,51) ;
 . S PV1VALUE=PATIENTC_"^"_PURPVISI_"^"_PRIMSTOP_"^"_PRIMCRED_"^"_SDDATE
 . ;
 I SEGTYPE="PV2" D
 . S ELIGIB=$$GET^HLOPRS(.SEG,7) ; VISIT USER ID-ELIGIBILITY FOR UNSCHEDULED VISITS 
 . S EXPECTDT=$$GET^HLOPRS(.SEG,8) ; EXPECTED DATE/TIME
 . ;CONVERT TO FM DATE
 . S EXPECTDT=$$FMDATE^HLFNC(EXPECTDT)
 . ;S APPTST=$$GET^HLOPRS(.SEG,24)  ;APPOINT STATUS
 . S DATEAPTM=$$GET^HLOPRS(.SEG,46) ;DATE APPT MADE
 . ;CONVERT TO FM DATE
 . S DATEAPTM=$$FMDATE^HLFNC(DATEAPTM)
 . S PV2VALUE=ELIGIB_"^"_EXPECTDT_"^"_DATEAPTM
 . ;
 ;
 ;
 ;BELOW FOR SDAPI REQUEST RECEIVE AND MAYBE SOME MAKE APPOINTMENT API REQUEST RECEIVE
 ;
 S ILOCATE=""
 I SEGTYPE="NTE" D
 . S TEMP=$$GET^HLOPRS(.SEG,3) ; UP TO 6 PLUS SDARRAY ELEMENTS
 . ;CHECK FOR SDVWNVAI
 . I $E(TEMP,1,9)="SDVWNVAI=" S SDVWNVAI=$P(TEMP,"SDVWNVAI=",2)
 . I $E(TEMP,1,9)="SDVWNVAI=" Q
 . ;CHECK FOR STYP=
 . I $E(TEMP,1,5)="STYP=" S STYP=$P(TEMP,"STYP=",2) S IEVN="A08"  ;MUST BE MAKE APPT REQUEST
 . I $E(TEMP,1,5)="STYP=" Q
 . I ($E(TEMP,1,11)="SDARRAY(2)=") S ILOCATE=1
 . I ($E(TEMP,1,9)="SDLOCATE=") S ILOCATE=2
 . I ($E(TEMP,1,11)="SDARRAY(2)=")!($E(TEMP,1,9)="SDLOCATE=") D
 . .I ILOCATE=1 S SDLOCATE=$P(TEMP,"SDARRAY(2)=",2)
 . .I ILOCATE=2 S SDLOCATE=$P(TEMP,"SDLOCATE=",2)
 . .S SDLOCATE=$P(SDLOCATE,"""",2) ; TAKE OUT FRONT QUOTE
 . .S SDLOCATE=$P(SDLOCATE,"""",1) ; TAKE OFF ENDING QUOTE
 . .; CONVERT TO INTERNAL IEN FROM EXTERNAL
 . .; 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))
 . . . S SDARRAY(2)=CLINIEN
 . . E  D
 . . . S ERROR=ERROR_"^"_"HOSPLOC NOT DEFINED"
 . . . ;
 . E  D
 . .;STORE EACH SDARRAY ELEMENT . LOOK FOR SDARRAY("FLDS") AS REQUIRED
 . .I TEMP["FLDS" S FLDS=1
 . .;D QUICK(TEMP,.SDARRAY)
 . . S AJJ3CNT1=0
 . . S IFLAG2=0
 . . S TEMP1=""
 . . ;
 . . S TEMP="S "_TEMP
 . . ;G OVER55
 . . F  S AJJ3CNT1=AJJ3CNT1+1 S AJJ3PIEC=$P(TEMP,"""",AJJ3CNT1) Q:(IFLAG2=1)  D
 . . .I AJJ3PIEC'="" D
 . . . .S AJJ3CNT2=AJJ3CNT1+1 S AJJ3PIE2=$P(TEMP,"""",AJJ3CNT2)
 . . . .I AJJ3PIE2="" D
 . . . . .S ILENX=$L(TEMP)
 . . . . .I $E(TEMP,ILENX,ILENX)="""" D
 . . . . . .S TEMP1=TEMP1_AJJ3PIEC_""""
 . . . . .E  D
 . . . . . .S TEMP1=TEMP1_AJJ3PIEC
 . . . .E  D
 . . . . .S TEMP1=TEMP1_AJJ3PIEC_""""
 . . .I AJJ3PIEC="" D
 . . . .S ILENX=$L(TEMP)
 . . . .I $E(TEMP,ILENX,ILENX)="""" D
 . . . . .S TEMP1=TEMP1_""
 . . . . .S IFLAG2=1
 . . . .E  D
 . . . . .S IFLAG2=1
OVER55 . .; 
 . . ;
 . . ;CONVERT SDARRAY TO SDARRAY1 ARRAY
 . . S TEMP1=$P(TEMP1,"SDARRAY",1)_"SDARRAY1"_$P(TEMP1,"SDARRAY",2)
 . . X TEMP1
 . . S AJJ3CNT1=0
 . . F  S AJJ3CNT1=$O(SDARRAY1(AJJ3CNT1)) Q:AJJ3CNT1=""  D
 . . .;
 . . .S SDARRAY(AJJ3CNT1)=SDARRAY1(AJJ3CNT1)
 . . ;
 . .;X TEMP
 . ;
 ;EVERY TIME GET A PID SEGMENT INCREMENT POSITION
 ;
 ;
 ;
 ;
 G SEQ
 ;
 ;
EXIT ;
 D OVERX^SDVWHLI2
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