- 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 Jan 18, 2025@03:55:56 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