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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1DGFFP02 ; ALB/SCK - FUGITIVE FELON PROGRAM REPORTS ; 11/14/2002
2 ;;5.3;Registration;**485**;Aug 13, 1993
3 ;
4QUE ;
5 N ZTSAVE,DGTMP,DIR,Y,DGEND,DGBEG,DIRUT,ZTRTN,ZTDESC,ZTDTH,ZTIO,%ZIS
6 ;
7 S DIR(0)="YAO",DIR("B")="YES",DIR("A")="Print report by date range? "
8 S DIR("?",1)="Enter 'YES' to print the report for showing those patients for who the"
9 S DIR("?",2)="flag was set within a specific date range."
10 S DIR("?")="Enter 'NO' to print for all dates."
11 D ^DIR K DIR
12 Q:$D(DIRUT)
13 I '+Y S (DGBEG,DGEND)=0
14 E D GETDT(.DGBEG,.DGEND) Q:'DGBEG
15 ;
16 S %ZIS="Q" D ^%ZIS G EXIT:POP
17 I $D(IO("Q")) D START Q
18 D ADMIN,^%ZISC Q
19 ;
20START ;
21 S ZTDTH=$$NOW^XLFDT
22 S ZTSAVE("DGBEG")="",ZTSAVE("DGEND")=""
23 S ZTDESC="DGFFP FF FLAG ALPHA REPORT"
24 S ZTRTN="ADMIN^DGFFP02"
25 D ^%ZTLOAD
26 I $D(ZTSK)[0 W !!?5,"Report canceled"
27 E W !!?5,"Report Queued"
28EXIT D HOME^%ZIS
29 Q
30 ;
31GETDT(DGBEG,DGEND) ; Retrieve Begin and End date values entered by the user
32 N DIR,DIRUT,Y
33 ;
34 S (DGBEG,DGEND)=0
35 S DIR(0)="DAO^::EX"
36 S DIR("?")="^D HELP^%DTC"
37 S DIR("A")="Enter beginning date for report: "
38 D ^DIR
39 Q:$D(DIRUT)
40 S DGBEG=+Y
41 ;
42 S DIR("A")="Enter end date for report: "
43 D ^DIR
44 I $D(DIRUT) S DGBEG=0 Q
45 S DGEND=+Y
46 Q
47 ;
48ADMIN ;
49 N PAGE
50 ;
51 U IO
52 S PAGE=1
53 K ^TMP("DGFFP",$J)
54 ;
55 I 'DGBEG D BLDALL
56 E D BLD(DGBEG,DGEND)
57 ;
58 D PRINT(DGBEG,DGEND)
59 K ^TMP("DGFFP",$J)
60 D ^%ZISC
61 Q
62 ;
63BLD(DGBEG,DGEND) ; Build report for specified date range
64 N DGIEN,DGFFP
65 ;
66 S DGEND=$$FMADD^XLFDT(DGEND,1)
67 S DGIEN=0
68 F S DGIEN=$O(^DPT("AXFFP",1,DGIEN)) Q:'DGIEN D
69 . S DGFFP=$G(^DPT(DGIEN,"FFP"))
70 . I $P($G(^DPT(DGIEN,"FFP")),U,3)>DGBEG&($P($G(^("FFP")),U,3)<DGEND) D
71 . . S ^TMP("DGFFP",$J,$$GET1^DIQ(2,DGIEN,.01),DGIEN)=DGFFP
72 Q
73 ;
74BLDALL ; Build report for entire date range
75 N DGIEN,DGFFP
76 ;
77 S DGIEN=0
78 F S DGIEN=$O(^DPT("AXFFP",1,DGIEN)) Q:'DGIEN D
79 . S DGFFP=$G(^DPT(DGIEN,"FFP"))
80 . S ^TMP("DGFFP",$J,$$GET1^DIQ(2,DGIEN,.01),DGIEN)=DGFFP
81 Q
82 ;
83PRINT(DGBEG,DGEND) ;
84 N DGNAME,DGUSER,VA,DFN,TXT,DGABRT
85 ;
86 D HDR(DGBEG,DGEND)
87 S DGNAME=""
88 F S DGNAME=$O(^TMP("DGFFP",$J,DGNAME)) Q:DGNAME']"" D Q:$G(DGABRT)
89 . S DFN=0
90 . F S DFN=$O(^TMP("DGFFP",$J,DGNAME,DFN)) Q:'DFN D Q:$G(DGABRT)
91 . . D PID^VADPT6
92 . . S TXT=$E(DGNAME,1,$L(DGNAME))_" "_"("_VA("BID")_")"
93 . . W !,TXT
94 . . W ?40,$$FMTE^XLFDT($P(^TMP("DGFFP",$J,DGNAME,DFN),U,3),"2D")
95 . . S DGUSER=$G(^TMP("DGFFP",$J,DGNAME,DFN))
96 . . I DGUSER>0 W ?50,$$GET1^DIQ(200,$P(DGUSER,U,2),.01)
97 . . I (($Y+5)>IOSL) D
98 . . . I $$PAUSE S DGABRT=1 Q
99 . . . D HDR(DGBEG,DGEND)
100 I $$PAUSE
101 ;
102 Q
103 ;
104PAUSE() ; Screen pause for Terminal displays
105 N DIR,RSLT
106 ;
107 I $E(IOST,1,2)="C-" D
108 . S DIR(0)="E"
109 . D ^DIR K DIR
110 . I 'Y S RSLT=1
111 Q $G(RSLT)
112 ;
113HDR(DGBEG,DGEND) ;
114 N LINE,TXT,SPACE
115 ;
116 I $E(IOST,1,2)="C-" W @IOF
117 S TXT="Fugitive Felon Alpha List"
118 S SPACE=(IOM-$L(TXT))/2
119 W !?SPACE,TXT
120 ;
121 I DGBEG>0 D
122 . S TXT="Report Date Range: "_$$FMTE^XLFDT(DGBEG)_" to "_$$FMTE^XLFDT(DGEND)
123 . S SPACE=(IOM-$L(TXT))/2
124 . W !?SPACE,TXT
125 ;
126 S TXT="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
127 S SPACE=(IOM-$L(TXT))/2
128 W !?SPACE,TXT
129 ;
130 S TXT="Page: "_PAGE
131 S SPACE=(IOM-$L(TXT))/2
132 W !?SPACE,TXT
133 S PAGE=PAGE+1
134 ;
135 W !!,"Patient Name",?40,"Entered",?50,"Who Entered"
136 S $P(LINE,"=",IOM)="" W !,LINE
137 Q
Note: See TracBrowser for help on using the repository browser.