| [613] | 1 | DGPFHLUQ ;ALB/RPM - PRF HL7 INTERACTIVE QUERY ; 8/24/06
|
|---|
| 2 | ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
|
|---|
| 3 | ;
|
|---|
| 4 | Q ;no direct entry
|
|---|
| 5 | ;
|
|---|
| 6 | EN ;entry point
|
|---|
| 7 | ;This procedure prompts the user to select a patient and the facility
|
|---|
| 8 | ;that they wish to check for existing Category I patient record flags.
|
|---|
| 9 | ;An HL7 query is then sent to the selected facility.
|
|---|
| 10 | ;
|
|---|
| 11 | N DGDFN ;pointer to patient in PATIENT (#2) file
|
|---|
| 12 | N DGFAC ;selected facility
|
|---|
| 13 | N DGTF ;array of treating facilities
|
|---|
| 14 | N DGPAT ;selected patient
|
|---|
| 15 | N DGRSLT ;result of query call
|
|---|
| 16 | ;
|
|---|
| 17 | ;select patient
|
|---|
| 18 | W !!
|
|---|
| 19 | D SELPAT^DGPFUT1(.DGPAT)
|
|---|
| 20 | Q:+$G(DGPAT)'>0
|
|---|
| 21 | S DGDFN=+DGPAT
|
|---|
| 22 | ;
|
|---|
| 23 | ;build list of valid query facilities
|
|---|
| 24 | I '$$BLDTFL^DGPFUT2(DGDFN,.DGTF) D Q
|
|---|
| 25 | . N DGLINE
|
|---|
| 26 | . S DGLINE(1)=""
|
|---|
| 27 | . S DGLINE(3)="* No treating facilities are available to query. *"
|
|---|
| 28 | . S $P(DGLINE(2),"*",$L(DGLINE(3)))="*"
|
|---|
| 29 | . S DGLINE(4)=DGLINE(2)
|
|---|
| 30 | . S DGLINE(5)=""
|
|---|
| 31 | . D EN^DDIOL(.DGLINE)
|
|---|
| 32 | . I $$CONTINUE^DGPFUT()
|
|---|
| 33 | ;
|
|---|
| 34 | ;select facility
|
|---|
| 35 | S DGFAC=$$ANSWER^DGPFUT("Select facility to query",$P($$NS^XUAF4($$GETNXTF^DGPFUT(DGDFN)),U),"P^4:EMZ","","I $D(DGTF(+Y))")
|
|---|
| 36 | Q:DGFAC'>0
|
|---|
| 37 | S DGFAC=$$STA^XUAF4(DGFAC)
|
|---|
| 38 | ;
|
|---|
| 39 | ;send query and build display
|
|---|
| 40 | S DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,3,DGFAC)
|
|---|
| 41 | ;
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | ;
|
|---|
| 45 | DISPLAY(DGMTIEN,DGRESULT) ;DISPLAY RESULTS
|
|---|
| 46 | ;This procedure is the entry point called from SNDQRY^DGPFHLS that
|
|---|
| 47 | ;parses and displays the returned Response to Observation Query
|
|---|
| 48 | ;(ORF~R04) HL7 message.
|
|---|
| 49 | ;
|
|---|
| 50 | ; Input:
|
|---|
| 51 | ; DGMTIEN - if positive a response was returned from destination;
|
|---|
| 52 | ; otherwise, no response was returned
|
|---|
| 53 | ; DGRESULT - result parameter from HLMA call
|
|---|
| 54 | ;
|
|---|
| 55 | ; Output: none
|
|---|
| 56 | ;
|
|---|
| 57 | N DGANS ;pause response
|
|---|
| 58 | N DGCNT ;continuation node counter
|
|---|
| 59 | N DGERR ;parsed message error results array
|
|---|
| 60 | N DGFACNAM ;facility name
|
|---|
| 61 | N DGORF ;parsed data array name
|
|---|
| 62 | N DGSEGCNT ;segment counter
|
|---|
| 63 | N DGSTA ;station number
|
|---|
| 64 | N DGTEXT ;message text array
|
|---|
| 65 | N DGWRK ;HL7 segments array name
|
|---|
| 66 | ;
|
|---|
| 67 | ;if HL7 package reports failure, notify user and quit
|
|---|
| 68 | I +$G(DGMTIEN)<1!(+$P($G(DGRESULT),U,2)) D Q
|
|---|
| 69 | . K DGTEXT
|
|---|
| 70 | . S DGTEXT(1)="The facility failed to respond to the query request."
|
|---|
| 71 | . D SHOWMSG(.DGTEXT,"*")
|
|---|
| 72 | . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
|
|---|
| 73 | ;
|
|---|
| 74 | S DGWRK=$NA(^TMP("DGPFHL7",$J))
|
|---|
| 75 | K @DGWRK
|
|---|
| 76 | S DGORF=$NA(^TMP("DGPF",$J))
|
|---|
| 77 | K @DGORF
|
|---|
| 78 | ;
|
|---|
| 79 | ;load work global with segments
|
|---|
| 80 | F DGSEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
|
|---|
| 81 | . S DGCNT=0
|
|---|
| 82 | . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE
|
|---|
| 83 | . F S DGCNT=$O(HLNODE(DGCNT)) Q:'DGCNT D
|
|---|
| 84 | . . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE(DGCNT)
|
|---|
| 85 | ;
|
|---|
| 86 | ;parse segments and load into data array
|
|---|
| 87 | D PARSORF^DGPFHLQ4(DGWRK,.HL,DGORF,.DGERR)
|
|---|
| 88 | ;
|
|---|
| 89 | ;get facility name from message
|
|---|
| 90 | S DGSTA=$G(@DGORF@("SNDFAC"))
|
|---|
| 91 | S DGFACNAM=$$EXTERNAL^DILFD(26.13,.04,"F",$$IEN^XUAF4(DGSTA))
|
|---|
| 92 | ;
|
|---|
| 93 | ;when assignments are returned, file any that are missing locally
|
|---|
| 94 | ;and display all returned assignments
|
|---|
| 95 | I $O(@DGORF@(0)) D
|
|---|
| 96 | . ;
|
|---|
| 97 | . N DGDFN ;patient
|
|---|
| 98 | . N DGFLG ;flag name
|
|---|
| 99 | . N DGI ;generic index
|
|---|
| 100 | . N DGPRE ;list of flag assignments prior to filing
|
|---|
| 101 | . N DGPRECNT ;count of flag assignments prior to filing
|
|---|
| 102 | . N DGPST ;list of flag assignments following filing
|
|---|
| 103 | . ;
|
|---|
| 104 | . S DGDFN=$$GETDFN^MPIF001(+$G(@DGORF@("ICN")))
|
|---|
| 105 | . ;
|
|---|
| 106 | . ;get list of existing Cat I assignments
|
|---|
| 107 | . S DGPRECNT=$$GETFNAME(DGDFN,.DGPRE)
|
|---|
| 108 | . ;
|
|---|
| 109 | . ;store the returned assignments
|
|---|
| 110 | . I $$STOORF^DGPFHLR(DGDFN,DGORF) ;naked IF
|
|---|
| 111 | . ;
|
|---|
| 112 | . ;get updated list of Cat I assignments and notify user when
|
|---|
| 113 | . ;assignments are added
|
|---|
| 114 | . I $$GETFNAME(DGDFN,.DGPST)>DGPRECNT D
|
|---|
| 115 | . . K DGTEXT
|
|---|
| 116 | . . ;
|
|---|
| 117 | . . ;remove pre-existing flags from assignment list
|
|---|
| 118 | . . S DGFLG=""
|
|---|
| 119 | . . F S DGFLG=$O(DGPST(DGFLG)) Q:DGFLG="" K:$D(DGPRE(DGFLG)) DGPST(DGFLG)
|
|---|
| 120 | . . ;build user message
|
|---|
| 121 | . . S DGTEXT(1)="The following Category I Patient Record Flag Assignments"
|
|---|
| 122 | . . S DGTEXT(2)="were returned and filed on your system:"
|
|---|
| 123 | . . S DGFLG=""
|
|---|
| 124 | . . F DGI=3:1 S DGFLG=$O(DGPST(DGFLG)) Q:DGFLG="" D
|
|---|
| 125 | . . . S DGTEXT(DGI)=" "_DGFLG
|
|---|
| 126 | . . D SHOWMSG(.DGTEXT,"*")
|
|---|
| 127 | . . S DGANS=$$ANSWER^DGPFUT("Enter RETURN to view query results","","E")
|
|---|
| 128 | . ;
|
|---|
| 129 | . ;display query results
|
|---|
| 130 | . I +$G(DGANS)>-1 D EN^DGPFLMQ(DGORF)
|
|---|
| 131 | ;
|
|---|
| 132 | ;otherwise notify user that none were found
|
|---|
| 133 | E D
|
|---|
| 134 | . K DGTEXT
|
|---|
| 135 | . S DGTEXT(1)="No Category I Patient Record Flag Assignments found for"
|
|---|
| 136 | . S DGTEXT(2)="this patient at "_DGFACNAM_" ("_DGSTA_")."
|
|---|
| 137 | . D SHOWMSG(.DGTEXT,"*")
|
|---|
| 138 | . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
|
|---|
| 139 | ;
|
|---|
| 140 | ;cleanup
|
|---|
| 141 | K @DGWRK
|
|---|
| 142 | K @DGORF
|
|---|
| 143 | Q
|
|---|
| 144 | ;
|
|---|
| 145 | GETFNAME(DGDFN,DGFLGS) ;get list of assigned flag names
|
|---|
| 146 | ;
|
|---|
| 147 | ; Input:
|
|---|
| 148 | ; DGDFN
|
|---|
| 149 | ;
|
|---|
| 150 | ; Output:
|
|---|
| 151 | ; Function value - count of assigned flag names
|
|---|
| 152 | ; DGFLGS - array of assigned flag names
|
|---|
| 153 | ; Ex. DGFLGS("FLAGNAME")=""
|
|---|
| 154 | ;
|
|---|
| 155 | N DGASGN ;PRF assignments array
|
|---|
| 156 | N DGCNT ;assigned flag name count
|
|---|
| 157 | N DGPFA ;assignment data array
|
|---|
| 158 | N DGIEN ;assignment record#
|
|---|
| 159 | ;
|
|---|
| 160 | S DGCNT=0
|
|---|
| 161 | I $$GETALL^DGPFAA(DGDFN,.DGASGN,"",1) D
|
|---|
| 162 | . S DGIEN=0
|
|---|
| 163 | . F S DGIEN=$O(DGASGN(DGIEN)) Q:'DGIEN D
|
|---|
| 164 | . . I $$GETASGN^DGPFAA(DGIEN,.DGPFA) D
|
|---|
| 165 | . . . S DGFLGS($P(DGPFA("FLAG"),U,2))=""
|
|---|
| 166 | . . . S DGCNT=DGCNT+1
|
|---|
| 167 | Q DGCNT
|
|---|
| 168 | ;
|
|---|
| 169 | SHOWMSG(DGTEXT,DGBCHAR) ;format and display user message
|
|---|
| 170 | ;
|
|---|
| 171 | ; Input:
|
|---|
| 172 | ; DGTEXT - array of lines to display
|
|---|
| 173 | ; DGBCHAR - border character (optional [DEFAULT="*"])
|
|---|
| 174 | ;
|
|---|
| 175 | ; Output: none
|
|---|
| 176 | ;
|
|---|
| 177 | N DGBLNK ;blank line
|
|---|
| 178 | N DGBORDER ;border string
|
|---|
| 179 | N DGCNT ;line counter
|
|---|
| 180 | N DGI ;generic index
|
|---|
| 181 | N DGLEN ;line length
|
|---|
| 182 | N DGLINE ;formatted text line
|
|---|
| 183 | N DGMAX ;max line length
|
|---|
| 184 | ;
|
|---|
| 185 | S DGBCHAR=$S($G(DGBCHAR)?1.ANP:$E(DGBCHAR),1:"*")
|
|---|
| 186 | ;determine max line length
|
|---|
| 187 | S (DGI,DGCNT,DGMAX)=0
|
|---|
| 188 | F S DGI=$O(DGTEXT(DGI)) Q:'DGI D
|
|---|
| 189 | . S DGLEN=$L(DGTEXT(DGI))
|
|---|
| 190 | . I DGLEN>(IOM-4) D
|
|---|
| 191 | . . S DGTEXT(DGI+.1)=$E(DGTEXT(DGI),IOM-3,DGLEN)
|
|---|
| 192 | . . S DGTEXT(DGI)=$E(DGTEXT(DGI),1,IOM-4)
|
|---|
| 193 | . . S DGLEN=IOM-4
|
|---|
| 194 | . S:DGLEN>DGMAX DGMAX=DGLEN
|
|---|
| 195 | S $P(DGBLNK," ",DGMAX+1)=""
|
|---|
| 196 | S $P(DGBORDER,DGBCHAR,DGMAX+5)=""
|
|---|
| 197 | S DGCNT=DGCNT+1
|
|---|
| 198 | S DGLINE(DGCNT)=""
|
|---|
| 199 | S DGCNT=DGCNT+1
|
|---|
| 200 | S DGLINE(DGCNT)=DGBORDER
|
|---|
| 201 | S DGI=0
|
|---|
| 202 | F S DGI=$O(DGTEXT(DGI)) Q:'DGI D
|
|---|
| 203 | . S DGCNT=DGCNT+1
|
|---|
| 204 | . S DGLINE(DGCNT)=DGBCHAR_" "_DGTEXT(DGI)_$E(DGBLNK,1,$L(DGBLNK)-$L(DGTEXT(DGI)))_" "_DGBCHAR
|
|---|
| 205 | S DGCNT=DGCNT+1
|
|---|
| 206 | S DGLINE(DGCNT)=DGBORDER
|
|---|
| 207 | S DGCNT=DGCNT+1
|
|---|
| 208 | S DGLINE(DGCNT)=""
|
|---|
| 209 | D EN^DDIOL(.DGLINE)
|
|---|
| 210 | ;
|
|---|
| 211 | Q
|
|---|
