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

DGPFHLUQ.m

Go to the documentation of this file.
  1. DGPFHLUQ ;ALB/RPM - PRF HL7 INTERACTIVE QUERY ; 8/24/06
  1. ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
  1. ;
  1. Q ;no direct entry
  1. ;
  1. EN ;entry point
  1. ;This procedure prompts the user to select a patient and the facility
  1. ;that they wish to check for existing Category I patient record flags.
  1. ;An HL7 query is then sent to the selected facility.
  1. ;
  1. N DGDFN ;pointer to patient in PATIENT (#2) file
  1. N DGFAC ;selected facility
  1. N DGTF ;array of treating facilities
  1. N DGPAT ;selected patient
  1. N DGRSLT ;result of query call
  1. ;
  1. ;select patient
  1. W !!
  1. D SELPAT^DGPFUT1(.DGPAT)
  1. Q:+$G(DGPAT)'>0
  1. S DGDFN=+DGPAT
  1. ;
  1. ;build list of valid query facilities
  1. I '$$BLDTFL^DGPFUT2(DGDFN,.DGTF) D Q
  1. . N DGLINE
  1. . S DGLINE(1)=""
  1. . S DGLINE(3)="* No treating facilities are available to query. *"
  1. . S $P(DGLINE(2),"*",$L(DGLINE(3)))="*"
  1. . S DGLINE(4)=DGLINE(2)
  1. . S DGLINE(5)=""
  1. . D EN^DDIOL(.DGLINE)
  1. . I $$CONTINUE^DGPFUT()
  1. ;
  1. ;select facility
  1. S DGFAC=$$ANSWER^DGPFUT("Select facility to query",$P($$NS^XUAF4($$GETNXTF^DGPFUT(DGDFN)),U),"P^4:EMZ","","I $D(DGTF(+Y))")
  1. Q:DGFAC'>0
  1. S DGFAC=$$STA^XUAF4(DGFAC)
  1. ;
  1. ;send query and build display
  1. S DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,3,DGFAC)
  1. ;
  1. Q
  1. ;
  1. ;
  1. DISPLAY(DGMTIEN,DGRESULT) ;DISPLAY RESULTS
  1. ;This procedure is the entry point called from SNDQRY^DGPFHLS that
  1. ;parses and displays the returned Response to Observation Query
  1. ;(ORF~R04) HL7 message.
  1. ;
  1. ; Input:
  1. ; DGMTIEN - if positive a response was returned from destination;
  1. ; otherwise, no response was returned
  1. ; DGRESULT - result parameter from HLMA call
  1. ;
  1. ; Output: none
  1. ;
  1. N DGANS ;pause response
  1. N DGCNT ;continuation node counter
  1. N DGERR ;parsed message error results array
  1. N DGFACNAM ;facility name
  1. N DGORF ;parsed data array name
  1. N DGSEGCNT ;segment counter
  1. N DGSTA ;station number
  1. N DGTEXT ;message text array
  1. N DGWRK ;HL7 segments array name
  1. ;
  1. ;if HL7 package reports failure, notify user and quit
  1. I +$G(DGMTIEN)<1!(+$P($G(DGRESULT),U,2)) D Q
  1. . K DGTEXT
  1. . S DGTEXT(1)="The facility failed to respond to the query request."
  1. . D SHOWMSG(.DGTEXT,"*")
  1. . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
  1. ;
  1. S DGWRK=$NA(^TMP("DGPFHL7",$J))
  1. K @DGWRK
  1. S DGORF=$NA(^TMP("DGPF",$J))
  1. K @DGORF
  1. ;
  1. ;load work global with segments
  1. F DGSEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
  1. . S DGCNT=0
  1. . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE
  1. . F S DGCNT=$O(HLNODE(DGCNT)) Q:'DGCNT D
  1. . . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE(DGCNT)
  1. ;
  1. ;parse segments and load into data array
  1. D PARSORF^DGPFHLQ4(DGWRK,.HL,DGORF,.DGERR)
  1. ;
  1. ;get facility name from message
  1. S DGSTA=$G(@DGORF@("SNDFAC"))
  1. S DGFACNAM=$$EXTERNAL^DILFD(26.13,.04,"F",$$IEN^XUAF4(DGSTA))
  1. ;
  1. ;when assignments are returned, file any that are missing locally
  1. ;and display all returned assignments
  1. I $O(@DGORF@(0)) D
  1. . ;
  1. . N DGDFN ;patient
  1. . N DGFLG ;flag name
  1. . N DGI ;generic index
  1. . N DGPRE ;list of flag assignments prior to filing
  1. . N DGPRECNT ;count of flag assignments prior to filing
  1. . N DGPST ;list of flag assignments following filing
  1. . ;
  1. . S DGDFN=$$GETDFN^MPIF001(+$G(@DGORF@("ICN")))
  1. . ;
  1. . ;get list of existing Cat I assignments
  1. . S DGPRECNT=$$GETFNAME(DGDFN,.DGPRE)
  1. . ;
  1. . ;store the returned assignments
  1. . I $$STOORF^DGPFHLR(DGDFN,DGORF) ;naked IF
  1. . ;
  1. . ;get updated list of Cat I assignments and notify user when
  1. . ;assignments are added
  1. . I $$GETFNAME(DGDFN,.DGPST)>DGPRECNT D
  1. . . K DGTEXT
  1. . . ;
  1. . . ;remove pre-existing flags from assignment list
  1. . . S DGFLG=""
  1. . . F S DGFLG=$O(DGPST(DGFLG)) Q:DGFLG="" K:$D(DGPRE(DGFLG)) DGPST(DGFLG)
  1. . . ;build user message
  1. . . S DGTEXT(1)="The following Category I Patient Record Flag Assignments"
  1. . . S DGTEXT(2)="were returned and filed on your system:"
  1. . . S DGFLG=""
  1. . . F DGI=3:1 S DGFLG=$O(DGPST(DGFLG)) Q:DGFLG="" D
  1. . . . S DGTEXT(DGI)=" "_DGFLG
  1. . . D SHOWMSG(.DGTEXT,"*")
  1. . . S DGANS=$$ANSWER^DGPFUT("Enter RETURN to view query results","","E")
  1. . ;
  1. . ;display query results
  1. . I +$G(DGANS)>-1 D EN^DGPFLMQ(DGORF)
  1. ;
  1. ;otherwise notify user that none were found
  1. E D
  1. . K DGTEXT
  1. . S DGTEXT(1)="No Category I Patient Record Flag Assignments found for"
  1. . S DGTEXT(2)="this patient at "_DGFACNAM_" ("_DGSTA_")."
  1. . D SHOWMSG(.DGTEXT,"*")
  1. . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
  1. ;
  1. ;cleanup
  1. K @DGWRK
  1. K @DGORF
  1. Q
  1. ;
  1. GETFNAME(DGDFN,DGFLGS) ;get list of assigned flag names
  1. ;
  1. ; Input:
  1. ; DGDFN
  1. ;
  1. ; Output:
  1. ; Function value - count of assigned flag names
  1. ; DGFLGS - array of assigned flag names
  1. ; Ex. DGFLGS("FLAGNAME")=""
  1. ;
  1. N DGASGN ;PRF assignments array
  1. N DGCNT ;assigned flag name count
  1. N DGPFA ;assignment data array
  1. N DGIEN ;assignment record#
  1. ;
  1. S DGCNT=0
  1. I $$GETALL^DGPFAA(DGDFN,.DGASGN,"",1) D
  1. . S DGIEN=0
  1. . F S DGIEN=$O(DGASGN(DGIEN)) Q:'DGIEN D
  1. . . I $$GETASGN^DGPFAA(DGIEN,.DGPFA) D
  1. . . . S DGFLGS($P(DGPFA("FLAG"),U,2))=""
  1. . . . S DGCNT=DGCNT+1
  1. Q DGCNT
  1. ;
  1. SHOWMSG(DGTEXT,DGBCHAR) ;format and display user message
  1. ;
  1. ; Input:
  1. ; DGTEXT - array of lines to display
  1. ; DGBCHAR - border character (optional [DEFAULT="*"])
  1. ;
  1. ; Output: none
  1. ;
  1. N DGBLNK ;blank line
  1. N DGBORDER ;border string
  1. N DGCNT ;line counter
  1. N DGI ;generic index
  1. N DGLEN ;line length
  1. N DGLINE ;formatted text line
  1. N DGMAX ;max line length
  1. ;
  1. S DGBCHAR=$S($G(DGBCHAR)?1.ANP:$E(DGBCHAR),1:"*")
  1. ;determine max line length
  1. S (DGI,DGCNT,DGMAX)=0
  1. F S DGI=$O(DGTEXT(DGI)) Q:'DGI D
  1. . S DGLEN=$L(DGTEXT(DGI))
  1. . I DGLEN>(IOM-4) D
  1. . . S DGTEXT(DGI+.1)=$E(DGTEXT(DGI),IOM-3,DGLEN)
  1. . . S DGTEXT(DGI)=$E(DGTEXT(DGI),1,IOM-4)
  1. . . S DGLEN=IOM-4
  1. . S:DGLEN>DGMAX DGMAX=DGLEN
  1. S $P(DGBLNK," ",DGMAX+1)=""
  1. S $P(DGBORDER,DGBCHAR,DGMAX+5)=""
  1. S DGCNT=DGCNT+1
  1. S DGLINE(DGCNT)=""
  1. S DGCNT=DGCNT+1
  1. S DGLINE(DGCNT)=DGBORDER
  1. S DGI=0
  1. F S DGI=$O(DGTEXT(DGI)) Q:'DGI D
  1. . S DGCNT=DGCNT+1
  1. . S DGLINE(DGCNT)=DGBCHAR_" "_DGTEXT(DGI)_$E(DGBLNK,1,$L(DGBLNK)-$L(DGTEXT(DGI)))_" "_DGBCHAR
  1. S DGCNT=DGCNT+1
  1. S DGLINE(DGCNT)=DGBORDER
  1. S DGCNT=DGCNT+1
  1. S DGLINE(DGCNT)=""
  1. D EN^DDIOL(.DGLINE)
  1. ;
  1. Q