- DGPFHLQ ;ALB/RPM - PRF HL7 QRY/ORF PROCESSING ; 1/23/03
- ;;5.3;Registration;**425,650,951**;Aug 13, 1993;Build 135
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- BLDQRY(DGDFN,DGICN,DGROOT,DGHL) ;Build QRY~R02 Message/Segments
- ;
- ; Input:
- ; DGDFN - (required) Pointer to patient in PATIENT (#2) file
- ; DGICN - (required) Patient's Integrated Control Number
- ; DGROOT - (required) Closed root array or global name for segment
- ; storage.
- ; DGHL - (required) VistA HL7 environment array
- ;
- ; Output:
- ; Function Value - 1 on success, 0 on failure
- ; DGROOT - array of HL7 segments on success
- ;
- N DGCNT ;segment counter
- N DGDEM ;pt. demographics array
- N DGQRD ;formatted QRD segment
- N DGQRF ;formatted QRF segment
- N DGRSLT ;function value
- N DGSTR ;field string
- ;
- S DGRSLT=0
- S DGCNT=0
- ;
- I +$G(DGDFN),+$G(DGICN),$G(DGROOT)]"" D
- . ;
- . ;get patient demographics
- . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM)
- . ;
- . ;build QRD
- . S DGSTR="1,2,3,4,7,8,9,10"
- . S DGQRD=$$QRD^DGPFHLQ1(DGDFN,DGICN,DGSTR,.DGHL)
- . Q:(DGQRD="")
- . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGQRD
- . ;
- . ;build QRF
- . S DGSTR="1,4,5"
- . S DGQRF=$$QRF^DGPFHLQ2($G(DGDEM("SSN")),$G(DGDEM("DOB")),DGSTR,.DGHL)
- . Q:(DGQRF="")
- . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGQRF
- . ;
- . S DGRSLT=1
- Q DGRSLT
- ;
- BLDORF(DGROOT,DGHL,DGDFN,DGQRY,DGSEGERR,DGQRYERR) ;Build ORF~R04 Message/Segments
- ;
- ; Input:
- ; DGROOT - (required) Segment array
- ; DGHL - (required) HL7 environment array
- ; DGDFN - (required) Pointer to patient in PATIENT (#2) file
- ; DGQRY - (required) Array of parsed QRY data
- ; DGSEGERR - (optional) Array of errors encountered during QRY parsing
- ; DGQRYERR - (optional) Error encountered during ICN to DFN conversion
- ;
- ; Output:
- ; Function Value - 1 on success, 0 on failure
- ;
- N DGACK ;acknowledgment code (i.e. AA, AE)
- N DGAIENS ;array of assignment IENS
- N DGCNT ;segment counter
- N DGI ;generic index
- N DGOBROOT ;temporary storage of OBR/OBX segments
- N DGRSLT ;function value
- N DGSEGSTR ;formatted segment string
- N DGSTR ;comma-delimited list of fields to include
- ;
- S DGRSLT=0
- S DGOBROOT=$NA(^TMP("DGPF OB",$J))
- K @DGOBROOT
- ;
- I $G(DGROOT)]"",$D(DGQRY) D
- . S DGCNT=0
- . S DGACK=$S($D(DGSEGERR):"AE",$D(DGQRYERR):"AE",1:"AA")
- . ;
- . ;build OBR/OBX segments for any Category I record flag assignments
- . I DGACK="AA",$$GETALL^DGPFAA($G(DGDFN),.DGAIENS,"",1) D
- . . ;
- . . ;build and temporarily store OBR/OBX segments
- . . Q:$$BLDALLOB(DGOBROOT,.DGAIENS,.DGHL)
- . . ;
- . . ;if we get here then the data retrieval failed
- . . S DGQRYERR=261130 ;unable to retrieve existing assignments
- . . S DGACK="AE"
- . . K @DGOBROOT
- . ;
- . ;build MSA segment
- . S DGSTR=$S($D(DGQRYERR):"1,2,6",1:"1,2")
- . S DGSEGSTR=$$MSA^DGPFHLU3(DGACK,DGHL("MID"),.DGQRYERR,DGSTR,.DGHL)
- . Q:(DGSEGSTR="")
- . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR
- . ;
- . ;build ERR segments for any segment parsing errors
- . I $D(DGSEGERR),'$$BLDERR^DGPFHLU4(DGROOT,.DGSEGERR,.DGHL,.DGCNT) Q
- . ;
- . ;build QRD segment
- . S DGSTR="1,2,3,4,7,8,9,10"
- . S DGSEGSTR=$$QRD^DGPFHLQ1($G(DGQRY("QID")),$G(DGQRY("ICN")),DGSTR,.DGHL)
- . Q:(DGSEGSTR="")
- . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR
- . ;
- . ;move any OBR/OBX segments into the message
- . S DGI=0
- . F S DGI=$O(@DGOBROOT@(DGI)) Q:'DGI D
- . . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=@DGOBROOT@(DGI)
- . ;
- . ;success
- . S DGRSLT=1
- ;
- ;cleanup
- K @DGOBROOT
- ;
- Q DGRSLT
- ;
- BLDALLOB(DGROOT,DGAIENS,DGHL) ;build all OBRs and OBXs for a patient
- ;
- ; Input:
- ; DGROOT - (required) Closed root array or global name for segment
- ; storage.
- ; DGAIENS - (required) Array of pointers to PRF ASSIGNMENT (#26.13) file
- ; DGHL - (required) VistA HL7 environment array
- ;
- ; Output:
- ; Function Value - 1 on success, 0 on failure
- ; DGROOT - array of HL7 segments on success
- ;
- N DGAIEN ;single assignment IEN
- N DGCNT ;segment counter
- N DGHIEN ;single assignment history IEN
- N DGHIENS ;array of assignment history IENs
- N DGOBRSET ;OBR segment Set ID
- N DGOBXOK ;OBX segment creation flag
- N DGOBXSET ;OBX segment Set ID
- N DGPFA ;assignment data array
- N DGPFAH ;assignment history data array
- N DGRSLT ;function value
- N DGSEGSTR ;formatted segment string
- N DGSTR ;comma-delimited list of fields to include
- N DGTROOT ;closed root name of text array value
- N LASTH ;last assignment history entry
- N DBRSSTR,Z
- ;
- S (DGCNT,DGRSLT)=0
- I $G(DGROOT)]"",$D(DGAIENS) D
- .S (DGAIEN,DGOBRSET)=0
- .F S DGAIEN=$O(DGAIENS(DGAIEN)) Q:'DGAIEN D
- ..N DGHIENS ;array of assignment history IENS
- ..N DGPFA ;assignment data array
- ..;get assignment details
- ..Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA)
- ..;get last assignment history for narrative observation date
- ..Q:'$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGAIEN),.DGPFAH,1)
- ..K LASTH M LASTH=DGPFAH
- ..;build OBR segment for this assignment
- ..S DGSTR="1,4,7,20,21"
- ..S DGOBRSET=DGOBRSET+1
- ..S DGSEGSTR=$$OBR^DGPFHLU1(DGOBRSET,.DGPFA,.DGPFAH,DGSTR,.DGHL)
- ..Q:DGSEGSTR=""
- ..S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR
- ..;build narrative OBX segment for this assignment
- ..S DGOBXSET=0
- ..S DGTROOT="DGPFA(""NARR"")"
- ..Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"N",.DGPFAH,.DGHL,.DGCNT,.DGOBXSET)
- ..;get a list of all assignment histories
- ..Q:'$$GETALL^DGPFAAH(DGAIEN,.DGHIENS)
- ..S DGSTR="1,2,3,5,11,14,23"
- ..;loop through each assignment history entry
- ..S DGHIEN=0 F S DGHIEN=$O(DGHIENS(DGHIEN)) Q:'DGHIEN D Q:'DGOBXOK
- ...N DGPFAH
- ...S DGOBXOK=0
- ...;get single assignment history record
- ...Q:'$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH)
- ...;build status OBX segment for this history record
- ...S DGOBXSET=DGOBXSET+1
- ...S DGSEGSTR=$$OBX^DGPFHLU2(DGOBXSET,"S","",$P($G(DGPFAH("ACTION")),U,2),.DGPFAH,DGSTR,.DGHL)
- ...Q:DGSEGSTR=""
- ...S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR
- ...;build review comment OBX segments for this history record
- ...S DGTROOT="DGPFAH(""COMMENT"")"
- ...Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"C",.DGPFAH,.DGHL,.DGCNT,.DGOBXSET)
- ...S DGOBXOK=1
- ...Q
- ..; build DBRS OBX segments
- ..; ORF message never updates existing assignment records, so send all DBRS data except for deleted entries
- ..; regardless of the action code in 26.14.
- ..S Z="" F S Z=$O(LASTH("DBRS",Z)) Q:Z="" D Q:'DGOBXOK
- ...S DGOBXOK=0
- ...S DBRSSTR=$G(LASTH("DBRS",Z))
- ...; don't send deleted DBRS entries
- ...I $P($P(DBRSSTR,U,4),";")="D" Q
- ...S DGOBXSET=DGOBXSET+1
- ...S DGSEGSTR=$$OBX^DGPFHLU2(DGOBXSET,"D","",DBRSSTR,.LASTH,"1,2,3,5,11,14,23",.DGHL)
- ...Q:DGSEGSTR=""
- ...S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR
- ...S DGOBXOK=1
- ...Q
- ..Q:'DGOBXOK
- ..S DGRSLT=1
- ..Q
- .Q
- Q DGRSLT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFHLQ 6909 printed Feb 19, 2025@00:13:42 Page 2
- DGPFHLQ ;ALB/RPM - PRF HL7 QRY/ORF PROCESSING ; 1/23/03
- +1 ;;5.3;Registration;**425,650,951**;Aug 13, 1993;Build 135
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- BLDQRY(DGDFN,DGICN,DGROOT,DGHL) ;Build QRY~R02 Message/Segments
- +1 ;
- +2 ; Input:
- +3 ; DGDFN - (required) Pointer to patient in PATIENT (#2) file
- +4 ; DGICN - (required) Patient's Integrated Control Number
- +5 ; DGROOT - (required) Closed root array or global name for segment
- +6 ; storage.
- +7 ; DGHL - (required) VistA HL7 environment array
- +8 ;
- +9 ; Output:
- +10 ; Function Value - 1 on success, 0 on failure
- +11 ; DGROOT - array of HL7 segments on success
- +12 ;
- +13 ;segment counter
- NEW DGCNT
- +14 ;pt. demographics array
- NEW DGDEM
- +15 ;formatted QRD segment
- NEW DGQRD
- +16 ;formatted QRF segment
- NEW DGQRF
- +17 ;function value
- NEW DGRSLT
- +18 ;field string
- NEW DGSTR
- +19 ;
- +20 SET DGRSLT=0
- +21 SET DGCNT=0
- +22 ;
- +23 IF +$GET(DGDFN)
- IF +$GET(DGICN)
- IF $GET(DGROOT)]""
- Begin DoDot:1
- +24 ;
- +25 ;get patient demographics
- +26 if '$$GETPAT^DGPFUT2(DGDFN,.DGDEM)
- QUIT
- +27 ;
- +28 ;build QRD
- +29 SET DGSTR="1,2,3,4,7,8,9,10"
- +30 SET DGQRD=$$QRD^DGPFHLQ1(DGDFN,DGICN,DGSTR,.DGHL)
- +31 if (DGQRD="")
- QUIT
- +32 SET DGCNT=DGCNT+1
- SET @DGROOT@(DGCNT)=DGQRD
- +33 ;
- +34 ;build QRF
- +35 SET DGSTR="1,4,5"
- +36 SET DGQRF=$$QRF^DGPFHLQ2($GET(DGDEM("SSN")),$GET(DGDEM("DOB")),DGSTR,.DGHL)
- +37 if (DGQRF="")
- QUIT
- +38 SET DGCNT=DGCNT+1
- SET @DGROOT@(DGCNT)=DGQRF
- +39 ;
- +40 SET DGRSLT=1
- End DoDot:1
- +41 QUIT DGRSLT
- +42 ;
- BLDORF(DGROOT,DGHL,DGDFN,DGQRY,DGSEGERR,DGQRYERR) ;Build ORF~R04 Message/Segments
- +1 ;
- +2 ; Input:
- +3 ; DGROOT - (required) Segment array
- +4 ; DGHL - (required) HL7 environment array
- +5 ; DGDFN - (required) Pointer to patient in PATIENT (#2) file
- +6 ; DGQRY - (required) Array of parsed QRY data
- +7 ; DGSEGERR - (optional) Array of errors encountered during QRY parsing
- +8 ; DGQRYERR - (optional) Error encountered during ICN to DFN conversion
- +9 ;
- +10 ; Output:
- +11 ; Function Value - 1 on success, 0 on failure
- +12 ;
- +13 ;acknowledgment code (i.e. AA, AE)
- NEW DGACK
- +14 ;array of assignment IENS
- NEW DGAIENS
- +15 ;segment counter
- NEW DGCNT
- +16 ;generic index
- NEW DGI
- +17 ;temporary storage of OBR/OBX segments
- NEW DGOBROOT
- +18 ;function value
- NEW DGRSLT
- +19 ;formatted segment string
- NEW DGSEGSTR
- +20 ;comma-delimited list of fields to include
- NEW DGSTR
- +21 ;
- +22 SET DGRSLT=0
- +23 SET DGOBROOT=$NAME(^TMP("DGPF OB",$JOB))
- +24 KILL @DGOBROOT
- +25 ;
- +26 IF $GET(DGROOT)]""
- IF $DATA(DGQRY)
- Begin DoDot:1
- +27 SET DGCNT=0
- +28 SET DGACK=$SELECT($DATA(DGSEGERR):"AE",$DATA(DGQRYERR):"AE",1:"AA")
- +29 ;
- +30 ;build OBR/OBX segments for any Category I record flag assignments
- +31 IF DGACK="AA"
- IF $$GETALL^DGPFAA($GET(DGDFN),.DGAIENS,"",1)
- Begin DoDot:2
- +32 ;
- +33 ;build and temporarily store OBR/OBX segments
- +34 if $$BLDALLOB(DGOBROOT,.DGAIENS,.DGHL)
- QUIT
- +35 ;
- +36 ;if we get here then the data retrieval failed
- +37 ;unable to retrieve existing assignments
- SET DGQRYERR=261130
- +38 SET DGACK="AE"
- +39 KILL @DGOBROOT
- End DoDot:2
- +40 ;
- +41 ;build MSA segment
- +42 SET DGSTR=$SELECT($DATA(DGQRYERR):"1,2,6",1:"1,2")
- +43 SET DGSEGSTR=$$MSA^DGPFHLU3(DGACK,DGHL("MID"),.DGQRYERR,DGSTR,.DGHL)
- +44 if (DGSEGSTR="")
- QUIT
- +45 SET DGCNT=DGCNT+1
- SET @DGROOT@(DGCNT)=DGSEGSTR
- +46 ;
- +47 ;build ERR segments for any segment parsing errors
- +48 IF $DATA(DGSEGERR)
- IF '$$BLDERR^DGPFHLU4(DGROOT,.DGSEGERR,.DGHL,.DGCNT)
- QUIT
- +49 ;
- +50 ;build QRD segment
- +51 SET DGSTR="1,2,3,4,7,8,9,10"
- +52 SET DGSEGSTR=$$QRD^DGPFHLQ1($GET(DGQRY("QID")),$GET(DGQRY("ICN")),DGSTR,.DGHL)
- +53 if (DGSEGSTR="")
- QUIT
- +54 SET DGCNT=DGCNT+1
- SET @DGROOT@(DGCNT)=DGSEGSTR
- +55 ;
- +56 ;move any OBR/OBX segments into the message
- +57 SET DGI=0
- +58 FOR
- SET DGI=$ORDER(@DGOBROOT@(DGI))
- if 'DGI
- QUIT
- Begin DoDot:2
- +59 SET DGCNT=DGCNT+1
- SET @DGROOT@(DGCNT)=@DGOBROOT@(DGI)
- End DoDot:2
- +60 ;
- +61 ;success
- +62 SET DGRSLT=1
- End DoDot:1
- +63 ;
- +64 ;cleanup
- +65 KILL @DGOBROOT
- +66 ;
- +67 QUIT DGRSLT
- +68 ;
- BLDALLOB(DGROOT,DGAIENS,DGHL) ;build all OBRs and OBXs for a patient
- +1 ;
- +2 ; Input:
- +3 ; DGROOT - (required) Closed root array or global name for segment
- +4 ; storage.
- +5 ; DGAIENS - (required) Array of pointers to PRF ASSIGNMENT (#26.13) file
- +6 ; DGHL - (required) VistA HL7 environment array
- +7 ;
- +8 ; Output:
- +9 ; Function Value - 1 on success, 0 on failure
- +10 ; DGROOT - array of HL7 segments on success
- +11 ;
- +12 ;single assignment IEN
- NEW DGAIEN
- +13 ;segment counter
- NEW DGCNT
- +14 ;single assignment history IEN
- NEW DGHIEN
- +15 ;array of assignment history IENs
- NEW DGHIENS
- +16 ;OBR segment Set ID
- NEW DGOBRSET
- +17 ;OBX segment creation flag
- NEW DGOBXOK
- +18 ;OBX segment Set ID
- NEW DGOBXSET
- +19 ;assignment data array
- NEW DGPFA
- +20 ;assignment history data array
- NEW DGPFAH
- +21 ;function value
- NEW DGRSLT
- +22 ;formatted segment string
- NEW DGSEGSTR
- +23 ;comma-delimited list of fields to include
- NEW DGSTR
- +24 ;closed root name of text array value
- NEW DGTROOT
- +25 ;last assignment history entry
- NEW LASTH
- +26 NEW DBRSSTR,Z
- +27 ;
- +28 SET (DGCNT,DGRSLT)=0
- +29 IF $GET(DGROOT)]""
- IF $DATA(DGAIENS)
- Begin DoDot:1
- +30 SET (DGAIEN,DGOBRSET)=0
- +31 FOR
- SET DGAIEN=$ORDER(DGAIENS(DGAIEN))
- if 'DGAIEN
- QUIT
- Begin DoDot:2
- +32 ;array of assignment history IENS
- NEW DGHIENS
- +33 ;assignment data array
- NEW DGPFA
- +34 ;get assignment details
- +35 if '$$GETASGN^DGPFAA(DGAIEN,.DGPFA)
- QUIT
- +36 ;get last assignment history for narrative observation date
- +37 if '$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGAIEN),.DGPFAH,1)
- QUIT
- +38 KILL LASTH
- MERGE LASTH=DGPFAH
- +39 ;build OBR segment for this assignment
- +40 SET DGSTR="1,4,7,20,21"
- +41 SET DGOBRSET=DGOBRSET+1
- +42 SET DGSEGSTR=$$OBR^DGPFHLU1(DGOBRSET,.DGPFA,.DGPFAH,DGSTR,.DGHL)
- +43 if DGSEGSTR=""
- QUIT
- +44 SET DGCNT=DGCNT+1
- SET @DGROOT@(DGCNT)=DGSEGSTR
- +45 ;build narrative OBX segment for this assignment
- +46 SET DGOBXSET=0
- +47 SET DGTROOT="DGPFA(""NARR"")"
- +48 if '$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"N",.DGPFAH,.DGHL,.DGCNT,.DGOBXSET)
- QUIT
- +49 ;get a list of all assignment histories
- +50 if '$$GETALL^DGPFAAH(DGAIEN,.DGHIENS)
- QUIT
- +51 SET DGSTR="1,2,3,5,11,14,23"
- +52 ;loop through each assignment history entry
- +53 SET DGHIEN=0
- FOR
- SET DGHIEN=$ORDER(DGHIENS(DGHIEN))
- if 'DGHIEN
- QUIT
- Begin DoDot:3
- +54 NEW DGPFAH
- +55 SET DGOBXOK=0
- +56 ;get single assignment history record
- +57 if '$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH)
- QUIT
- +58 ;build status OBX segment for this history record
- +59 SET DGOBXSET=DGOBXSET+1
- +60 SET DGSEGSTR=$$OBX^DGPFHLU2(DGOBXSET,"S","",$PIECE($GET(DGPFAH("ACTION")),U,2),.DGPFAH,DGSTR,.DGHL)
- +61 if DGSEGSTR=""
- QUIT
- +62 SET DGCNT=DGCNT+1
- SET @DGROOT@(DGCNT)=DGSEGSTR
- +63 ;build review comment OBX segments for this history record
- +64 SET DGTROOT="DGPFAH(""COMMENT"")"
- +65 if '$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"C",.DGPFAH,.DGHL,.DGCNT,.DGOBXSET)
- QUIT
- +66 SET DGOBXOK=1
- +67 QUIT
- End DoDot:3
- if 'DGOBXOK
- QUIT
- +68 ; build DBRS OBX segments
- +69 ; ORF message never updates existing assignment records, so send all DBRS data except for deleted entries
- +70 ; regardless of the action code in 26.14.
- +71 SET Z=""
- FOR
- SET Z=$ORDER(LASTH("DBRS",Z))
- if Z=""
- QUIT
- Begin DoDot:3
- +72 SET DGOBXOK=0
- +73 SET DBRSSTR=$GET(LASTH("DBRS",Z))
- +74 ; don't send deleted DBRS entries
- +75 IF $PIECE($PIECE(DBRSSTR,U,4),";")="D"
- QUIT
- +76 SET DGOBXSET=DGOBXSET+1
- +77 SET DGSEGSTR=$$OBX^DGPFHLU2(DGOBXSET,"D","",DBRSSTR,.LASTH,"1,2,3,5,11,14,23",.DGHL)
- +78 if DGSEGSTR=""
- QUIT
- +79 SET DGCNT=DGCNT+1
- SET @DGROOT@(DGCNT)=DGSEGSTR
- +80 SET DGOBXOK=1
- +81 QUIT
- End DoDot:3
- if 'DGOBXOK
- QUIT
- +82 if 'DGOBXOK
- QUIT
- +83 SET DGRSLT=1
- +84 QUIT
- End DoDot:2
- +85 QUIT
- End DoDot:1
- +86 QUIT DGRSLT