DGQEACK ;ALB/JFP - Process VIC ACK message (Batch/Single) ; 09/01/96
;;5.3;Registration;**73,1015**;DEC 11,1996;Build 21
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; This routine will process both single and batch acknowledgements
; Format of HL7 message:
;
; -- Batch Single
; BHS MSH
; [MSH MSA
; MSA]
; BTS
;Note: This code does not handle the optional ERR segment
;
;Input : All variables set by HL7 package
;Output :
;
EN ; - entry point to process HL7 ACK message
; -- Declare variables
N EXCARR,DGQESEG,BCID,MCID,HLMSG,ACKCODE
N REFFLG,DELFLG,DGQEND,J,I,X
N REASON,DGQEMSG,DONE
;
; -- define exception array
S EXCARR="^TMP(""DGQE-ACK"","_$J_",""EXC"")"
K @EXCARR
;
I '$D(HL("FS")) S HL("FS")="^"
S HLFS=HL("FS")
S (HLMSG,DONE)=0
BLD ; -- Builds HL7 message text for error processing
D BLDMSG
START ; -- Get first segment
D NEXT Q:DONE
; -- Check for header message (BHS or MSH)
I DGQESEG="MSH" D SINGLE Q
I DGQESEG="BHS" D BATCH Q
; -- Wrong segment
S HLMSG="-1^Missing BHS or MSH segment on ACK, segment received was: "_DGQESEG
D NOTIFY(HLMSG)
Q
;
SINGLE ; -- Parse single ACK message
D NEXT Q:DONE
D MSA
; -- Delete entry from 39.4, acknowledged
S:MCID'="" DELFLG=$$DEL^DGQEHL74(MCID)
K @EXCARR
Q
;
BATCH ; -- Parse batch ACK message
; -- get batch control ID from BHS segment
S BCID=$P(DGQEND,HLFS,11)
; -- get next segment
D NEXT Q:DONE
; -- Check to see if all entries in batch successful
I DGQESEG="BTS" D DELACK Q
I DGQESEG'="MSH" D Q
.S HLMSG="-1^Missing MSH or BTS segment in processing ACK, segment received was: "_DGQESEG
.D NOTIFY(HLMSG)
.D DELACK
; -- otherwise process exception batch
D EXC
; -- Delete all transactions in batch
D DELACK
K @EXCARR
Q
;
EXC ; -- Processes of exceptions in batch ACK
D MSH Q:DONE
D NEXT Q:DONE
D MSA Q:DONE
; -- Loop through remaining entries
F D NEXT D Q:DONE
.Q:DONE
.I DGQESEG="BTS" S DONE=1 Q
.D MSH Q:DONE
.D NEXT Q:DONE
.D MSA Q:DONE
Q
;
MSH ; -- Process MSH segment
I DGQESEG'="MSH" D Q
.S HLMSG="-1^Missing MSH segment on ACK, segment received was: "_DGQESEG
.D NOTIFY(HLMSG)
.S DONE=1
Q
;
MSA ; -- Process MSA segment
I DGQESEG'="MSA" D Q
.S HLMSG="-1^Missing MSA segment on ACK, segment received was: "_DGQESEG
.D NOTIFY(HLMSG)
.S DONE=1
; -- Extract Segment MSA segment Data
S ACKCODE=$P(DGQEND,HLFS,1)
S MCID=$P(DGQEND,HLFS,2)
; -- Check for error
I ACKCODE'="AA" D Q
.S @EXCARR@(MCID)=""
.S REASON="-1^"_$P(DGQEND,HLFS,3)
.S REFFLG=$$REJ^DGQEHL74(MCID,"1",REASON)
.D NOTIFY(REASON)
Q
;
DELACK ; -- Deletes all entries from 39.4, related to message ID
Q:BCID=""
N ID
S ID=BCID_"-0"
F S ID=$O(^VAT(39.4,"B",ID)) Q:$P(ID,"-")'=BCID D
.S:ID'="" DELFLG=$$DEL^DGQEHL74(ID)
Q
;
NEXT ; -- Gets the next HL7 segment to process
S (DGQESEG,DGQEND)=""
X HLNEXT
I HLQUIT'>0 S DONE=1 Q
S DGQEND=HLNODE
; -- Check for segment lengths greater than 245
I $D(HLNODE(1)) D
.S J=0
.F S J=$O(HLNODE(J)) Q:'J S DGQEND=DGQEND_HLNODE(J)
; -- Pull off segment
S DGQESEG=$E(DGQEND,1,3)
S DGQEND=$P(DGQEND,HLFS,2,9999)
Q
;
BLDMSG ; -- GET MESSAGE TEXT
F I=1:1 X HLNEXT Q:(HLQUIT'>0) D
.S DGQEMSG(I,1)=HLNODE
.; -- Check for segment lengths greater than 245
.S X=0 F S X=+$O(HLNODE(X)) Q:('X) S DGQEMSG(I,(X+1))=HLNODE(X)
Q
;
NOTIFY(REASON) ; -- Sends error bulletin on negative acknowledgment
;Input: REASON - problem with acknowledgment
; DGQEMSG() - Array containing HL7 message that was received
;Output: None
;
; -- Check input, reason in piece 2
Q:'$D(REASON)
S REASON=$P($G(REASON),"^",2)
; -- Declare variables
N MSGTXT,XMB,XMTEXT,XMY,XMDUZ,XMDT,XMZ,LINE
; -- Send message text
S MSGTXT(1)="Acknowledgment received from photo capture station"
S MSGTXT(2)="with the following problem:"
S MSGTXT(3)=" "
S MSGTXT(4)=" ** "_REASON
; -- Check to see if hl7 message is available for display
N X,Y
I $D(DGQEMSG(1)) D
.S MSGTXT(5)=" "
.S MSGTXT(6)="The message received looks like this: "
.S MSGTXT(7)=" "
.S LINE=8,X=0
.F S X=+$O(DGQEMSG(X)) Q:('X) D
..S Y=0
..F S Y=+$O(DGQEMSG(X,Y)) Q:('Y) D
...S MSGTXT(LINE)=DGQEMSG(X,Y)
...S LINE=LINE+1
; -- Send bulletin subject
S XMB(1)="** Problem with ACK for VIC **"
; -- Deliver bulletin
S XMB="DGQE PHOTO CAPTURE"
S XMTEXT="MSGTXT("
D ^XMB
Q
;
END ; -- End of code
Q
DGQEACK ;ALB/JFP - Process VIC ACK message (Batch/Single) ; 09/01/96
+1 ;;5.3;Registration;**73,1015**;DEC 11,1996;Build 21
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; This routine will process both single and batch acknowledgements
+5 ; Format of HL7 message:
+6 ;
+7 ; -- Batch Single
+8 ; BHS MSH
+9 ; [MSH MSA
+10 ; MSA]
+11 ; BTS
+12 ;Note: This code does not handle the optional ERR segment
+13 ;
+14 ;Input : All variables set by HL7 package
+15 ;Output :
+16 ;
EN ; - entry point to process HL7 ACK message
+1 ; -- Declare variables
+2 NEW EXCARR,DGQESEG,BCID,MCID,HLMSG,ACKCODE
+3 NEW REFFLG,DELFLG,DGQEND,J,I,X
+4 NEW REASON,DGQEMSG,DONE
+5 ;
+6 ; -- define exception array
+7 SET EXCARR="^TMP(""DGQE-ACK"","_$JOB_",""EXC"")"
+8 KILL @EXCARR
+9 ;
+10 IF '$DATA(HL("FS"))
SET HL("FS")="^"
+11 SET HLFS=HL("FS")
+12 SET (HLMSG,DONE)=0
BLD ; -- Builds HL7 message text for error processing
+1 DO BLDMSG
START ; -- Get first segment
+1 DO NEXT
IF DONE
QUIT
+2 ; -- Check for header message (BHS or MSH)
+3 IF DGQESEG="MSH"
DO SINGLE
QUIT
+4 IF DGQESEG="BHS"
DO BATCH
QUIT
+5 ; -- Wrong segment
+6 SET HLMSG="-1^Missing BHS or MSH segment on ACK, segment received was: "_DGQESEG
+7 DO NOTIFY(HLMSG)
+8 QUIT
+9 ;
SINGLE ; -- Parse single ACK message
+1 DO NEXT
IF DONE
QUIT
+2 DO MSA
+3 ; -- Delete entry from 39.4, acknowledged
+4 IF MCID'=""
SET DELFLG=$$DEL^DGQEHL74(MCID)
+5 KILL @EXCARR
+6 QUIT
+7 ;
BATCH ; -- Parse batch ACK message
+1 ; -- get batch control ID from BHS segment
+2 SET BCID=$PIECE(DGQEND,HLFS,11)
+3 ; -- get next segment
+4 DO NEXT
IF DONE
QUIT
+5 ; -- Check to see if all entries in batch successful
+6 IF DGQESEG="BTS"
DO DELACK
QUIT
+7 IF DGQESEG'="MSH"
Begin DoDot:1
+8 SET HLMSG="-1^Missing MSH or BTS segment in processing ACK, segment received was: "_DGQESEG
+9 DO NOTIFY(HLMSG)
+10 DO DELACK
End DoDot:1
QUIT
+11 ; -- otherwise process exception batch
+12 DO EXC
+13 ; -- Delete all transactions in batch
+14 DO DELACK
+15 KILL @EXCARR
+16 QUIT
+17 ;
EXC ; -- Processes of exceptions in batch ACK
+1 DO MSH
IF DONE
QUIT
+2 DO NEXT
IF DONE
QUIT
+3 DO MSA
IF DONE
QUIT
+4 ; -- Loop through remaining entries
+5 FOR
DO NEXT
Begin DoDot:1
+6 IF DONE
QUIT
+7 IF DGQESEG="BTS"
SET DONE=1
QUIT
+8 DO MSH
IF DONE
QUIT
+9 DO NEXT
IF DONE
QUIT
+10 DO MSA
IF DONE
QUIT
End DoDot:1
IF DONE
QUIT
+11 QUIT
+12 ;
MSH ; -- Process MSH segment
+1 IF DGQESEG'="MSH"
Begin DoDot:1
+2 SET HLMSG="-1^Missing MSH segment on ACK, segment received was: "_DGQESEG
+3 DO NOTIFY(HLMSG)
+4 SET DONE=1
End DoDot:1
QUIT
+5 QUIT
+6 ;
MSA ; -- Process MSA segment
+1 IF DGQESEG'="MSA"
Begin DoDot:1
+2 SET HLMSG="-1^Missing MSA segment on ACK, segment received was: "_DGQESEG
+3 DO NOTIFY(HLMSG)
+4 SET DONE=1
End DoDot:1
QUIT
+5 ; -- Extract Segment MSA segment Data
+6 SET ACKCODE=$PIECE(DGQEND,HLFS,1)
+7 SET MCID=$PIECE(DGQEND,HLFS,2)
+8 ; -- Check for error
+9 IF ACKCODE'="AA"
Begin DoDot:1
+10 SET @EXCARR@(MCID)=""
+11 SET REASON="-1^"_$PIECE(DGQEND,HLFS,3)
+12 SET REFFLG=$$REJ^DGQEHL74(MCID,"1",REASON)
+13 DO NOTIFY(REASON)
End DoDot:1
QUIT
+14 QUIT
+15 ;
DELACK ; -- Deletes all entries from 39.4, related to message ID
+1 IF BCID=""
QUIT
+2 NEW ID
+3 SET ID=BCID_"-0"
+4 FOR
SET ID=$ORDER(^VAT(39.4,"B",ID))
IF $PIECE(ID,"-")'=BCID
QUIT
Begin DoDot:1
+5 IF ID'=""
SET DELFLG=$$DEL^DGQEHL74(ID)
End DoDot:1
+6 QUIT
+7 ;
NEXT ; -- Gets the next HL7 segment to process
+1 SET (DGQESEG,DGQEND)=""
+2 XECUTE HLNEXT
+3 IF HLQUIT'>0
SET DONE=1
QUIT
+4 SET DGQEND=HLNODE
+5 ; -- Check for segment lengths greater than 245
+6 IF $DATA(HLNODE(1))
Begin DoDot:1
+7 SET J=0
+8 FOR
SET J=$ORDER(HLNODE(J))
IF 'J
QUIT
SET DGQEND=DGQEND_HLNODE(J)
End DoDot:1
+9 ; -- Pull off segment
+10 SET DGQESEG=$EXTRACT(DGQEND,1,3)
+11 SET DGQEND=$PIECE(DGQEND,HLFS,2,9999)
+12 QUIT
+13 ;
BLDMSG ; -- GET MESSAGE TEXT
+1 FOR I=1:1
XECUTE HLNEXT
IF (HLQUIT'>0)
QUIT
Begin DoDot:1
+2 SET DGQEMSG(I,1)=HLNODE
+3 ; -- Check for segment lengths greater than 245
+4 SET X=0
FOR
SET X=+$ORDER(HLNODE(X))
IF ('X)
QUIT
SET DGQEMSG(I,(X+1))=HLNODE(X)
End DoDot:1
+5 QUIT
+6 ;
NOTIFY(REASON) ; -- Sends error bulletin on negative acknowledgment
+1 ;Input: REASON - problem with acknowledgment
+2 ; DGQEMSG() - Array containing HL7 message that was received
+3 ;Output: None
+4 ;
+5 ; -- Check input, reason in piece 2
+6 IF '$DATA(REASON)
QUIT
+7 SET REASON=$PIECE($GET(REASON),"^",2)
+8 ; -- Declare variables
+9 NEW MSGTXT,XMB,XMTEXT,XMY,XMDUZ,XMDT,XMZ,LINE
+10 ; -- Send message text
+11 SET MSGTXT(1)="Acknowledgment received from photo capture station"
+12 SET MSGTXT(2)="with the following problem:"
+13 SET MSGTXT(3)=" "
+14 SET MSGTXT(4)=" ** "_REASON
+15 ; -- Check to see if hl7 message is available for display
+16 NEW X,Y
+17 IF $DATA(DGQEMSG(1))
Begin DoDot:1
+18 SET MSGTXT(5)=" "
+19 SET MSGTXT(6)="The message received looks like this: "
+20 SET MSGTXT(7)=" "
+21 SET LINE=8
SET X=0
+22 FOR
SET X=+$ORDER(DGQEMSG(X))
IF ('X)
QUIT
Begin DoDot:2
+23 SET Y=0
+24 FOR
SET Y=+$ORDER(DGQEMSG(X,Y))
IF ('Y)
QUIT
Begin DoDot:3
+25 SET MSGTXT(LINE)=DGQEMSG(X,Y)
+26 SET LINE=LINE+1
End DoDot:3
End DoDot:2
End DoDot:1
+27 ; -- Send bulletin subject
+28 SET XMB(1)="** Problem with ACK for VIC **"
+29 ; -- Deliver bulletin
+30 SET XMB="DGQE PHOTO CAPTURE"
+31 SET XMTEXT="MSGTXT("
+32 DO ^XMB
+33 QUIT
+34 ;
END ; -- End of code
+1 QUIT
