267 lines
8.9 KiB
Mathematica
267 lines
8.9 KiB
Mathematica
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
|