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

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

initial load of WorldVistAEHR

File size: 5.9 KB
Line 
1DGPFRPA1 ;ALB/RBS - PRF PATIENT ASSIGNMENTS REPORT CONT. ; 5/21/04 12:53pm
2 ;;5.3;Registration;**554**;Aug 13, 1993
3 ;
4 ;This routine will be used to display or print all the record flag
5 ;assignments of a patient.
6 ;
7 ; Input: The following sort array contains the report parameters:
8 ; DGSORT("DGDFN") = Patient IEN of (#2) file to report on
9 ; DGSORT("DGSTATUS") = Assignment Status to report on
10 ; = 1;Active, 2:Inactive, 3:Both
11 ;
12 ; Output:
13 ; A formatted report of Record Flag Assignments for a patient.
14 ;
15 ;- no direct entry
16 QUIT
17 ;
18START ; compile and print report
19 I $E(IOST)="C" D WAIT^DICD
20 N DGLIST ;temp global name used for report list
21 S DGLIST=$NA(^TMP("DGPFRPA1",$J))
22 K @DGLIST
23 D LOOP(.DGSORT,DGLIST)
24 D PRINT(.DGSORT,DGLIST)
25 K @DGLIST
26 D EXIT
27 Q
28 ;
29LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list
30 ; Input:
31 ; DGSORT - array of user selected report parameters
32 ; DGLIST - temp global name
33 ;
34 ; Output:
35 ; ^TMP("DGPFRPA1",$J) - temp global used for report output
36 ;
37 N DGDFN ;pointer to patient being reported on
38 N DGIEN ;ien of assignment record
39 N DGIENS ;array of ien's of the patients assignments records
40 N DGPAT ;patient data array
41 N DGPFA ;assignment data array
42 N DGSSN ;patient ssn
43 N DGSTAT ;status of assignment
44 N DGSTATUS ;assignment status to report on
45 N DGX ;loop var
46 ;
47 ; setup variables equal to user input parameter subscripts
48 ; "DGDFN", "DGSTATUS"
49 S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
50 ;
51 S DGSTAT=+DGSTATUS ; assignments status to report on
52 S:DGSTAT=2 DGSTAT=0 ; inactive status value is '0'
53 ;
54 ; get patient demographics to setup patient name & ssn
55 K DGPAT
56 Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
57 ; add patient name & ssn to DGSORT for printing
58 S DGSSN=$E(DGPAT("SSN"),1,3)_"-"_$E(DGPAT("SSN"),4,5)_"-"_$E(DGPAT("SSN"),6,10)
59 S DGSORT("DGDFN")=DGSORT("DGDFN")_U_DGPAT("NAME")_U_DGSSN
60 ; get list of all assignments for patient
61 Q:'$$GETALL^DGPFAA(DGDFN,.DGIENS)
62 S DGIEN=0
63 F S DGIEN=$O(DGIENS(DGIEN)) Q:'DGIEN D
64 . ; get assignment record fields
65 . K DGPFA
66 . Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
67 . I +DGSTATUS'=3,($P(DGPFA("STATUS"),U)'=DGSTAT) Q
68 . ; call to build temp global
69 . D BLDTMP(.DGPFA,DGIEN,DGLIST)
70 ;
71 Q
72 ;
73BLDTMP(DGPFA,DGIEN,DGLIST) ; list global builder
74 ; Input:
75 ; DGPFA - array of assignment record data
76 ; DGIEN - ien pointer to PRF ASSIGNMENT (#26.13) file record
77 ; DGLIST - temp global name used for report list
78 ;
79 ; Output:
80 ; ^TMP("DGPFRPA1",$J) - temp global containing report output
81 ;
82 N DGACTDT ;initial entry date
83 N DGAPRVBY ;approved by person name
84 N DGCATG ;category of flag
85 N DGFGNM ;flag name
86 N DGLINE ;report detail display line
87 N DGPCAT ;print output of category
88 N DGPFAH ;array of assignment history data
89 N DGREVDT ;review date
90 ;
91 ; get initial assignment history
92 Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
93 Q:'$G(DGPFAH("ASSIGNDT"))
94 S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
95 S DGREVDT=+DGPFA("REVIEWDT")
96 S DGREVDT=$S(DGREVDT:$$FDATE^VALM1(DGREVDT),1:"N/A")
97 S DGFGNM=$P(DGPFA("FLAG"),U,2)
98 S:DGFGNM']"" DGFGNM="MISSING FLAG NAME"
99 S DGAPRVBY=$P(DGPFAH("APPRVBY"),U,2)
100 S:DGAPRVBY']"" DGAPRVBY="Missing Name"
101 S DGCATG=$S(DGPFA("FLAG")[26.15:1,1:2) ;category
102 S DGPCAT=$S(DGCATG=1:"I",1:"II")
103 S DGLINE=$E(DGFGNM,1,15)_U_DGPCAT_U_$E(DGAPRVBY,1,15)_U_DGACTDT_U_DGREVDT_U_$P(DGPFA("STATUS"),U,2)_U_$E($P(DGPFA("OWNER"),U,2),1,15)
104 S @DGLIST@(DGCATG,+DGPFAH("ASSIGNDT"))=DGLINE
105 Q
106 ;
107PRINT(DGSORT,DGLIST) ;output report
108 ; Input:
109 ; DGSORT - array of user selected report parameters
110 ; DGLIST - temp global name used for report list
111 ;
112 ; Output: Formatted report to user selected device
113 ;
114 N DGCAT ;flag category
115 N DGCNT ;flag counter
116 N DGDFN ;ien of patient
117 N DGDT ;date time report printed
118 N DGFG ;flag name
119 N DGLINE ;string of hyphens (80) for report header format
120 N DGNAM ;patient name
121 N DGPAGE ;page counter
122 N DGQ ;quit flag
123 N DGSTAT ;status report is run for
124 N DGSTR ;string of detail line to display
125 N X,Y
126 ;
127 S (DGCNT,DGQ,DGPAGE)=0,$P(DGLINE,"-",81)=""
128 S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
129 S DGSTAT=+DGSORT("DGSTATUS")
130 ;
131 I $O(@DGLIST@(""))="" D Q
132 . D HEAD
133 . W !!," >>> No Record Flag Assignments were found using the report criteria.",!
134 ;
135 ; loop and print report
136 S (DGCAT,DGFG,DGNAM,DGDFN,DGSTR)="",DGCNT=0
137 D HEAD
138 F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ
139 . F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ
140 .. I $Y>(IOSL-4) D PAUSE(.DGQ) Q:DGQ D HEAD
141 .. S DGSTR=$G(@DGLIST@(DGCAT,DGFG))
142 .. S DGCNT=DGCNT+1
143 .. W !,DGCNT,?3,$E($P(DGSTR,U),1,17),?21,$P(DGSTR,U,2),?25,$E($P(DGSTR,U,3),1,11),?38,$P(DGSTR,U,4),?48,$P(DGSTR,U,5),?59,$P(DGSTR,U,6),?69,$E($P(DGSTR,U,7),1,11)
144 . Q:DGQ
145 ;
146 ;Shutdown if stop task requested
147 I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
148 ;
149 W !!,"<End of Report>"
150 Q
151 ;
152PAUSE(DGQ) ; pause screen display
153 ; Input:
154 ; DGQ - var used to quit report processing to user CRT
155 ; Output:
156 ; DGQ - passed by reference - 0 = Continue, 1 = Quit
157 ;
158 I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1
159 Q
160 ;
161HEAD ;Print/Display page header
162 ;
163 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
164 ;
165 W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
166 ;
167 S DGPAGE=$G(DGPAGE)+1
168 W !?25,"PATIENT RECORD FLAGS"
169 W !?22,"PATIENT ASSIGNMENTS REPORT",?68,"Page: ",$G(DGPAGE)
170 W !,"Report Selected: "_$S(DGSTAT=1:"ACTIVE",DGSTAT=2:"INACTIVE",1:"Both (ACTIVE & INACTIVE)")
171 W ?50,"Printed: ",DGDT
172 W !,DGLINE
173 W !!,"Patient: ",$P(DGSORT("DGDFN"),U,2)," ",$P(DGSORT("DGDFN"),U,3)
174 W !!?3,"FLAG NAME",?15,"CATEGORY",?25,"APPROVED BY",?38,"ENTERED",?48,"REVIEW DT",?59,"STATUS",?69,"OWNING SITE"
175 W !,"------------------",?20,"---",?25,"-----------",?38,"--------",?48,"---------",?59,"--------",?69,"-----------"
176 Q
177 ;
178EXIT ;
179 I $D(ZTQUEUED) S ZTREQ="@"
180 I '$D(ZTQUEUED) D
181 . K %ZIS,POP
182 . D ^%ZISC,HOME^%ZIS
183 Q
Note: See TracBrowser for help on using the repository browser.