DGROHLR ;DJH/AMA - ROM HL7 RECEIVE DRIVERS ; 10/20/10 10:55am
;;5.3;Registration;**533,572,754,797**;Aug 13, 1993;Build 24
;
RCV ;Receive all message types and route to message specific receiver
;
;This procedure is the main driver entry point for receiving all
;message types (ACK, QRY and ORF) for Register Once Messaging.
;
;All procedures and functions assume that all VistA HL7 environment
;variables are properly initialized and will produce a fatal error if
;they are missing.
;
;The received message is copied to a temporary work global for
;processing. The message type is determined from the MSH segment and
;a receive processing procedure specific to the message type is called.
;(Ex. ORF~R01 message calls procedure: RCVORF). The specific receive
;processing procedure calls a message specific parse procedure to
;validate the message data and return data arrays for storage. If no
;parse errors are reported during validation, then the data arrays are
;stored by the receive processing procedure. Control, along with any
;parse validation errors, is then passed to the message specific send
;processing procedures to build and transmit the acknowledgment and
;query results messages.
;
; The message specific procedures are as follows:
;
; Message Receive Procedure Parse Procedure Send Procedure
; ------- ----------------- ---------------- --------------
; SNDACK^DGROHLS
; ACK~R01 RCVACK^DGROHLR PARSACK^DGROHLU4 N/A
; QRY~R02 RCVQRY^DGROHLR PARSQRY^DGROHLQ3 SNDORF^DGROHLS
; ORF~R01 RCVORF^DGROHLR PARSORF^DGROHLQ3 N/A
;
N DGCNT,DGMSGTYP,DGSEG,DGSEGCNT,DGWRK
;
S DGWRK=$NA(^TMP("DGROHL7",$J))
K @DGWRK
;
;load work global with segments
F DGSEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
. S DGCNT=0
. S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE
. F S DGCNT=$O(HLNODE(DGCNT)) Q:'DGCNT D
. . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE(DGCNT)
;
;get message type from "MSH"
I $$NXTSEG^DGROHLUT(DGWRK,0,HL("FS"),.DGSEG),$G(DGSEG("TYPE"))="MSH" D
. S DGMSGTYP=$P(DGSEG(9),$E(HL("ECH"),1),1)
. ;HLMTIENS is only required by RCVORU and RCVQRY, thus $GET
. I DGMSGTYP="" S (DGMSGTYP,HL("MTN"))="ORF",HLMTIENS=HLMTIEN
. I DGMSGTYP=HL("MTN") D @("RCV"_DGMSGTYP_"(DGWRK,$G(HLMTIENS),.HL)")
;
;cleanup
K @DGWRK
Q
;
RCVACK(DGWRK,DGMIEN,DGHL) ;Receive ACK Message Types (ACK~R01)
;
; Input:
; DGWRK - name of work global containing segments
; DGMIEN - IEN of message entry in file #773
; DGHL - HL environment array
;
; Output:
; none
;
N DGACK ;ACK data array
N DGERR ;error array
N DGLIEN ;HL7 transmission log IEN
N DGROL ;HL7 transmssion log data array
;
S ACKCODE=0
D PARSACK^DGROHLU4(DGWRK,.DGHL,.DGACK,.DGERR)
I $G(DGACK("ACKCODE"))'="AA" S ACKCODE=1
Q
;
RCVQRY(DGWRK,DGMIEN,DGHL) ;Receive QRY Message Types (QRY~R02)
;
; Input:
; DGWRK - name of work global containing segments
; DGMIEN - IEN of message entry in file #773
; DGHL - HL environment array
;
; Output:
; none
;
N DGDFN,DGQRY,DGQRYERR,DGSEGERR
;
D PARSQRY^DGROHLQ3(DGWRK,.DGHL,.DGQRY,.DGSEGERR)
S DGDFN=$$GETDFN^DGROUT2(DGQRY("ICN"),DGQRY("DOB"),DGQRY("SSN"))
I DGDFN'>0 D
. S DGQRYERR="NM"
. ;
. ;THE ICN FROM THE MPI DOES NOT MATCH A PATIENT, SO NOTIFY THE MPI
. D MPIMAIL^DGROMAIL(.DGQRY)
. ;
D SNDORF^DGROHLS(.DGQRY,DGMIEN,.DGHL,DGDFN,.DGSEGERR,.DGQRYERR)
Q
;
RCVORF(DGWRK,DGMIEN,DGHL) ;Receive ORF Message Types (ORF~R01)
;
; Input:
; DGWRK - name of work global containing segments, ^TMP("DGROHL7",$J)
; DGMIEN - IEN of message entry in file #773
; DGHL - HL environment array
;
; Output:
; none
;
N DGDATA ;patient data array to upload
N DGERR ;parse error array
N DGORF ;ORF data array
;
S DGDATA=$NA(^TMP("DGROFDA",$J)) K @DGDATA
D PARSORF^DGROHLQ3(DGWRK,.DGHL,.DGORF,.DGERR,.DGDATA)
;
I $D(DGROVRCK) DO
. S:('$D(DGORF("PATCH"))) DGROVRCK=0
. I ($D(DGORF("PATCH"))),(+DGORF("PATCH")'=572) S DGROVRCK=0
;
;* QUIT conditions
Q:'$D(DGORF)
Q:(+$G(DGORF("DFN"))'>0)
Q:'$D(^DPT(DGORF("DFN"),0))
Q:('$D(DGORF("PATCH")))
;Q:(+DGORF("PATCH")'=572)
;
S DFN=DGORF("DFN")
;
;Get DFN at Last Site Treated
S LSTDFN=+$O(@DGDATA@(2,""))
;CHECK BUSINESS RULES
D AO^DGRODEBR(DGDATA,DFN,LSTDFN) ;AGENT ORANGE EXPOSURE
D IR^DGRODEBR(DGDATA,DFN,LSTDFN) ;RADIATION EXPOSURE
D DOD^DGRODEBR(DGDATA,DFN,LSTDFN) ;DATE OF DEATH
D TA^DGRODEBR(DGDATA,LSTDFN) ;TEMPORARY ADDRESS
D SP^DGRODEBR(DGDATA,DFN,LSTDFN) ;SENSITIVE PATIENT
D CA^DGRODEBR(DGDATA,LSTDFN) ;CONFIDENTIAL ADDRESS
D SWA^DGRODEBR(DGDATA,DFN,LSTDFN) ;SOUTHWEST ASIA CONDITIONS
D INC^DGRODEBR(DGDATA,DFN,LSTDFN) ;RULED INCOMPETENT
D INE^DGRODEBR(DGDATA,DFN,LSTDFN) ;INELIGIBLE
D RDOC^DGRODEBR(DGDATA,DFN,LSTDFN) ;RECENT DATE(S) OF CARE
D MSE^DGRODEBR(DGDATA,LSTDFN) ;MILITARY SERVICE EPISODES
;
;File the data
D CONVFDA^DGROHLR1(DFN,DGDATA)
;CLEAN UP
K @DGDATA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGROHLR 5141 printed Dec 13, 2024@02:55:15 Page 2
DGROHLR ;DJH/AMA - ROM HL7 RECEIVE DRIVERS ; 10/20/10 10:55am
+1 ;;5.3;Registration;**533,572,754,797**;Aug 13, 1993;Build 24
+2 ;
RCV ;Receive all message types and route to message specific receiver
+1 ;
+2 ;This procedure is the main driver entry point for receiving all
+3 ;message types (ACK, QRY and ORF) for Register Once Messaging.
+4 ;
+5 ;All procedures and functions assume that all VistA HL7 environment
+6 ;variables are properly initialized and will produce a fatal error if
+7 ;they are missing.
+8 ;
+9 ;The received message is copied to a temporary work global for
+10 ;processing. The message type is determined from the MSH segment and
+11 ;a receive processing procedure specific to the message type is called.
+12 ;(Ex. ORF~R01 message calls procedure: RCVORF). The specific receive
+13 ;processing procedure calls a message specific parse procedure to
+14 ;validate the message data and return data arrays for storage. If no
+15 ;parse errors are reported during validation, then the data arrays are
+16 ;stored by the receive processing procedure. Control, along with any
+17 ;parse validation errors, is then passed to the message specific send
+18 ;processing procedures to build and transmit the acknowledgment and
+19 ;query results messages.
+20 ;
+21 ; The message specific procedures are as follows:
+22 ;
+23 ; Message Receive Procedure Parse Procedure Send Procedure
+24 ; ------- ----------------- ---------------- --------------
+25 ; SNDACK^DGROHLS
+26 ; ACK~R01 RCVACK^DGROHLR PARSACK^DGROHLU4 N/A
+27 ; QRY~R02 RCVQRY^DGROHLR PARSQRY^DGROHLQ3 SNDORF^DGROHLS
+28 ; ORF~R01 RCVORF^DGROHLR PARSORF^DGROHLQ3 N/A
+29 ;
+30 NEW DGCNT,DGMSGTYP,DGSEG,DGSEGCNT,DGWRK
+31 ;
+32 SET DGWRK=$NAME(^TMP("DGROHL7",$JOB))
+33 KILL @DGWRK
+34 ;
+35 ;load work global with segments
+36 FOR DGSEGCNT=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+37 SET DGCNT=0
+38 SET @DGWRK@(DGSEGCNT,DGCNT)=HLNODE
+39 FOR
SET DGCNT=$ORDER(HLNODE(DGCNT))
if 'DGCNT
QUIT
Begin DoDot:2
+40 SET @DGWRK@(DGSEGCNT,DGCNT)=HLNODE(DGCNT)
End DoDot:2
End DoDot:1
+41 ;
+42 ;get message type from "MSH"
+43 IF $$NXTSEG^DGROHLUT(DGWRK,0,HL("FS"),.DGSEG)
IF $GET(DGSEG("TYPE"))="MSH"
Begin DoDot:1
+44 SET DGMSGTYP=$PIECE(DGSEG(9),$EXTRACT(HL("ECH"),1),1)
+45 ;HLMTIENS is only required by RCVORU and RCVQRY, thus $GET
+46 IF DGMSGTYP=""
SET (DGMSGTYP,HL("MTN"))="ORF"
SET HLMTIENS=HLMTIEN
+47 IF DGMSGTYP=HL("MTN")
DO @("RCV"_DGMSGTYP_"(DGWRK,$G(HLMTIENS),.HL)")
End DoDot:1
+48 ;
+49 ;cleanup
+50 KILL @DGWRK
+51 QUIT
+52 ;
RCVACK(DGWRK,DGMIEN,DGHL) ;Receive ACK Message Types (ACK~R01)
+1 ;
+2 ; Input:
+3 ; DGWRK - name of work global containing segments
+4 ; DGMIEN - IEN of message entry in file #773
+5 ; DGHL - HL environment array
+6 ;
+7 ; Output:
+8 ; none
+9 ;
+10 ;ACK data array
NEW DGACK
+11 ;error array
NEW DGERR
+12 ;HL7 transmission log IEN
NEW DGLIEN
+13 ;HL7 transmssion log data array
NEW DGROL
+14 ;
+15 SET ACKCODE=0
+16 DO PARSACK^DGROHLU4(DGWRK,.DGHL,.DGACK,.DGERR)
+17 IF $GET(DGACK("ACKCODE"))'="AA"
SET ACKCODE=1
+18 QUIT
+19 ;
RCVQRY(DGWRK,DGMIEN,DGHL) ;Receive QRY Message Types (QRY~R02)
+1 ;
+2 ; Input:
+3 ; DGWRK - name of work global containing segments
+4 ; DGMIEN - IEN of message entry in file #773
+5 ; DGHL - HL environment array
+6 ;
+7 ; Output:
+8 ; none
+9 ;
+10 NEW DGDFN,DGQRY,DGQRYERR,DGSEGERR
+11 ;
+12 DO PARSQRY^DGROHLQ3(DGWRK,.DGHL,.DGQRY,.DGSEGERR)
+13 SET DGDFN=$$GETDFN^DGROUT2(DGQRY("ICN"),DGQRY("DOB"),DGQRY("SSN"))
+14 IF DGDFN'>0
Begin DoDot:1
+15 SET DGQRYERR="NM"
+16 ;
+17 ;THE ICN FROM THE MPI DOES NOT MATCH A PATIENT, SO NOTIFY THE MPI
+18 DO MPIMAIL^DGROMAIL(.DGQRY)
+19 ;
End DoDot:1
+20 DO SNDORF^DGROHLS(.DGQRY,DGMIEN,.DGHL,DGDFN,.DGSEGERR,.DGQRYERR)
+21 QUIT
+22 ;
RCVORF(DGWRK,DGMIEN,DGHL) ;Receive ORF Message Types (ORF~R01)
+1 ;
+2 ; Input:
+3 ; DGWRK - name of work global containing segments, ^TMP("DGROHL7",$J)
+4 ; DGMIEN - IEN of message entry in file #773
+5 ; DGHL - HL environment array
+6 ;
+7 ; Output:
+8 ; none
+9 ;
+10 ;patient data array to upload
NEW DGDATA
+11 ;parse error array
NEW DGERR
+12 ;ORF data array
NEW DGORF
+13 ;
+14 SET DGDATA=$NAME(^TMP("DGROFDA",$JOB))
KILL @DGDATA
+15 DO PARSORF^DGROHLQ3(DGWRK,.DGHL,.DGORF,.DGERR,.DGDATA)
+16 ;
+17 IF $DATA(DGROVRCK)
Begin DoDot:1
+18 if ('$DATA(DGORF("PATCH")))
SET DGROVRCK=0
+19 IF ($DATA(DGORF("PATCH")))
IF (+DGORF("PATCH")'=572)
SET DGROVRCK=0
End DoDot:1
+20 ;
+21 ;* QUIT conditions
+22 if '$DATA(DGORF)
QUIT
+23 if (+$GET(DGORF("DFN"))'>0)
QUIT
+24 if '$DATA(^DPT(DGORF("DFN"),0))
QUIT
+25 if ('$DATA(DGORF("PATCH")))
QUIT
+26 ;Q:(+DGORF("PATCH")'=572)
+27 ;
+28 SET DFN=DGORF("DFN")
+29 ;
+30 ;Get DFN at Last Site Treated
+31 SET LSTDFN=+$ORDER(@DGDATA@(2,""))
+32 ;CHECK BUSINESS RULES
+33 ;AGENT ORANGE EXPOSURE
DO AO^DGRODEBR(DGDATA,DFN,LSTDFN)
+34 ;RADIATION EXPOSURE
DO IR^DGRODEBR(DGDATA,DFN,LSTDFN)
+35 ;DATE OF DEATH
DO DOD^DGRODEBR(DGDATA,DFN,LSTDFN)
+36 ;TEMPORARY ADDRESS
DO TA^DGRODEBR(DGDATA,LSTDFN)
+37 ;SENSITIVE PATIENT
DO SP^DGRODEBR(DGDATA,DFN,LSTDFN)
+38 ;CONFIDENTIAL ADDRESS
DO CA^DGRODEBR(DGDATA,LSTDFN)
+39 ;SOUTHWEST ASIA CONDITIONS
DO SWA^DGRODEBR(DGDATA,DFN,LSTDFN)
+40 ;RULED INCOMPETENT
DO INC^DGRODEBR(DGDATA,DFN,LSTDFN)
+41 ;INELIGIBLE
DO INE^DGRODEBR(DGDATA,DFN,LSTDFN)
+42 ;RECENT DATE(S) OF CARE
DO RDOC^DGRODEBR(DGDATA,DFN,LSTDFN)
+43 ;MILITARY SERVICE EPISODES
DO MSE^DGRODEBR(DGDATA,LSTDFN)
+44 ;
+45 ;File the data
+46 DO CONVFDA^DGROHLR1(DFN,DGDATA)
+47 ;CLEAN UP
+48 KILL @DGDATA
+49 QUIT
