| [613] | 1 | DGPFAPI ;ALB/RBS - PRF EXTERNAL API'S ; 7/26/06 9:22am
|
|---|
| 2 | ;;5.3;Registration;**425,554,699,650**;Aug 13, 1993;Build 3
|
|---|
| 3 | ;
|
|---|
| 4 | Q ;no direct entry
|
|---|
| 5 | ;
|
|---|
| 6 | GETACT(DGDFN,DGPRF) ;Retrieve all ACTIVE Patient record flag assignments
|
|---|
| 7 | ;The purpose of this API is to facilitate the retrieval of specific
|
|---|
| 8 | ;data that can be used for the displaying of or the reporting of
|
|---|
| 9 | ;only ACTIVE Patient Record Flag (PRF) Assignment information for
|
|---|
| 10 | ;a patient.
|
|---|
| 11 | ;
|
|---|
| 12 | ; Associated DBIA: #3860 - DGPF PATIENT RECORD FLAG
|
|---|
| 13 | ;
|
|---|
| 14 | ; Input:
|
|---|
| 15 | ; DGDFN - IEN of patient in the PATIENT (#2) file
|
|---|
| 16 | ; DGPRF - Closed Root array of return values
|
|---|
| 17 | ; [Optional-default DGPFAPI]
|
|---|
| 18 | ;
|
|---|
| 19 | ; Output:
|
|---|
| 20 | ; Function result - "0" = No Active record flags for the patient
|
|---|
| 21 | ; - "nn" = Total number of flags returned in array
|
|---|
| 22 | ; DGPRF() - Array, passed by closed root reference
|
|---|
| 23 | ; - Multiple subscripted array of Active flag information
|
|---|
| 24 | ; If the function call is successful, this array will
|
|---|
| 25 | ; contain each of the Active flag records.
|
|---|
| 26 | ; - Subscript field value = internal value^external value
|
|---|
| 27 | ; 2 piece string caret(^) delimited
|
|---|
| 28 | ; DGPFAPI() - Default array name if no name passed
|
|---|
| 29 | ;
|
|---|
| 30 | ; Subscript Field Name Field #/File #
|
|---|
| 31 | ; --------- ---------- --------------
|
|---|
| 32 | ; "APPRVBY" APPROVED BY (.05)/(#26.14)
|
|---|
| 33 | ; (Note: The .5 (POSTMASTER) internal field value
|
|---|
| 34 | ; triggers an output transform that converts the
|
|---|
| 35 | ; external value of "POSTMASTER" to "CHIEF OF STAFF".
|
|---|
| 36 | ; "ASSIGNDT" DATE/TIME (.02)/(#26.14)
|
|---|
| 37 | ; "REVIEWDT" REVIEW DATE (.06)/(#26.13)
|
|---|
| 38 | ; "FLAG" FLAG NAME (.02)/(#26.13)
|
|---|
| 39 | ; "FLAGTYPE" TYPE (.03)/(#26.11 or #26.15)
|
|---|
| 40 | ; "CATEGORY" National or Local Flag (#26.15) or (#26.11)
|
|---|
| 41 | ; "OWNER" OWNER SITE (.04)/(#26.13)
|
|---|
| 42 | ; "ORIGSITE" ORIGINATING SITE (.05)/(#26.13)
|
|---|
| 43 | ; "TIUTITLE" TIU PN TITLE (.07)/(#26.11) or (#26.15)
|
|---|
| 44 | ; "TIULINK" TIU PN LINK (.06)/(#26.14)
|
|---|
| 45 | ; "NARR" ASSIGNMENT NARRATIVE (1)/(#26.13)
|
|---|
| 46 | ; (word-processing, multiple nodes)
|
|---|
| 47 | ; The format is in a word-processing value that may
|
|---|
| 48 | ; contain multiple nodes of text. Each node of text
|
|---|
| 49 | ; will be less than 80 characters in length.
|
|---|
| 50 | ; The format is as follows:
|
|---|
| 51 | ; TARGET_ROOT(nn,"NARR",line#,0)=text
|
|---|
| 52 | ; where:
|
|---|
| 53 | ; nn = a unique number for each Flag
|
|---|
| 54 | ; line# = a unique number starting at 1 for each wp line
|
|---|
| 55 | ; of narrative text
|
|---|
| 56 | ; 0 = standard subscript format for the nodes of a
|
|---|
| 57 | ; FileMan Word Processing field
|
|---|
| 58 | ;
|
|---|
| 59 | N DGPFTCNT ;return results, "0"=no flags, "nn"=number of flags
|
|---|
| 60 | N DGPFIENS ;array of all active flag assignment IEN's
|
|---|
| 61 | N DGPFIEN ;ien of record flag assignment in (#26.13) file
|
|---|
| 62 | N DGPFA ;flag assignment array
|
|---|
| 63 | N DGPFAH ;flag assignment history array
|
|---|
| 64 | N DGPFLAG ;flag record array
|
|---|
| 65 | N DGPFLAH ;last flag assignment history array
|
|---|
| 66 | N DGCAT ;flag category
|
|---|
| 67 | ;
|
|---|
| 68 | Q:'$G(DGDFN) 0 ;Quit, null parameter
|
|---|
| 69 | Q:'$$GETALL^DGPFAA(DGDFN,.DGPFIENS,1) 0 ;Quit, no Active assign's
|
|---|
| 70 | ;
|
|---|
| 71 | S DGPRF=$G(DGPRF)
|
|---|
| 72 | I DGPRF']"" S DGPRF="DGPFAPI" ;setup default array name
|
|---|
| 73 | ;
|
|---|
| 74 | K @DGPRF ;Kill/initialize work array
|
|---|
| 75 | ;
|
|---|
| 76 | S (DGPFIEN,DGCAT)="",DGPFTCNT=0
|
|---|
| 77 | ;
|
|---|
| 78 | ; loop all returned Active Record Flag Assignment ien's
|
|---|
| 79 | F S DGPFIEN=$O(DGPFIENS(DGPFIEN)) Q:DGPFIEN="" D
|
|---|
| 80 | . K DGPFA,DGPFAH,DGPFLAG,DGPFLAH
|
|---|
| 81 | . ;
|
|---|
| 82 | . ; retrieve single assignment record fields
|
|---|
| 83 | . Q:'$$GETASGN^DGPFAA(DGPFIEN,.DGPFA)
|
|---|
| 84 | . ;
|
|---|
| 85 | . ; no patient DFN match
|
|---|
| 86 | . I DGDFN'=$P(DGPFA("DFN"),U) Q
|
|---|
| 87 | . ;
|
|---|
| 88 | . ; get initial assignment history
|
|---|
| 89 | . Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGPFIEN),.DGPFAH)
|
|---|
| 90 | . ;
|
|---|
| 91 | . ; get last assignment history
|
|---|
| 92 | . Q:'$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGPFIEN),.DGPFLAH)
|
|---|
| 93 | . ;
|
|---|
| 94 | . ; get record flag record
|
|---|
| 95 | . Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGPFLAG)
|
|---|
| 96 | . ;
|
|---|
| 97 | . S DGPFTCNT=DGPFTCNT+1
|
|---|
| 98 | . ;
|
|---|
| 99 | . ; approved by user
|
|---|
| 100 | . S @DGPRF@(DGPFTCNT,"APPRVBY")=$G(DGPFLAH("APPRVBY"))
|
|---|
| 101 | . ;
|
|---|
| 102 | . ; initial assignment date/time
|
|---|
| 103 | . S @DGPRF@(DGPFTCNT,"ASSIGNDT")=$G(DGPFAH("ASSIGNDT"))
|
|---|
| 104 | . ;
|
|---|
| 105 | . ; next review due date
|
|---|
| 106 | . S @DGPRF@(DGPFTCNT,"REVIEWDT")=$G(DGPFA("REVIEWDT"))
|
|---|
| 107 | . ;
|
|---|
| 108 | . ; record flag name
|
|---|
| 109 | . S @DGPRF@(DGPFTCNT,"FLAG")=$G(DGPFA("FLAG"))
|
|---|
| 110 | . ;
|
|---|
| 111 | . ; record flag type
|
|---|
| 112 | . S @DGPRF@(DGPFTCNT,"FLAGTYPE")=$G(DGPFLAG("TYPE"))
|
|---|
| 113 | . ;
|
|---|
| 114 | . ; category of flag - I (NATIONAL) or II (LOCAL)
|
|---|
| 115 | . S DGCAT=$S($G(DGPFA("FLAG"))["26.15":"I (NATIONAL)",1:"II (LOCAL)")
|
|---|
| 116 | . S @DGPRF@(DGPFTCNT,"CATEGORY")=DGCAT_U_DGCAT
|
|---|
| 117 | . ;
|
|---|
| 118 | . ; owner site
|
|---|
| 119 | . S @DGPRF@(DGPFTCNT,"OWNER")=$G(DGPFA("OWNER"))_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("OWNER")),U))
|
|---|
| 120 | . ;
|
|---|
| 121 | . ; originating site
|
|---|
| 122 | . S @DGPRF@(DGPFTCNT,"ORIGSITE")=$G(DGPFA("ORIGSITE"))_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("ORIGSITE")),U))
|
|---|
| 123 | . ;
|
|---|
| 124 | . ; add TIU info when Owner Site is a local division
|
|---|
| 125 | . I $$ISDIV^DGPFUT($P(DGPFA("OWNER"),U)) D
|
|---|
| 126 | . . ;
|
|---|
| 127 | . . ; flag associated TIU PN Title
|
|---|
| 128 | . . S @DGPRF@(DGPFTCNT,"TIUTITLE")=$G(DGPFLAG("TIUTITLE"))
|
|---|
| 129 | . . ;
|
|---|
| 130 | . . ; assignment history TIU PN Link
|
|---|
| 131 | . . S @DGPRF@(DGPFTCNT,"TIULINK")=$G(DGPFLAH("TIULINK"))
|
|---|
| 132 | . ;
|
|---|
| 133 | . ; narrative
|
|---|
| 134 | . I '$D(DGPFA("NARR",1,0)) D Q ;should never happen - but -
|
|---|
| 135 | . . S @DGPRF@(DGPFTCNT,"NARR",1,0)="No Narrative Text"
|
|---|
| 136 | . ;
|
|---|
| 137 | . M @DGPRF@(DGPFTCNT,"NARR")=DGPFA("NARR")
|
|---|
| 138 | ;
|
|---|
| 139 | ; Re-Sort Active flags by category & alpha flag name
|
|---|
| 140 | I +$G(DGPFTCNT)>1 D
|
|---|
| 141 | . I $$SORT^DGPFUT2(DGPRF) ;naked IF to just do resort
|
|---|
| 142 | ;
|
|---|
| 143 | Q DGPFTCNT
|
|---|
| 144 | ;
|
|---|
| 145 | PRFQRY(DGDFN) ;query a treating facility for patient record flag assignments
|
|---|
| 146 | ;This function queries a given patient's treating facility to retrieve
|
|---|
| 147 | ;all patient record flag assignments for the patient.
|
|---|
| 148 | ;
|
|---|
| 149 | ; Input:
|
|---|
| 150 | ; DGDFN - pointer to patient in PATIENT (#2) file
|
|---|
| 151 | ;
|
|---|
| 152 | ; Output:
|
|---|
| 153 | ; Function value - 1 on success, 0 on failure
|
|---|
| 154 | ;
|
|---|
| 155 | N DGEVNT
|
|---|
| 156 | N DGRSLT
|
|---|
| 157 | ;
|
|---|
| 158 | S DGRSLT=0
|
|---|
| 159 | S DGEVNT=$$FNDEVNT^DGPFHLL1(DGDFN)
|
|---|
| 160 | I DGEVNT D
|
|---|
| 161 | . ;
|
|---|
| 162 | . ;must have INCOMPLETE status
|
|---|
| 163 | . Q:'$$ISINCOMP^DGPFHLL1(DGEVNT)
|
|---|
| 164 | . ;
|
|---|
| 165 | . ;run query using mode defined in PRF HL7 QUERY STATUS (#3) field of
|
|---|
| 166 | . ;PRF PARAMETERS (#26.18) file.
|
|---|
| 167 | . S DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,$$QRYON^DGPFPARM())
|
|---|
| 168 | ;
|
|---|
| 169 | Q DGRSLT
|
|---|
| 170 | ;
|
|---|
| 171 | DISPPRF(DGDFN) ;display active patient record flag assignments
|
|---|
| 172 | ;This procedure performs a lookup for active patient record flag
|
|---|
| 173 | ;assignments for a given patient and formats the assignment data for
|
|---|
| 174 | ;roll-and-scroll display.
|
|---|
| 175 | ;
|
|---|
| 176 | ; Input:
|
|---|
| 177 | ; DGDFN - pointer to patient in PATIENT (#2) file
|
|---|
| 178 | ;
|
|---|
| 179 | ; Output:
|
|---|
| 180 | ; none
|
|---|
| 181 | ;
|
|---|
| 182 | Q:'$D(XQY0)
|
|---|
| 183 | Q:$P(XQY0,U)="DGPF RECORD FLAG ASSIGNMENT"
|
|---|
| 184 | ;
|
|---|
| 185 | ;protect Kernel IO variables
|
|---|
| 186 | N IOBM,IOBOFF,IOBON,IOEDEOP,IOINHI,IOINORM,IORC,IORVOFF,IORVON,IOIL
|
|---|
| 187 | N IOSC,IOSGRO,IOSTBM,IOTM,IOUOFF,IOUON
|
|---|
| 188 | ;
|
|---|
| 189 | ;protect ListMan variables
|
|---|
| 190 | N VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCC,VALMCNT,VALMCOFF,VALMCON
|
|---|
| 191 | N VALMDDF,VALMDN,VALMEVL,VALMHDR,VALMIOXY,VALMKEY,VALMLFT,VALMLST
|
|---|
| 192 | N VALMMENU,VALMPGE,VALMSGR,VALMUP,VALMWD
|
|---|
| 193 | ;
|
|---|
| 194 | ;protect Unwinder variables
|
|---|
| 195 | N ORU,ORUDA,ORUER,ORUFD,ORUFG,ORUSB,ORUSQ,ORUSV,ORUT,ORUW,ORUX
|
|---|
| 196 | N XQORM,DQ
|
|---|
| 197 | ;
|
|---|
| 198 | ; protect original Listman VALM DATA global
|
|---|
| 199 | K ^TMP($J,"DGPFVALM DATA")
|
|---|
| 200 | M ^TMP($J,"DGPFVALM DATA")=^TMP("VALM DATA",$J)
|
|---|
| 201 | ;
|
|---|
| 202 | D DISPPRF^DGPFUT1(DGDFN)
|
|---|
| 203 | ;
|
|---|
| 204 | ; restore original Listman VALM DATA global
|
|---|
| 205 | M ^TMP("VALM DATA",$J)=^TMP($J,"DGPFVALM DATA")
|
|---|
| 206 | ;
|
|---|
| 207 | K ^TMP($J,"DGPFVALM DATA")
|
|---|
| 208 | Q
|
|---|
