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

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1DGFFP04 ;ALB/SCK - FUGITIVE FELON PROGRAM CLEARED REPORT 12/5/02
2 ;;5.3;Registration;**485**;Aug 13, 1993
3 ;
4QUE ;
5 N ZTSAVE,DGTMP,DIR,Y,DGEND,DGBEG,DIRUT,ZTRTN,ZTDESC,ZTDTH,ZTIO,POP,IO,ZTSK,%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 showing those patients for whom the"
9 S DIR("?",2)="flag was cleared 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^DGFFP02(.DGBEG,.DGEND)
15 ;
16 W !,$CHAR(7)
17 W !?5,">> This report requires a 132-column printer"
18 S %ZIS="Q" D ^%ZIS G EXIT:POP
19 I $D(IO("Q")) D START Q
20 D RPT,^%ZISC
21 Q
22 ;
23START ;
24 S ZTDTH=$$NOW^XLFDT
25 S ZTSAVE("DGBEG")="",ZTSAVE("DGEND")=""
26 S ZTDESC="DGFFP CLEARED FF FLAG REPORT"
27 S ZTRTN="RPT^DGFFP04"
28 D ^%ZTLOAD
29 I $D(ZTSK)[0 W !!?5,"Report canceled"
30 E W !!?5,"Report Queued"
31EXIT D HOME^%ZIS
32 Q
33 ;
34RPT ;
35 N PAGE
36 ;
37 U IO
38 K ^TMP("DGFFP",$J)
39 ;
40 I +DGBEG>0 D GETLST(DGBEG,DGEND)
41 E D GETALL
42 ;
43 D PRINT(DGBEG,DGEND)
44 K ^TMP("DGFFP",$J)
45 D ^%ZISC
46 Q
47 ;
48GETALL ;
49 N DGIEN,DGDFN
50 ;
51 S DGDFN=0
52 F S DGDFN=$O(^DPT(DGDFN)) Q:'DGDFN D
53 . Q:'$D(^DPT(DGDFN,"FFP"))
54 . Q:$D(^DPT("AXFFP",1,DGDFN))
55 . S ^TMP("DGFFP",$J,$P($G(^DPT(DGDFN,0)),U,1),DGDFN)=$G(^("FFP"))
56 Q
57 ;
58GETLST(DGBEG,DGEND) ; Retreive cleared FF Flags by date range (date cleared)
59 N DGDFN,DGFFP
60 ;
61 S DGDFN=0
62 S DGEND=$$FMADD^XLFDT(DGEND,1)
63 F S DGDFN=$O(^DPT(DGDFN)) Q:'DGDFN D
64 . Q:'$D(^DPT(DGDFN,"FFP"))
65 . Q:$D(^DPT("AXFFP",1,DGDFN))
66 . S DGFFP=$G(^DPT(DGDFN,"FFP"))
67 . I $P(DGFFP,U,5)>DGBEG&($P(DGFFP,U,5)<DGEND) D
68 . . S ^TMP("DGFFP",$J,$$GET1^DIQ(2,DGDFN,.01),DGDFN)=DGFFP
69 Q
70 ;
71PRINT(DGBEG,DGEND) ;
72 N DFN,VA,TXT,DGNAME,DGABRT,DGNODE,PAGE
73 ;
74 S PAGE=0
75 D HDR(DGBEG,DGEND)
76 S DGNAME=""
77 F S DGNAME=$O(^TMP("DGFFP",$J,DGNAME)) Q:DGNAME']"" D Q:$G(DGABRT)
78 . S DFN=0
79 . F S DFN=$O(^TMP("DGFFP",$J,DGNAME,DFN)) Q:'DFN D Q:$G(DGABRT)
80 . . D PID^VADPT6
81 . . S TXT=$E(DGNAME,1,$L(DGNAME))_" ("_VA("BID")_")"
82 . . W !,TXT
83 . . S DGNODE=^TMP("DGFFP",$J,DGNAME,DFN)
84 . . W ?40,$$FMTE^XLFDT($P(DGNODE,U,3),"2D")
85 . . W ?50,$$GET1^DIQ(200,$P(DGNODE,U,2),.01)
86 . . W ?80,$$FMTE^XLFDT($P(DGNODE,U,5),"2D")
87 . . W ?90,$$GET1^DIQ(200,$P(DGNODE,U,4),.01)
88 . . W !?5,$P(DGNODE,U,9)
89 Q
90 ;
91HDR(DGBEG,DGEND) ;
92 N LINE,TXT,SPACE
93 ;
94 I $E(IOST,1,2)="C-" W @IOF
95 S TXT="Cleared Fugitive Felon Status Report"
96 S SPACE=(IOM-$L(TXT))/2
97 W !?SPACE,TXT
98 ;
99 I DGBEG>0 D
100 . S TXT="Report Date Range: "_$$FMTE^XLFDT(DGBEG)_" to "_$$FMTE^XLFDT(DGEND)
101 . S SPACE=(IOM-$L(TXT))/2
102 . W !?SPACE,TXT
103 ;
104 S TXT="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
105 S SPACE=(IOM-$L(TXT))/2
106 W !?SPACE,TXT
107 ;
108 S PAGE=PAGE+1
109 S TXT="Page: "_PAGE
110 S SPACE=(IOM-$L(TXT))/2
111 W !?SPACE,TXT
112 ;
113 W !!,"Patient Name",?40,"Entered",?50,"Who Entered",?80,"Cleared",?90,"Who Cleared"
114 S $P(LINE,"=",IOM)="" W !,LINE
115 Q
Note: See TracBrowser for help on using the repository browser.