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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1DGPFLMQ1 ;ALB/RPM - PRF QUERY LISTMAN SCREEN BUILDER; 6/19/06
2 ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
3 ;
4 Q ;no direct entry
5 ;
6BLDHDR(DGORF,DGPFHDR) ;build VALMHDR array
7 ;This procedure builds the VALMHDR array to display the ListMan header.
8 ;
9 ; Supported DBIA #2701: The supported DBIA is used to access the
10 ; MPI functions to retrieve the ICN and CMOR.
11 ;
12 ; Input:
13 ; DGORF - parsed ORF segments data array
14 ; DGPFHDR - header array passed by reference
15 ;
16 ; Output:
17 ; DGPFHDR - header array
18 ;
19 N DGDFN ;pointer to patient in PATIENT (#2) file
20 N DGFACNAM ;facility name
21 N DGICN ;Integrated Control Number
22 N DGPFPAT ;Patient identifying info
23 ;
24 S DGDFN=+$$GETDFN^MPIF001($G(@DGORF@("ICN")))
25 ;
26 ;retrieve patient identifying info
27 I $$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
28 ;
29 ;set 1st line of header
30 S DGPFHDR(1)="Patient: "_$G(DGPFPAT("NAME"))_" "
31 S DGPFHDR(1)=$$SETSTR^VALM1("("_$G(DGPFPAT("SSN"))_")",DGPFHDR(1),$L(DGPFHDR(1))+1,80)
32 S DGPFHDR(1)=$$SETSTR^VALM1("DOB: "_$$FDATE^VALM1($G(DGPFPAT("DOB"))),DGPFHDR(1),54,80)
33 ;
34 ;set 2nd line of header
35 S DGICN=$G(@DGORF@("ICN"))
36 S DGICN=$S(DGICN<0:"No ICN for patient",1:DGICN)
37 S DGPFHDR(2)=" ICN: "_DGICN
38 S DGFACNAM=$$EXTERNAL^DILFD(26.13,.04,"F",$$IEN^XUAF4($G(@DGORF@("SNDFAC"))))
39 S DGPFHDR(2)=$$SETSTR^VALM1("FACILITY QUERIED: "_DGFACNAM,DGPFHDR(2),41,27)
40 Q
41 ;
42 ;
43BLDLIST(DGORF) ;build list of returned assignments
44 ;
45 ; Input:
46 ; DGORF - parsed ORF segments data array
47 ;
48 ; Output: none
49 ;
50 D CLEAN^VALM10
51 N DGSET ;flag assignment indicator
52 ;
53 ;
54 S DGSET=0,VALMCNT=0
55 F S DGSET=$O(@DGORF@(DGSET)) Q:'DGSET D
56 . S VALMCNT=VALMCNT+1
57 . N DGPFA ;assignment data array
58 . ;
59 . ;load assignment data array
60 . D LDASGN^DGPFLMQ2(DGSET,DGORF,.DGPFA)
61 . ;
62 . S DGPFA("INITASSIGN")=$O(@DGORF@(DGSET,0)) ;initial assignment date
63 . ;
64 . ;get most recent assignment history to calculate current status
65 . S DGADT=$O(@DGORF@(DGSET,9999999.999999),-1)
66 . S DGPFA("STATUS")=$$STATUS^DGPFUT($G(@DGORF@(DGSET,DGADT,"ACTION")))
67 . S DGPFA("NUMACT")=$$NUMACT(DGSET,DGORF)
68 . ;
69 . ;build Assignment line
70 . D BLDLIN(VALMCNT,.DGPFA,DGSET)
71 ;
72 Q
73 ;
74 ;
75BLDLIN(DGLNUM,DGPFA,DGSET) ;build and format lines
76 ;This procedure will build and setup ListMan lines and array.
77 ;
78 ; Input:
79 ; DGLNUM - line number
80 ; DGPFA - array containing assignment, passed by reference
81 ; DGSET - set id representing a single PRF assignment
82 ;
83 ; Output: None
84 ;
85 N DGTXT ;used as temporary text field
86 N DGLINE ;string to insert field data
87 S DGLINE="" ;init
88 S DGLINE=$$SETSTR^VALM1(DGLNUM,DGLINE,1,3)
89 ;
90 ;flag name
91 S DGTXT=$$EXTERNAL^DILFD(26.13,.02,"F",$G(DGPFA("FLAG")))
92 S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"FLAG")
93 ;
94 ;initial assignment date
95 S DGTXT=$$FDATE^VALM1(+$G(DGPFA("INITASSIGN")))
96 S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ASSIGN DATE")
97 ;
98 ;status/active (yes/no)
99 S DGTXT=$P($G(DGPFA("STATUS")),U)
100 S DGTXT=$S(DGTXT=1:"YES",1:"NO")
101 S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"STATUS")
102 ;
103 ;# of actions
104 S DGTXT=DGPFA("NUMACT")
105 S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ACTION CNT")
106 ;
107 ;owner site
108 S DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$G(DGPFA("OWNER")))
109 S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"OWNER SITE")
110 ;
111 ;construct initial list array and "IDX"
112 D SET^VALM10(DGLNUM,DGLINE,+$G(DGSET))
113 ;
114 Q
115 ;
116NUMACT(DGSET,DGORF) ;count actions
117 ;This function counts the number of assignment actions for a given
118 ;flag assignment.
119 ;
120 ; Input:
121 ; DGSET - set id representing a single PRF assignment
122 ; DGORF - parsed ORF segments data array
123 ;
124 ; Output:
125 ; Function value - count of assignment actions
126 ;
127 N DGADT ;assignment date
128 N DGCNT ;function value
129 ;
130 S DGADT=0,DGCNT=0
131 F S DGADT=$O(@DGORF@(DGSET,DGADT)) Q:'DGADT S DGCNT=DGCNT+1
132 ;
133 Q DGCNT
134 ;
135 ;
136DR ;Display Query Results action
137 ;This procedure is called by the DGPF DISPLAY QUERY RESULTS action
138 ;protocol.
139 ;
140 ; Input:
141 ; DGORF - parsed ORF segments data array passed globally
142 ;
143 ; Output:
144 ; VALMBCK - 'R'= refresh screen
145 ;
146 N DGSET ;flag assignment indicator
147 N SEL ;user selection
148 N VALMY ;output of EN^VALM2 call, array of user selected entries
149 ;
150 ;set screen to full scroll region
151 D FULL^VALM1
152 ;
153 ;is action selection allowed?
154 I '$D(@VALMAR@("IDX")) D Q
155 . W !!?2,">>> '"_$P($G(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7
156 . W !?6,"There are no record flag assignment query results for this patient."
157 . D PAUSE^VALM1
158 . S VALMBCK="R"
159 ;
160 ;ask user to select a single assignment for detail display
161 S (SEL,VALMBCK)=""
162 D EN^VALM2($G(XQORNOD(0)),"S")
163 ;
164 ;process user selection
165 S SEL=$O(VALMY(""))
166 I SEL,$D(@VALMAR@("IDX",SEL)) D
167 . S DGSET=$O(@VALMAR@("IDX",SEL,""))
168 . ;-display query result flag assignment details
169 . N VALMHDR
170 . D EN^DGPFLMQD(DGSET,DGORF)
171 ;
172 ;return to LM (refresh screen)
173 S VALMBCK="R"
174 Q
Note: See TracBrowser for help on using the repository browser.