Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPFHLQ

DGPFHLQ.m

Go to the documentation of this file.
  1. DGPFHLQ ;ALB/RPM - PRF HL7 QRY/ORF PROCESSING ; 1/23/03
  1. ;;5.3;Registration;**425,650,951**;Aug 13, 1993;Build 135
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. BLDQRY(DGDFN,DGICN,DGROOT,DGHL) ;Build QRY~R02 Message/Segments
  1. ;
  1. ; Input:
  1. ; DGDFN - (required) Pointer to patient in PATIENT (#2) file
  1. ; DGICN - (required) Patient's Integrated Control Number
  1. ; DGROOT - (required) Closed root array or global name for segment
  1. ; storage.
  1. ; DGHL - (required) VistA HL7 environment array
  1. ;
  1. ; Output:
  1. ; Function Value - 1 on success, 0 on failure
  1. ; DGROOT - array of HL7 segments on success
  1. ;
  1. N DGCNT ;segment counter
  1. N DGDEM ;pt. demographics array
  1. N DGQRD ;formatted QRD segment
  1. N DGQRF ;formatted QRF segment
  1. N DGRSLT ;function value
  1. N DGSTR ;field string
  1. ;
  1. S DGRSLT=0
  1. S DGCNT=0
  1. ;
  1. I +$G(DGDFN),+$G(DGICN),$G(DGROOT)]"" D
  1. . ;
  1. . ;get patient demographics
  1. . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM)
  1. . ;
  1. . ;build QRD
  1. . S DGSTR="1,2,3,4,7,8,9,10"
  1. . S DGQRD=$$QRD^DGPFHLQ1(DGDFN,DGICN,DGSTR,.DGHL)
  1. . Q:(DGQRD="")
  1. . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGQRD
  1. . ;
  1. . ;build QRF
  1. . S DGSTR="1,4,5"
  1. . S DGQRF=$$QRF^DGPFHLQ2($G(DGDEM("SSN")),$G(DGDEM("DOB")),DGSTR,.DGHL)
  1. . Q:(DGQRF="")
  1. . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGQRF
  1. . ;
  1. . S DGRSLT=1
  1. Q DGRSLT
  1. ;
  1. BLDORF(DGROOT,DGHL,DGDFN,DGQRY,DGSEGERR,DGQRYERR) ;Build ORF~R04 Message/Segments
  1. ;
  1. ; Input:
  1. ; DGROOT - (required) Segment array
  1. ; DGHL - (required) HL7 environment array
  1. ; DGDFN - (required) Pointer to patient in PATIENT (#2) file
  1. ; DGQRY - (required) Array of parsed QRY data
  1. ; DGSEGERR - (optional) Array of errors encountered during QRY parsing
  1. ; DGQRYERR - (optional) Error encountered during ICN to DFN conversion
  1. ;
  1. ; Output:
  1. ; Function Value - 1 on success, 0 on failure
  1. ;
  1. N DGACK ;acknowledgment code (i.e. AA, AE)
  1. N DGAIENS ;array of assignment IENS
  1. N DGCNT ;segment counter
  1. N DGI ;generic index
  1. N DGOBROOT ;temporary storage of OBR/OBX segments
  1. N DGRSLT ;function value
  1. N DGSEGSTR ;formatted segment string
  1. N DGSTR ;comma-delimited list of fields to include
  1. ;
  1. S DGRSLT=0
  1. S DGOBROOT=$NA(^TMP("DGPF OB",$J))
  1. K @DGOBROOT
  1. ;
  1. I $G(DGROOT)]"",$D(DGQRY) D
  1. . S DGCNT=0
  1. . S DGACK=$S($D(DGSEGERR):"AE",$D(DGQRYERR):"AE",1:"AA")
  1. . ;
  1. . ;build OBR/OBX segments for any Category I record flag assignments
  1. . I DGACK="AA",$$GETALL^DGPFAA($G(DGDFN),.DGAIENS,"",1) D
  1. . . ;
  1. . . ;build and temporarily store OBR/OBX segments
  1. . . Q:$$BLDALLOB(DGOBROOT,.DGAIENS,.DGHL)
  1. . . ;
  1. . . ;if we get here then the data retrieval failed
  1. . . S DGQRYERR=261130 ;unable to retrieve existing assignments
  1. . . S DGACK="AE"
  1. . . K @DGOBROOT
  1. . ;
  1. . ;build MSA segment
  1. . S DGSTR=$S($D(DGQRYERR):"1,2,6",1:"1,2")
  1. . S DGSEGSTR=$$MSA^DGPFHLU3(DGACK,DGHL("MID"),.DGQRYERR,DGSTR,.DGHL)
  1. . Q:(DGSEGSTR="")
  1. . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR
  1. . ;
  1. . ;build ERR segments for any segment parsing errors
  1. . I $D(DGSEGERR),'$$BLDERR^DGPFHLU4(DGROOT,.DGSEGERR,.DGHL,.DGCNT) Q
  1. . ;
  1. . ;build QRD segment
  1. . S DGSTR="1,2,3,4,7,8,9,10"
  1. . S DGSEGSTR=$$QRD^DGPFHLQ1($G(DGQRY("QID")),$G(DGQRY("ICN")),DGSTR,.DGHL)
  1. . Q:(DGSEGSTR="")
  1. . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR
  1. . ;
  1. . ;move any OBR/OBX segments into the message
  1. . S DGI=0
  1. . F S DGI=$O(@DGOBROOT@(DGI)) Q:'DGI D
  1. . . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=@DGOBROOT@(DGI)
  1. . ;
  1. . ;success
  1. . S DGRSLT=1
  1. ;
  1. ;cleanup
  1. K @DGOBROOT
  1. ;
  1. Q DGRSLT
  1. ;
  1. BLDALLOB(DGROOT,DGAIENS,DGHL) ;build all OBRs and OBXs for a patient
  1. ;
  1. ; Input:
  1. ; DGROOT - (required) Closed root array or global name for segment
  1. ; storage.
  1. ; DGAIENS - (required) Array of pointers to PRF ASSIGNMENT (#26.13) file
  1. ; DGHL - (required) VistA HL7 environment array
  1. ;
  1. ; Output:
  1. ; Function Value - 1 on success, 0 on failure
  1. ; DGROOT - array of HL7 segments on success
  1. ;
  1. N DGAIEN ;single assignment IEN
  1. N DGCNT ;segment counter
  1. N DGHIEN ;single assignment history IEN
  1. N DGHIENS ;array of assignment history IENs
  1. N DGOBRSET ;OBR segment Set ID
  1. N DGOBXOK ;OBX segment creation flag
  1. N DGOBXSET ;OBX segment Set ID
  1. N DGPFA ;assignment data array
  1. N DGPFAH ;assignment history data array
  1. N DGRSLT ;function value
  1. N DGSEGSTR ;formatted segment string
  1. N DGSTR ;comma-delimited list of fields to include
  1. N DGTROOT ;closed root name of text array value
  1. N LASTH ;last assignment history entry
  1. N DBRSSTR,Z
  1. ;
  1. S (DGCNT,DGRSLT)=0
  1. I $G(DGROOT)]"",$D(DGAIENS) D
  1. .S (DGAIEN,DGOBRSET)=0
  1. .F S DGAIEN=$O(DGAIENS(DGAIEN)) Q:'DGAIEN D
  1. ..N DGHIENS ;array of assignment history IENS
  1. ..N DGPFA ;assignment data array
  1. ..;get assignment details
  1. ..Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA)
  1. ..;get last assignment history for narrative observation date
  1. ..Q:'$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGAIEN),.DGPFAH,1)
  1. ..K LASTH M LASTH=DGPFAH
  1. ..;build OBR segment for this assignment
  1. ..S DGSTR="1,4,7,20,21"
  1. ..S DGOBRSET=DGOBRSET+1
  1. ..S DGSEGSTR=$$OBR^DGPFHLU1(DGOBRSET,.DGPFA,.DGPFAH,DGSTR,.DGHL)
  1. ..Q:DGSEGSTR=""
  1. ..S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR
  1. ..;build narrative OBX segment for this assignment
  1. ..S DGOBXSET=0
  1. ..S DGTROOT="DGPFA(""NARR"")"
  1. ..Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"N",.DGPFAH,.DGHL,.DGCNT,.DGOBXSET)
  1. ..;get a list of all assignment histories
  1. ..Q:'$$GETALL^DGPFAAH(DGAIEN,.DGHIENS)
  1. ..S DGSTR="1,2,3,5,11,14,23"
  1. ..;loop through each assignment history entry
  1. ..S DGHIEN=0 F S DGHIEN=$O(DGHIENS(DGHIEN)) Q:'DGHIEN D Q:'DGOBXOK
  1. ...N DGPFAH
  1. ...S DGOBXOK=0
  1. ...;get single assignment history record
  1. ...Q:'$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH)
  1. ...;build status OBX segment for this history record
  1. ...S DGOBXSET=DGOBXSET+1
  1. ...S DGSEGSTR=$$OBX^DGPFHLU2(DGOBXSET,"S","",$P($G(DGPFAH("ACTION")),U,2),.DGPFAH,DGSTR,.DGHL)
  1. ...Q:DGSEGSTR=""
  1. ...S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR
  1. ...;build review comment OBX segments for this history record
  1. ...S DGTROOT="DGPFAH(""COMMENT"")"
  1. ...Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"C",.DGPFAH,.DGHL,.DGCNT,.DGOBXSET)
  1. ...S DGOBXOK=1
  1. ...Q
  1. ..; build DBRS OBX segments
  1. ..; ORF message never updates existing assignment records, so send all DBRS data except for deleted entries
  1. ..; regardless of the action code in 26.14.
  1. ..S Z="" F S Z=$O(LASTH("DBRS",Z)) Q:Z="" D Q:'DGOBXOK
  1. ...S DGOBXOK=0
  1. ...S DBRSSTR=$G(LASTH("DBRS",Z))
  1. ...; don't send deleted DBRS entries
  1. ...I $P($P(DBRSSTR,U,4),";")="D" Q
  1. ...S DGOBXSET=DGOBXSET+1
  1. ...S DGSEGSTR=$$OBX^DGPFHLU2(DGOBXSET,"D","",DBRSSTR,.LASTH,"1,2,3,5,11,14,23",.DGHL)
  1. ...Q:DGSEGSTR=""
  1. ...S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR
  1. ...S DGOBXOK=1
  1. ...Q
  1. ..Q:'DGOBXOK
  1. ..S DGRSLT=1
  1. ..Q
  1. .Q
  1. Q DGRSLT