source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFAPI.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1DGPFAPI ;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 ;
6GETACT(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 ;
145PRFQRY(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 ;
171DISPPRF(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
Note: See TracBrowser for help on using the repository browser.