- 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 Feb 19, 2025@00:14:02 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