DGPFHLUQ ;ALB/RPM - PRF HL7 INTERACTIVE QUERY ; 8/24/06
;;5.3;Registration;**650**;Aug 13, 1993;Build 3
;
Q ;no direct entry
;
EN ;entry point
;This procedure prompts the user to select a patient and the facility
;that they wish to check for existing Category I patient record flags.
;An HL7 query is then sent to the selected facility.
;
N DGDFN ;pointer to patient in PATIENT (#2) file
N DGFAC ;selected facility
N DGTF ;array of treating facilities
N DGPAT ;selected patient
N DGRSLT ;result of query call
;
;select patient
W !!
D SELPAT^DGPFUT1(.DGPAT)
Q:+$G(DGPAT)'>0
S DGDFN=+DGPAT
;
;build list of valid query facilities
I '$$BLDTFL^DGPFUT2(DGDFN,.DGTF) D Q
. N DGLINE
. S DGLINE(1)=""
. S DGLINE(3)="* No treating facilities are available to query. *"
. S $P(DGLINE(2),"*",$L(DGLINE(3)))="*"
. S DGLINE(4)=DGLINE(2)
. S DGLINE(5)=""
. D EN^DDIOL(.DGLINE)
. I $$CONTINUE^DGPFUT()
;
;select facility
S DGFAC=$$ANSWER^DGPFUT("Select facility to query",$P($$NS^XUAF4($$GETNXTF^DGPFUT(DGDFN)),U),"P^4:EMZ","","I $D(DGTF(+Y))")
Q:DGFAC'>0
S DGFAC=$$STA^XUAF4(DGFAC)
;
;send query and build display
S DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,3,DGFAC)
;
Q
;
;
DISPLAY(DGMTIEN,DGRESULT) ;DISPLAY RESULTS
;This procedure is the entry point called from SNDQRY^DGPFHLS that
;parses and displays the returned Response to Observation Query
;(ORF~R04) HL7 message.
;
; Input:
; DGMTIEN - if positive a response was returned from destination;
; otherwise, no response was returned
; DGRESULT - result parameter from HLMA call
;
; Output: none
;
N DGANS ;pause response
N DGCNT ;continuation node counter
N DGERR ;parsed message error results array
N DGFACNAM ;facility name
N DGORF ;parsed data array name
N DGSEGCNT ;segment counter
N DGSTA ;station number
N DGTEXT ;message text array
N DGWRK ;HL7 segments array name
;
;if HL7 package reports failure, notify user and quit
I +$G(DGMTIEN)<1!(+$P($G(DGRESULT),U,2)) D Q
. K DGTEXT
. S DGTEXT(1)="The facility failed to respond to the query request."
. D SHOWMSG(.DGTEXT,"*")
. I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
;
S DGWRK=$NA(^TMP("DGPFHL7",$J))
K @DGWRK
S DGORF=$NA(^TMP("DGPF",$J))
K @DGORF
;
;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)
;
;parse segments and load into data array
D PARSORF^DGPFHLQ4(DGWRK,.HL,DGORF,.DGERR)
;
;get facility name from message
S DGSTA=$G(@DGORF@("SNDFAC"))
S DGFACNAM=$$EXTERNAL^DILFD(26.13,.04,"F",$$IEN^XUAF4(DGSTA))
;
;when assignments are returned, file any that are missing locally
;and display all returned assignments
I $O(@DGORF@(0)) D
. ;
. N DGDFN ;patient
. N DGFLG ;flag name
. N DGI ;generic index
. N DGPRE ;list of flag assignments prior to filing
. N DGPRECNT ;count of flag assignments prior to filing
. N DGPST ;list of flag assignments following filing
. ;
. S DGDFN=$$GETDFN^MPIF001(+$G(@DGORF@("ICN")))
. ;
. ;get list of existing Cat I assignments
. S DGPRECNT=$$GETFNAME(DGDFN,.DGPRE)
. ;
. ;store the returned assignments
. I $$STOORF^DGPFHLR(DGDFN,DGORF) ;naked IF
. ;
. ;get updated list of Cat I assignments and notify user when
. ;assignments are added
. I $$GETFNAME(DGDFN,.DGPST)>DGPRECNT D
. . K DGTEXT
. . ;
. . ;remove pre-existing flags from assignment list
. . S DGFLG=""
. . F S DGFLG=$O(DGPST(DGFLG)) Q:DGFLG="" K:$D(DGPRE(DGFLG)) DGPST(DGFLG)
. . ;build user message
. . S DGTEXT(1)="The following Category I Patient Record Flag Assignments"
. . S DGTEXT(2)="were returned and filed on your system:"
. . S DGFLG=""
. . F DGI=3:1 S DGFLG=$O(DGPST(DGFLG)) Q:DGFLG="" D
. . . S DGTEXT(DGI)=" "_DGFLG
. . D SHOWMSG(.DGTEXT,"*")
. . S DGANS=$$ANSWER^DGPFUT("Enter RETURN to view query results","","E")
. ;
. ;display query results
. I +$G(DGANS)>-1 D EN^DGPFLMQ(DGORF)
;
;otherwise notify user that none were found
E D
. K DGTEXT
. S DGTEXT(1)="No Category I Patient Record Flag Assignments found for"
. S DGTEXT(2)="this patient at "_DGFACNAM_" ("_DGSTA_")."
. D SHOWMSG(.DGTEXT,"*")
. I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
;
;cleanup
K @DGWRK
K @DGORF
Q
;
GETFNAME(DGDFN,DGFLGS) ;get list of assigned flag names
;
; Input:
; DGDFN
;
; Output:
; Function value - count of assigned flag names
; DGFLGS - array of assigned flag names
; Ex. DGFLGS("FLAGNAME")=""
;
N DGASGN ;PRF assignments array
N DGCNT ;assigned flag name count
N DGPFA ;assignment data array
N DGIEN ;assignment record#
;
S DGCNT=0
I $$GETALL^DGPFAA(DGDFN,.DGASGN,"",1) D
. S DGIEN=0
. F S DGIEN=$O(DGASGN(DGIEN)) Q:'DGIEN D
. . I $$GETASGN^DGPFAA(DGIEN,.DGPFA) D
. . . S DGFLGS($P(DGPFA("FLAG"),U,2))=""
. . . S DGCNT=DGCNT+1
Q DGCNT
;
SHOWMSG(DGTEXT,DGBCHAR) ;format and display user message
;
; Input:
; DGTEXT - array of lines to display
; DGBCHAR - border character (optional [DEFAULT="*"])
;
; Output: none
;
N DGBLNK ;blank line
N DGBORDER ;border string
N DGCNT ;line counter
N DGI ;generic index
N DGLEN ;line length
N DGLINE ;formatted text line
N DGMAX ;max line length
;
S DGBCHAR=$S($G(DGBCHAR)?1.ANP:$E(DGBCHAR),1:"*")
;determine max line length
S (DGI,DGCNT,DGMAX)=0
F S DGI=$O(DGTEXT(DGI)) Q:'DGI D
. S DGLEN=$L(DGTEXT(DGI))
. I DGLEN>(IOM-4) D
. . S DGTEXT(DGI+.1)=$E(DGTEXT(DGI),IOM-3,DGLEN)
. . S DGTEXT(DGI)=$E(DGTEXT(DGI),1,IOM-4)
. . S DGLEN=IOM-4
. S:DGLEN>DGMAX DGMAX=DGLEN
S $P(DGBLNK," ",DGMAX+1)=""
S $P(DGBORDER,DGBCHAR,DGMAX+5)=""
S DGCNT=DGCNT+1
S DGLINE(DGCNT)=""
S DGCNT=DGCNT+1
S DGLINE(DGCNT)=DGBORDER
S DGI=0
F S DGI=$O(DGTEXT(DGI)) Q:'DGI D
. S DGCNT=DGCNT+1
. S DGLINE(DGCNT)=DGBCHAR_" "_DGTEXT(DGI)_$E(DGBLNK,1,$L(DGBLNK)-$L(DGTEXT(DGI)))_" "_DGBCHAR
S DGCNT=DGCNT+1
S DGLINE(DGCNT)=DGBORDER
S DGCNT=DGCNT+1
S DGLINE(DGCNT)=""
D EN^DDIOL(.DGLINE)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFHLUQ 6319 printed Apr 09, 2024@22:00:48 Page 2
DGPFHLUQ ;ALB/RPM - PRF HL7 INTERACTIVE QUERY ; 8/24/06
+1 ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
+2 ;
+3 ;no direct entry
QUIT
+4 ;
EN ;entry point
+1 ;This procedure prompts the user to select a patient and the facility
+2 ;that they wish to check for existing Category I patient record flags.
+3 ;An HL7 query is then sent to the selected facility.
+4 ;
+5 ;pointer to patient in PATIENT (#2) file
NEW DGDFN
+6 ;selected facility
NEW DGFAC
+7 ;array of treating facilities
NEW DGTF
+8 ;selected patient
NEW DGPAT
+9 ;result of query call
NEW DGRSLT
+10 ;
+11 ;select patient
+12 WRITE !!
+13 DO SELPAT^DGPFUT1(.DGPAT)
+14 if +$GET(DGPAT)'>0
QUIT
+15 SET DGDFN=+DGPAT
+16 ;
+17 ;build list of valid query facilities
+18 IF '$$BLDTFL^DGPFUT2(DGDFN,.DGTF)
Begin DoDot:1
+19 NEW DGLINE
+20 SET DGLINE(1)=""
+21 SET DGLINE(3)="* No treating facilities are available to query. *"
+22 SET $PIECE(DGLINE(2),"*",$LENGTH(DGLINE(3)))="*"
+23 SET DGLINE(4)=DGLINE(2)
+24 SET DGLINE(5)=""
+25 DO EN^DDIOL(.DGLINE)
+26 IF $$CONTINUE^DGPFUT()
End DoDot:1
QUIT
+27 ;
+28 ;select facility
+29 SET DGFAC=$$ANSWER^DGPFUT("Select facility to query",$PIECE($$NS^XUAF4($$GETNXTF^DGPFUT(DGDFN)),U),"P^4:EMZ","","I $D(DGTF(+Y))")
+30 if DGFAC'>0
QUIT
+31 SET DGFAC=$$STA^XUAF4(DGFAC)
+32 ;
+33 ;send query and build display
+34 SET DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,3,DGFAC)
+35 ;
+36 QUIT
+37 ;
+38 ;
DISPLAY(DGMTIEN,DGRESULT) ;DISPLAY RESULTS
+1 ;This procedure is the entry point called from SNDQRY^DGPFHLS that
+2 ;parses and displays the returned Response to Observation Query
+3 ;(ORF~R04) HL7 message.
+4 ;
+5 ; Input:
+6 ; DGMTIEN - if positive a response was returned from destination;
+7 ; otherwise, no response was returned
+8 ; DGRESULT - result parameter from HLMA call
+9 ;
+10 ; Output: none
+11 ;
+12 ;pause response
NEW DGANS
+13 ;continuation node counter
NEW DGCNT
+14 ;parsed message error results array
NEW DGERR
+15 ;facility name
NEW DGFACNAM
+16 ;parsed data array name
NEW DGORF
+17 ;segment counter
NEW DGSEGCNT
+18 ;station number
NEW DGSTA
+19 ;message text array
NEW DGTEXT
+20 ;HL7 segments array name
NEW DGWRK
+21 ;
+22 ;if HL7 package reports failure, notify user and quit
+23 IF +$GET(DGMTIEN)<1!(+$PIECE($GET(DGRESULT),U,2))
Begin DoDot:1
+24 KILL DGTEXT
+25 SET DGTEXT(1)="The facility failed to respond to the query request."
+26 DO SHOWMSG(.DGTEXT,"*")
+27 IF $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
End DoDot:1
QUIT
+28 ;
+29 SET DGWRK=$NAME(^TMP("DGPFHL7",$JOB))
+30 KILL @DGWRK
+31 SET DGORF=$NAME(^TMP("DGPF",$JOB))
+32 KILL @DGORF
+33 ;
+34 ;load work global with segments
+35 FOR DGSEGCNT=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+36 SET DGCNT=0
+37 SET @DGWRK@(DGSEGCNT,DGCNT)=HLNODE
+38 FOR
SET DGCNT=$ORDER(HLNODE(DGCNT))
if 'DGCNT
QUIT
Begin DoDot:2
+39 SET @DGWRK@(DGSEGCNT,DGCNT)=HLNODE(DGCNT)
End DoDot:2
End DoDot:1
+40 ;
+41 ;parse segments and load into data array
+42 DO PARSORF^DGPFHLQ4(DGWRK,.HL,DGORF,.DGERR)
+43 ;
+44 ;get facility name from message
+45 SET DGSTA=$GET(@DGORF@("SNDFAC"))
+46 SET DGFACNAM=$$EXTERNAL^DILFD(26.13,.04,"F",$$IEN^XUAF4(DGSTA))
+47 ;
+48 ;when assignments are returned, file any that are missing locally
+49 ;and display all returned assignments
+50 IF $ORDER(@DGORF@(0))
Begin DoDot:1
+51 ;
+52 ;patient
NEW DGDFN
+53 ;flag name
NEW DGFLG
+54 ;generic index
NEW DGI
+55 ;list of flag assignments prior to filing
NEW DGPRE
+56 ;count of flag assignments prior to filing
NEW DGPRECNT
+57 ;list of flag assignments following filing
NEW DGPST
+58 ;
+59 SET DGDFN=$$GETDFN^MPIF001(+$GET(@DGORF@("ICN")))
+60 ;
+61 ;get list of existing Cat I assignments
+62 SET DGPRECNT=$$GETFNAME(DGDFN,.DGPRE)
+63 ;
+64 ;store the returned assignments
+65 ;naked IF
IF $$STOORF^DGPFHLR(DGDFN,DGORF)
+66 ;
+67 ;get updated list of Cat I assignments and notify user when
+68 ;assignments are added
+69 IF $$GETFNAME(DGDFN,.DGPST)>DGPRECNT
Begin DoDot:2
+70 KILL DGTEXT
+71 ;
+72 ;remove pre-existing flags from assignment list
+73 SET DGFLG=""
+74 FOR
SET DGFLG=$ORDER(DGPST(DGFLG))
if DGFLG=""
QUIT
if $DATA(DGPRE(DGFLG))
KILL DGPST(DGFLG)
+75 ;build user message
+76 SET DGTEXT(1)="The following Category I Patient Record Flag Assignments"
+77 SET DGTEXT(2)="were returned and filed on your system:"
+78 SET DGFLG=""
+79 FOR DGI=3:1
SET DGFLG=$ORDER(DGPST(DGFLG))
if DGFLG=""
QUIT
Begin DoDot:3
+80 SET DGTEXT(DGI)=" "_DGFLG
End DoDot:3
+81 DO SHOWMSG(.DGTEXT,"*")
+82 SET DGANS=$$ANSWER^DGPFUT("Enter RETURN to view query results","","E")
End DoDot:2
+83 ;
+84 ;display query results
+85 IF +$GET(DGANS)>-1
DO EN^DGPFLMQ(DGORF)
End DoDot:1
+86 ;
+87 ;otherwise notify user that none were found
+88 IF '$TEST
Begin DoDot:1
+89 KILL DGTEXT
+90 SET DGTEXT(1)="No Category I Patient Record Flag Assignments found for"
+91 SET DGTEXT(2)="this patient at "_DGFACNAM_" ("_DGSTA_")."
+92 DO SHOWMSG(.DGTEXT,"*")
+93 IF $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
End DoDot:1
+94 ;
+95 ;cleanup
+96 KILL @DGWRK
+97 KILL @DGORF
+98 QUIT
+99 ;
GETFNAME(DGDFN,DGFLGS) ;get list of assigned flag names
+1 ;
+2 ; Input:
+3 ; DGDFN
+4 ;
+5 ; Output:
+6 ; Function value - count of assigned flag names
+7 ; DGFLGS - array of assigned flag names
+8 ; Ex. DGFLGS("FLAGNAME")=""
+9 ;
+10 ;PRF assignments array
NEW DGASGN
+11 ;assigned flag name count
NEW DGCNT
+12 ;assignment data array
NEW DGPFA
+13 ;assignment record#
NEW DGIEN
+14 ;
+15 SET DGCNT=0
+16 IF $$GETALL^DGPFAA(DGDFN,.DGASGN,"",1)
Begin DoDot:1
+17 SET DGIEN=0
+18 FOR
SET DGIEN=$ORDER(DGASGN(DGIEN))
if 'DGIEN
QUIT
Begin DoDot:2
+19 IF $$GETASGN^DGPFAA(DGIEN,.DGPFA)
Begin DoDot:3
+20 SET DGFLGS($PIECE(DGPFA("FLAG"),U,2))=""
+21 SET DGCNT=DGCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT DGCNT
+23 ;
SHOWMSG(DGTEXT,DGBCHAR) ;format and display user message
+1 ;
+2 ; Input:
+3 ; DGTEXT - array of lines to display
+4 ; DGBCHAR - border character (optional [DEFAULT="*"])
+5 ;
+6 ; Output: none
+7 ;
+8 ;blank line
NEW DGBLNK
+9 ;border string
NEW DGBORDER
+10 ;line counter
NEW DGCNT
+11 ;generic index
NEW DGI
+12 ;line length
NEW DGLEN
+13 ;formatted text line
NEW DGLINE
+14 ;max line length
NEW DGMAX
+15 ;
+16 SET DGBCHAR=$SELECT($GET(DGBCHAR)?1.ANP:$EXTRACT(DGBCHAR),1:"*")
+17 ;determine max line length
+18 SET (DGI,DGCNT,DGMAX)=0
+19 FOR
SET DGI=$ORDER(DGTEXT(DGI))
if 'DGI
QUIT
Begin DoDot:1
+20 SET DGLEN=$LENGTH(DGTEXT(DGI))
+21 IF DGLEN>(IOM-4)
Begin DoDot:2
+22 SET DGTEXT(DGI+.1)=$EXTRACT(DGTEXT(DGI),IOM-3,DGLEN)
+23 SET DGTEXT(DGI)=$EXTRACT(DGTEXT(DGI),1,IOM-4)
+24 SET DGLEN=IOM-4
End DoDot:2
+25 if DGLEN>DGMAX
SET DGMAX=DGLEN
End DoDot:1
+26 SET $PIECE(DGBLNK," ",DGMAX+1)=""
+27 SET $PIECE(DGBORDER,DGBCHAR,DGMAX+5)=""
+28 SET DGCNT=DGCNT+1
+29 SET DGLINE(DGCNT)=""
+30 SET DGCNT=DGCNT+1
+31 SET DGLINE(DGCNT)=DGBORDER
+32 SET DGI=0
+33 FOR
SET DGI=$ORDER(DGTEXT(DGI))
if 'DGI
QUIT
Begin DoDot:1
+34 SET DGCNT=DGCNT+1
+35 SET DGLINE(DGCNT)=DGBCHAR_" "_DGTEXT(DGI)_$EXTRACT(DGBLNK,1,$LENGTH(DGBLNK)-$LENGTH(DGTEXT(DGI)))_" "_DGBCHAR
End DoDot:1
+36 SET DGCNT=DGCNT+1
+37 SET DGLINE(DGCNT)=DGBORDER
+38 SET DGCNT=DGCNT+1
+39 SET DGLINE(DGCNT)=""
+40 DO EN^DDIOL(.DGLINE)
+41 ;
+42 QUIT
