source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDVWHLI1.m@ 1005

SDVWHLI1 ;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
 ;
SDAPIACK ; APPLICATION ACKNOWLEDGE TO SDAPI REQUEST
 N EXTRET,ERROR2,LOCACKCD,ACKCDER,TEMP8,SEG
 N ERR,ERROR3,HLMSTATE,WHO,APPARMS,XQ,RETURN1,IJCOUNT ; NEW ONES SO CANNOT USE OLD HLMSTATE TO RETURN REAL ACK
 S EXTRET=0
 ;S SEG=""
 S ERROR2=""
 S XQ=""
 ;
 ;
 ; SEND ACK MESSAGE COMMENTED OUT BELOW. INSTEAD JUST SEND NORMAL MESSAGE WITH ADDED SEGMENTS
 ;
 ;;;;S APPARMS("ACK CODE")="AA"
 ;;;;S APPARMS("ACCEPT ACK TYPE")="NE"
 ;;;;I (ERROR'="")!(SDCOUNT<0) D
 ;;;;.S APPARMS("ACK CODE")="AE"
 ;;;.S APPARMS("ERROR MESSAGE")=ERROR_"^"_SDCOUNT
 ;;;;S APPARMS("MESSAGE TYPE")="ACK"
 ;;;;;S APPARMS("EVENT")="A19"
 ;;
 ;;
 S APPARMS("MESSAGE TYPE")="ADT"
 S APPARMS("EVENT")="A19" ; RESPONSE
 S APPARMS("COUNTRY")="USA"
 S APPARMS("FIELD SEPARATOR")="|"
 S APPARMS("ENCODING CHARACTERS")="^~\&"
 S APPARMS("VERSION")=2.4
 ;
 ;
 S APPARMS("SECURITY")=MSGCTRL
 ;ANALOGY FOR ACK FOR MAKE APPT BELOW
 I MAKEAPPT=1 D
 .S APPARMS("EVENT")="A08"
 .I IER=1 D
 ..S APPARMS("SECURITY")=MSGCTRL_"#"_"AA"
 .E  D
 ..S APPARMS("SECURITY")=MSGCTRL_"#"_"AE"
 ;
 ;
 ;
 ;DON'T USE ACK MESSAGE START , JUST REGULAR MESSAGE START
 ;START THE APPLICATION ACKNOWLEDGE MESSAGE
 ;;;I '$$ACK^HLOAPI2(.HLMSTATE,.APPARMS,.ACK,.ERROR1) S ERETURN="START ACK MESSAGE"
 ;;;
 ;;;
 ;;;
 ;;; JUMP OVER THIS AS ADDSEG^HLOAPI DOES NOT RETURN WITH A START APPLICATION ACKNOWLEDGE 
 ;;;D SET^HLOAPI(.SEG,"MSA",0) ;creates an MSA segment
 ;;;S LOCACKCD="AA"
 ;;;S ACKCDER=""
 ;;;I (ERROR'="")!(SDCOUNT<0) D
 ;;;.S LOCACKCD="AE"
 ;;;.S ACKCDER=ERROR_"^"_SDCOUNT
 ;;;D SET^HLOAPI(.SEG,LOCACKCD,1) ; "AA' OR "AE"
 ;;;D SET^HLOAPI(.SEG,MSGCTRL,2) ;=MSGCTRL 
    ;;;D SET^HLOAPI(.SEG,ACKCDER,3) ;will place the value into the array position
 ;;;
 ;;;
 ;;; ADD SEGMENT
 ;;;I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERROR2) S ERETURN="MSA"
 ;;;
 ;
 ;;CREATE NEW MESSAGE
 ;;
 ;
 S ERR=""
 S ERROR3=""
 S ERROR1=""
 ;
 I MAKEAPPT=1 D
 .I '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR3) S ERETURN="NEW MESSAGE ERROR"
 ;          
 I (MAKEAPPT'=1)&(SDCOUNT'>0) D
 .I '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR3) S ERETURN="NEW MESSAGE ERROR"
 ;JUMP OVER CREATE MSA SEGMENT OURSELF FOR A NON-ACK MESSAGE
 G OVERA
 ;Use message control ID in MSH segment for sync flag later in returned application ack 
 ;
 ;;CREATE SEGMENT
 ;
 ;EXPERIMENT . BUILD MSA SEGMENT BY ITSELF
 ;
 D SET^HLOAPI(.SEG,"MSA",0) ;creates an MSA segment
 S LOCACKCD="AA"
 S ACKCDER=""
 I (ERROR'="")!(SDCOUNT<0) D
 .S LOCACKCD="AE"
 .S ACKCDER=ERROR_"^"_SDCOUNT
 D SET^HLOAPI(.SEG,LOCACKCD,1) ; "AA' OR "AE"
 D SET^HLOAPI(.SEG,MSGCTRL,2) ;=MSGCTRL 
    D SET^HLOAPI(.SEG,ACKCDER,3) ;will place the value into the array position
 ;;;
 ;;;
 ;;; ADD SEGMENT
 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERROR2) S ERETURN="MSA"
OVERA ;
 ;
 ;
 ;
 ; ADD ERR SEGMENT IF NEEDED
 ;
    ;I (MAKEAPPT=1) I IER=1 S IER=0
    I (MAKEAPPT=1)!((MAKEAPPT'=1)&(SDCOUNT'>0)) D
 .I (ERETURN'=0)!(ERROR'="")!(SDCOUNT<0)!(ERROR1'="")!(IER'=1) S EXTRET=$$ERRORW(XQ)
 ;
 ;
 ;;CREATE SEGMENT QRD
 ;
 ; PUT N SORT METHOD FOR APPT RETURNED AND SDCOUNT VALUE
 ; ADD ADT ACK SEGMENT FOR MAKE APPT
 I MAKEAPPT=1 D
 .D SET^HLOAPI(.SEG,"PID",0)
 .D SET^HLOAPI(.SEG,DFN,3)
 .S SDFNNAME=$P($G(^DPT(DFN,0)),"^",1)
 .D SET^HLOAPI(.SEG,SDFNNAME,5)
 .S SDFNSSN=$P($G(^DPT(DFN,0)),"^",9)
 .D SET^HLOAPI(.SEG,SDFNSSN,19)
 .;
 .;; ADD SEGMENT
 .I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="PID"
 ;
 I MAKEAPPT=1 G OVERT
 I (MAKEAPPT'=1)&(SDCOUNT'>0) D
 .D SET^HLOAPI(.SEG,"QRD",0)
 .D SET^HLOAPI(.SEG,$$HLDATE^HLFNC($$NOW^XLFDT(),"TS"),1)
 .D SET^HLOAPI(.SEG,ORDRSORT,8)
 .I (ERROR="")&(SDCOUNT'="") D SET^HLOAPI(.SEG,SDCOUNT,11)
 .;
 .;
 .;
 .;; ADD SEGMENT
 .I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERR="QRD"
 .I $D(ERROR2) D
 ..;
 .E  D
 ..;
 ;;CREATE SEGMENT EVN
 ;
 ; PUT IN ADT A19 RETURN , BUT THIS MAY ALREADY BE THERE FROM APPARMS("EVENT")FROM ORIGINAL RECEIVED MESSAGE, BUT THIS CREATES EVENT 
 ;SEGMENT BELOW NOT ALREADY CREATED SINCE THIS IS REQUIRED TO SEND A NEW MSG WHICH IS WHAT THIS APP ACK IS.
 ;
 ;;D SET^HLOAPI(.SEG,"EVN",0)
 ;;D SET^HLOAPI(.SEG,"A19",1)
 ;;D SET^HLOAPI(.SEG,$$HLDATE^HLFNC($$NOW^XLFDT(),"TS"),2)
 ;
 ;; ADD SEGMENT
 ;;I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="EVN"
 ;
 ;
 ;
 ;I ORDRSORT="P" S SDCLIEN=$O(^TMP($J,"SDAMA301",DFN,SDCLIEN)) LAST SDATE
 ;I ORDRSORT="C" S SDDFN=$O(^TMP($J,"SDAMA301",CLINIEN,SDDFN)) LAST SDDATE
 ;I ORDRSORT="PS" S SDDATE=$O(^TMP($J,"SDAMA301",PATIENTID,CLINIEN)) LAST SDDATE
 ;I ORDRSORT="CN" S SDDFN=$O(^TMP($J,"SDAMA301",SDCLIEN,SDDFN)) LAST SDDATE
 I SDCOUNT>0 D
 .;CREATE MULTIPLES OF PID,PV1,PV2,NTE,NTE SEGMENTS FOR EACH APPOINTMENT/UNSCHEDULED VISIT RETURNED
 .;;
 .;DETERMINE FROM SORT ORDER IF $ORDER NEEDED TO GET DFN OR WHETHER ALREADY SPECIFIED THE SAME AS SUCH IN
 .;INPUT PARAMETERS
 .;
 .;FIRST ORDRSORT="P"
 .S IJCOUNT=0
 .I ($P(ORDRSORT,",",1)="P")&($G(SDARRAY("SORT"))="") D
 ..S SDCLIEN=0
 ..F  S SDCLIEN=$O(^TMP($J,"SDAMA301",DFN,SDCLIEN)) Q:SDCLIEN=""  D
 ...S SDDATE=0 F  S SDDATE=$O(^TMP($J,"SDAMA301",DFN,SDCLIEN,SDDATE)) Q:SDDATE=""  D
 ....S SDAPPT=$G(^TMP($J,"SDAMA301",DFN,SDCLIEN,SDDATE))
 ....S IJCOUNT=IJCOUNT+1
 ....D CYCLE^SDVWHLI3(DFN,SDCLIEN,SDDATE,SDAPPT,.ERETURN)
 .I ($P(ORDRSORT,",",1)="P")&($G(SDARRAY("SORT"))="C") D
 ..S SDCLIEN=0
 ..F  S SDCLIEN=$O(^TMP($J,"SDAMA301",SDCLIEN)) Q:SDCLIEN=""  D
 ...S SDDATE=0 F  S SDDATE=$O(^TMP($J,"SDAMA301",SDCLIEN,SDDATE)) Q:SDDATE=""  D
 ....S SDAPPT=$G(^TMP($J,"SDAMA301",SDCLIEN,SDDATE))
 ....S IJCOUNT=IJCOUNT+1
 ....D CYCLE^SDVWHLI3(DFN,SDCLIEN,SDDATE,SDAPPT,.ERETURN)
 .I ($P(ORDRSORT,",",1)="PS") D
 ..S SDDATE=0 F  S SDDATE=$O(^TMP($J,"SDAMA301",DFN,CLINIEN,SDDATE)) Q:SDDATE=""  D
 ...S SDAPPT=$G(^TMP($J,"SDAMA301",DFN,CLINIEN,SDDATE))
 ...S IJCOUNT=IJCOUNT+1
 ...D CYCLE^SDVWHLI3(DFN,CLINIEN,SDDATE,SDAPPT,.ERETURN)
 .I ($P(ORDRSORT,",",1)="C")&($G(SDARRAY("SORT"))="") D
 ..S SDDFN=0
 ..F  S SDDFN=$O(^TMP($J,"SDAMA301",CLINIEN,SDDFN)) Q:SDDFN=""  D
 ...S SDDATE=0 F  S SDDATE=$O(^TMP($J,"SDAMA301",CLINIEN,SDDFN,SDDATE)) Q:SDDATE=""  D
 ....S SDAPPT=$G(^TMP($J,"SDAMA301",CLINIEN,SDDFN,SDDATE))
 ....S IJCOUNT=IJCOUNT+1
 ....D CYCLE^SDVWHLI3(SDDFN,CLINIEN,SDDATE,SDAPPT,.ERETURN)
 .I ($P(ORDRSORT,",",1)="C")&($G(SDARRAY("SORT"))="P") D
 ..S SDDFN=0
 ..F  S SDDFN=$O(^TMP($J,"SDAMA301",SDDFN)) Q:SDDFN=""  D
 ...S SDDATE=0 F  S SDDATE=$O(^TMP($J,"SDAMA301",SDDFN,SDDATE)) Q:SDDATE=""  D
 ....S SDAPPT=$G(^TMP($J,"SDAMA301",SDDFN,SDDATE))
 ....S IJCOUNT=IJCOUNT+1
 ....D CYCLE^SDVWHLI3(SDDFN,CLINIEN,SDDATE,SDAPPT,.ERETURN)
 .I $P(ORDRSORT,",",1)="CN" D
 ..S SDCLIEN=0
 ..F  S SDDFN=$O(^TMP($J,"SDAMA301",SDCLIEN)) Q:SDCLIEN=""  D
 ...S SDDFN=0
 ...F  S SDDFN=$O(^TMP($J,"SDAMA301",SDCLIEN,SDDFN)) Q:SDDFN=""  D
 ....S SDDATE=0 F  S SDDATE=$O(^TMP($J,"SDAMA301",SDCLIEN,SDDFN,SDDATE)) Q:SDDATE=""  D
 .....S SDAPPT=$G(^TMP($J,"SDAMA301",SDCLIEN,SDDFN,SDDATE))
 .....S IJCOUNT=IJCOUNT+1
 .....D CYCLE^SDVWHLI3(SDDFN,SDCLIEN,SDDATE,SDAPPT,.ERETURN)
 I SDCOUNT>0 Q
 ;
 ; 
 ;;;;;;I (ERETURN'=0)!(ERROR'="")!(EXTRET'=0)!(SDCOUNT<0)!(ERROR1'="") S APPARMS("ACK CODE")="AE"
 ;
 ; NOT SEND APPLICATION ACKNOWLEDGEMENT.JUST REGULAE SEND ONE MESSAGE 
 ;
 ;;;;;;I $$SENDACK^HLOAPI2(.ACK,.ERROR1) S ERETURN="SENDAPPACK"
 ;
 ; DEFINE SENDING AND RECEIVING PARAMETERS
OVERT S APPARMS("SENDING APPLICATION")="VWSD RECEIVER"
 S APPARMS("ACCEPT ACK TYPE")="NE" ;"AL"
 ;S APPARMS("APP ACK RESPONSE")="APPACKRR^SDVWHLIN"
 ;S APPARMS("ACCEPT ACK RESPONSE")="MSGPROC^SDVWHLIN"
 ;REVERSE BELOW 
 S APPARMS("ACCEPT ACK RESPONSE")="APPACKRR^SDVWHLIN" ; WHEN COMIT ACK , SU OR AE RETURN MADE
 S APPARMS("APP ACK RESPONSE")="MSGPROC^SDVWHLIN" ; WHEN NO ACK RETURN MADE 
 S APPARMS("APP ACK TYPE")="NE" ;"AL"
 S WHO("RECEIVING APPLICATION")="VWSD HLO EXT"
 S WHO("FACILITY LINK NAME")="VWSD_PEASL"
 ;
 ;SEND MESSAGE
 ;
 S ERROR3=""
 S RETURN1=$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.WHO,.ERROR3)
 ;;;;;I '$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.WHO,.ERROR3) Q ;Q "ERR="_ERR_" ERROR="_ERROR
 ;;
 ;
 Q
ERRORW(X) ;ERROR SEGMENT (WITH ERETURN'=0,PATIENT,CLINIC,OR OTHER SDCOUNT ERROR )
 ;;CREATE SEGMENT
 ;
 N CONSTRUC,ERROR2
 S ERROR2=""
 D SET^HLOAPI(.SEG,"ERR",0)
 ;
 S CONSTRUC="ERETURN="_ERETURN_" ERROR="_ERROR_"^"_" IER="_IER_" SDCOUNT="_SDCOUNT
 ;
 D SET^HLOAPI(.SEG,CONSTRUC,1)
 ;
 ;
 ;; ADD SEGMENT
 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) Q "ERR"
 ;
 Q 0