DGPFHLQ ;ALB/RPM - PRF HL7 QRY/ORF PROCESSING ; 1/23/03
;;5.3;Registration;**425,650,1015**;Aug 13, 1993;Build 21
;
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
;
S DGCNT=0
S DGRSLT=0
I $G(DGROOT)]"",$D(DGAIENS) D
. S DGAIEN=0
. S 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)
. . ;
. . ;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)
. . ;
. . ;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 DGSTR="1,2,3,5,11,14"
. . . 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:'DGOBXOK
. . S DGRSLT=1
Q DGRSLT
DGPFHLQ ;ALB/RPM - PRF HL7 QRY/ORF PROCESSING ; 1/23/03
+1 ;;5.3;Registration;**425,650,1015**;Aug 13, 1993;Build 21
+2 ;
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 ;
+26 SET DGCNT=0
+27 SET DGRSLT=0
+28 IF $GET(DGROOT)]""
IF $DATA(DGAIENS)
Begin DoDot:1
+29 SET DGAIEN=0
+30 SET 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 ;
+35 ;get assignment details
+36 IF '$$GETASGN^DGPFAA(DGAIEN,.DGPFA)
QUIT
+37 ;
+38 ;get last assignment history for narrative observation date
+39 IF '$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGAIEN),.DGPFAH)
QUIT
+40 ;
+41 ;build OBR segment for this assignment
+42 SET DGSTR="1,4,7,20,21"
+43 SET DGOBRSET=DGOBRSET+1
+44 SET DGSEGSTR=$$OBR^DGPFHLU1(DGOBRSET,.DGPFA,.DGPFAH,DGSTR,.DGHL)
+45 IF (DGSEGSTR="")
QUIT
+46 SET DGCNT=DGCNT+1
SET @DGROOT@(DGCNT)=DGSEGSTR
+47 ;
+48 ;build narrative OBX segment for this assignment
+49 SET DGOBXSET=0
+50 SET DGTROOT="DGPFA(""NARR"")"
+51 IF '$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"N",.DGPFAH,.DGHL,.DGCNT,.DGOBXSET)
QUIT
+52 ;
+53 ;get a list of all assignment histories
+54 IF '$$GETALL^DGPFAAH(DGAIEN,.DGHIENS)
QUIT
+55 ;
+56 ;loop through each assignment history entry
+57 SET DGHIEN=0
+58 FOR
SET DGHIEN=$ORDER(DGHIENS(DGHIEN))
IF 'DGHIEN
QUIT
Begin DoDot:3
+59 NEW DGPFAH
+60 SET DGOBXOK=0
+61 ;
+62 ;get single assignment history record
+63 IF '$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH)
QUIT
+64 ;
+65 ;build status OBX segment for this history record
+66 SET DGSTR="1,2,3,5,11,14"
+67 SET DGOBXSET=DGOBXSET+1
+68 SET DGSEGSTR=$$OBX^DGPFHLU2(DGOBXSET,"S","",$PIECE($GET(DGPFAH("ACTION")),U,2),.DGPFAH,DGSTR,.DGHL)
+69 IF (DGSEGSTR="")
QUIT
+70 SET DGCNT=DGCNT+1
SET @DGROOT@(DGCNT)=DGSEGSTR
+71 ;
+72 ;build review comment OBX segments for this history record
+73 SET DGTROOT="DGPFAH(""COMMENT"")"
+74 IF '$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"C",.DGPFAH,.DGHL,.DGCNT,.DGOBXSET)
QUIT
+75 SET DGOBXOK=1
End DoDot:3
IF 'DGOBXOK
QUIT
+76 IF 'DGOBXOK
QUIT
+77 SET DGRSLT=1
End DoDot:2
End DoDot:1
+78 QUIT DGRSLT
