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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1DGPHSTAT ;ALB/RPM - PURPLE HEART STATUS REPORT ; 02/01/01 8:00am
2 ;;5.3;Registration;**343**;Aug 13, 1993
3 ;
4 ;This report lists all patients with Current PH Status of either
5 ;In Process or Pending. The report can be tasked using TaskMan
6 ;and the EN^DGPHSTAT entry point. The Purple Heart Sort field (#1202)
7 ;of the MAS PARAMETERS file (#43) contains the sort order used
8 ;when queuing from TaskMan. The option allows manual
9 ;generation of the report using a user selected sort order and
10 ;output device.
11 ;
12 Q ;No direct entry
13 ;
14EN ;Entry point
15 I '$D(ZTQUEUED) D MAN Q
16 ;
17QEN ;Start point for TaskMan queuing
18 N DGORD
19 ;
20 ;Retrieve the sort order in numeric: 1-"A"scending or 0-"D"escending
21 S DGORD=$$GETSORT("N")
22 D START
23 Q
24 ;
25MAN ;Start point for manual report allows sort order and device selection
26 N DGORD
27 S DGORD=$$ASKSORT()
28 Q:DGORD=-1
29 I $$DEVICE() D START
30 Q
31 ;
32ASKSORT() ;Requests sort order from user when MAN entry point
33 ; Input: none
34 ;
35 ; Output: Function value Interpretation
36 ; 0 Descending
37 ; 1 Ascending
38 ; -1 "^" or timeout
39 ;
40 N DGSORT,DIR,DIRUT,DTOUT
41 S DIR(0)="SA^D:DESCENDING;A:ASCENDING"
42 S DIR("A")="Select 'A'scending or 'D'escending format: "
43 S DIR("A",1)="The Purple Heart Status report will be sorted by number of days"
44 S DIR("A",2)="since the last Status change in ascending or descending order."
45 S DIR("A",3)=""
46 S DIR("B")=$$GETSORT("E")
47 S DIR("?")="Report will be sorted by number of days since last update."
48 S DIR("??")="Enter 'A' if you want most recent first, 'D' if oldest first."
49 W !!
50 D ^DIR
51 S DGSORT=$S(Y="A":1,1:0)
52 I $D(DIRUT)!$D(DTOUT) S DGSORT=-1
53 Q DGSORT
54 ;
55DEVICE() ;Allow user selection of output device
56 ; Input: none
57 ;
58 ; Output: Function value Interpretation
59 ; 0 User decides to queue or not print report.
60 ; 1 Device selected to generate report NOW.
61 ;
62 N OK,IOP,POP,%ZIS
63 S OK=1
64 S %ZIS="MQ"
65 D ^%ZIS
66 S:POP OK=0
67 I OK,$D(IO("Q")) D
68 . N ZTRTN,ZTDESC,ZTSAVE,ZTSK
69 . S ZTRTN="START^DGPHSTAT"
70 . S ZTDESC="Current PH Status Pending/In Process report."
71 . S ZTSAVE("DGORD")=""
72 . F DG1=1:1:20 D ^%ZTLOAD Q:$G(ZTSK)
73 . W !,$S($D(ZTSK):"Request "_ZTSK_" Queued!",1:"Request Cancelled!"),!
74 . D HOME^%ZIS
75 . S OK=0
76 Q OK
77 ;
78START ;
79 D LOOP
80 D PRINT
81 D EXIT
82 Q
83 ;
84LOOP ;Locate all PENDING and IN-PROCESS status Purple Heart requests
85 ;and build ^TMP("DGPH",$J, with data
86 N DGSTAT ;Purple Heart Status
87 N DGDFN ;Patient DFN
88 K ^TMP("DGPH",$J)
89 F DGSTAT=1,2 D
90 . S DGDFN=0
91 . F S DGDFN=$O(^DPT("C",DGSTAT,DGDFN)) Q:'DGDFN D
92 . . D BLDTMP(DGSTAT,DGDFN,DGORD)
93 Q
94 ;
95BLDTMP(DGST,DFN,DGOR) ;^TMP("DGPH",$J global builder
96 ; Build TMP file based on sort selection
97 ;
98 ; Division name retrieved from pointer to the INSTITUTION file (#4)
99 ; in PH DIVISION field (#.535) in PATIENT file (#2)
100 ; DBIA: #10090 - Supported read to the INSTITUTION file with FileMan
101 ;
102 ; Input:
103 ; DGST - PH Status
104 ; DFN - Patient
105 ; DGOR - Sort Order [default=0 (Descending)]
106 ;
107 N DGDAYS,DGDIV,DGDT,DGNAME,DGNUM,DGSSN,VADM,X,X1,X2,Y
108 ;validate input parameters
109 I $G(DGST)'=1,$G(DGST)'=2 Q
110 Q:'$G(DFN)
111 S DGOR=$G(DGOR,0)
112 ;
113 D ^VADPT
114 S DGNAME=VADM(1)
115 S DGSSN=$P(VADM(2),U,2)
116 S DGNUM=$O(^DPT(DFN,"PH"," "),-1)
117 Q:DGNUM=""
118 S DGDT=$P(^DPT(DFN,"PH",DGNUM,0),U)
119 S X1=DT,X2=DGDT D ^%DTC S DGDAYS=X
120 S Y=DGDT D DD^%DT S DGDT=Y
121 S DGDIV=$$GET1^DIQ(2,DFN,.535)
122 I $G(DGDIV)']"" S DGDIV="UNKNOWN"
123 S ^TMP("DGPH",$J,"REQ",DGDIV,DGST,$S(DGOR:DGDAYS,1:(999-DGDAYS)),DFN)=DGDAYS_"^"_DGDT_"^"_DGNAME_"^"_DGSSN
124 S ^TMP("DGPH",$J,"TOT")=$G(^TMP("DGPH",$J,"TOT"))+1
125 S ^TMP("DGPH",$J,"STAT",DGST)=$G(^TMP("DGPH",$J,"STAT",DGST))+1
126 S ^TMP("DGPH",$J,"DIV",DGDIV)=$G(^TMP("DGPH",$J,"DIV",DGDIV))+1
127 Q
128 ;
129PRINT ;
130 U IO
131 N DG1,DG2,DG3,DG4,DGFIRST,DGLINE
132 N DGSITE,DGSTNUM,DGSTTN,DGSTN
133 N DGQUIT,DGPAGE
134 S DGSITE=$$SITE^VASITE
135 S DGSTNUM=$P(DGSITE,U,3),DGSTN=$P(DGSITE,U,2)
136 S DGSTTN=$$NAME^VASITE(DT)
137 S DGSTN=$S($G(DGSTTN)]"":DGSTTN,1:$G(DGSTN))
138 S DGQUIT=0
139 S DGPAGE=0
140 I '$D(^TMP("DGPH",$J)) D Q
141 . D HEAD
142 . W !!!?20,"**** No records to report. ****"
143 S DG1=""
144 F S DG1=$O(^TMP("DGPH",$J,"REQ",DG1)) Q:DG1']"" D Q:DGQUIT
145 . D HEAD
146 . Q:DGQUIT
147 . W !,"Division: "_DG1
148 . S DG2=0
149 . F S DG2=$O(^TMP("DGPH",$J,"REQ",DG1,DG2)) Q:'DG2 D Q:DGQUIT
150 . . W !!,"DAYS",?13,"DATE"
151 . . W !,$S(DG2="1":"PENDING",1:"IN PROCESS"),?13,$S(DG2="1":"PENDING",1:"IN PROCESS"),?36,"PATIENT NAME",?67,"PATIENT SSN"
152 . . W !,"----------",?13,"----------",?36,"------------",?67,"-----------"
153 . . S DG3=""
154 . . F S DG3=$O(^TMP("DGPH",$J,"REQ",DG1,DG2,DG3)) Q:DG3="" D Q:DGQUIT
155 . . . S DG4=0
156 . . . F S DG4=$O(^TMP("DGPH",$J,"REQ",DG1,DG2,DG3,DG4)) Q:'DG4 D Q:DGQUIT
157 . . . . D:$Y>(IOSL-4) HEAD Q:DGQUIT
158 . . . . S DGLINE=^TMP("DGPH",$J,"REQ",DG1,DG2,DG3,DG4)
159 . . . . W !,$P($G(DGLINE),U),?13,$P($G(DGLINE),U,2),?36,$P($G(DGLINE),U,3),?67,$P($G(DGLINE),U,4)
160 . Q:DGQUIT
161 . W !!?5,"Requests from Division "_DG1_": "_^TMP("DGPH",$J,"DIV",DG1)
162 ;Shutdown if stop task requested
163 I DGQUIT W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
164 ;
165 W !!?7,"Total Number of Pending: "_$S($G(^TMP("DGPH",$J,"STAT","1"))>0:^TMP("DGPH",$J,"STAT","1"),1:0)
166 W !?5,"Total Number of In Process Requests: "_$S($G(^TMP("DGPH",$J,"STAT","2"))>0:^TMP("DGPH",$J,"STAT","2"),1:0)
167 W !?5,"Total Number of Outstanding Requests: "_$G(^TMP("DGPH",$J,"TOT"))
168 Q
169 ;
170HEAD ;
171 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQUIT)=1 Q
172 I $G(DGPAGE)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
173 Q:DGQUIT
174 W @IOF
175 S Y=DT X ^DD("DD") S DGDT=Y
176 S DGPAGE=$G(DGPAGE)+1
177 W !,"PURPLE HEART REQUEST STATUS REPORT",?48,DGDT,?70,"Page: ",$G(DGPAGE)
178 W !,"STATION: "_$G(DGSTN)
179 Q
180 ;
181GETSORT(DGFMT) ;Retrieve the sort order from field 1202 of MAS PARAMETERS file
182 ; Input: DGFMT - selects output format
183 ; Valid values: "N" - numeric [default]
184 ; "I" - internal FM
185 ; "E" - external FM
186 ;
187 ; Output: Function value Interpretation
188 ; 0 Descending order [default] when "N" input
189 ; 1 Ascending order when "N" input
190 ; "D" Descending order when "I" input
191 ; "A" Ascending order when "I" input
192 ; "DESCENDING" Descending order when "E" input
193 ; "ASCENDING" Ascending order when "E" input
194 ;
195 N DGSORT,DGFLG
196 S DGFMT=$G(DGFMT,"N")
197 I DGFMT'="N",DGFMT'="I",DGFMT'="E" S DGFMT="N"
198 S DGFLG=$S(DGFMT="I":"I",DGFMT="E":"E",1:"I")
199 S DGSORT=$$GET1^DIQ(43,"1,",1202,DGFLG)
200 I DGFMT="N" S DGSORT=$S(DGSORT="A":1,1:0)
201 I DGFMT="I" S DGSORT=$S(DGSORT'="":DGSORT,1:"D")
202 I DGFMT="E" S DGSORT=$S(DGSORT'="":DGSORT,1:"DESCENDING")
203 Q DGSORT
204 ;
205EXIT ;
206 I $D(ZTQUEUED) S ZTREQ="@"
207 K ^TMP("DGPH",$J)
208 I '$D(ZTQUEUED) D
209 . K %ZIS,POP
210 . D ^%ZISC,HOME^%ZIS
211 Q
Note: See TracBrowser for help on using the repository browser.