source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGCVRPT.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.3 KB
Line 
1DGCVRPT ;ALB/PJR - Unsupported CV End Dates Report; ; 6/10/04 12:15pm
2 ;;5.3;Registration;**564,731**; Aug 13,1993;Build 8
3 ;
4EN ; Called from DG UNSUPPORTED CV END DATES RPT option
5 N DGSRT
6 S DGSRT=$$SRT I DGSRT="" Q
7 D RPTQUE Q
8SRT() ; Get sort order
9 ; OUPUT: Y - Sort (N=Name; D=DFN)
10 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
11 S DIR(0)="SA^N:Name;D:DFN (Internal ID)"
12 S DIR("A")="Sort report by Name or DFN (Internal ID): ",DIR("B")="NAME"
13 S DIR("?",1)="Indicate whether the report should be sorted by the"
14 S DIR("?")="Veteran's Name or the Internal ID (DFN) of the Veteran"
15 D ^DIR I $D(DTOUT)!($D(DUOUT)) Q ""
16 Q Y
17 ;
18RPTQUE ; Get report device. Queue report if requested.
19 N POP,ZTRTN,ZTDESC,ZTSAVE,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
20 K IOP,%ZIS
21 S %ZIS="MQ"
22 W !
23 D ^%ZIS I POP W !!,*7,"Report Cancelled!",! S DIR(0)="E" D ^DIR Q
24 I $D(IO("Q")) D Q
25 .S ZTRTN="RPT^DGCVRPT(DGSRT)"
26 .S ZTDESC="Print Unsupported CV End Dates Report"
27 .S ZTSAVE("DGSRT")=""
28 .D ^%ZTLOAD
29 .W !!,"Report "_$S($D(ZTSK):"Queued!",1:"Cancelled!")
30 .W ! S DIR(0)="E" D ^DIR
31 .D HOME^%ZIS
32 D RPT(DGSRT)
33 D ^%ZISC
34 Q
35 ;
36RPT(DGSRT) ; Entry point to produce report
37 D EN1,EN2(DGSRT) Q
38EN1 ; Extract
39 N RNAME,DFN,RECCOUNT,SELCOUNT,DGXTMP,RES,CEN,CALC,EDITED
40 ; Initialize ^XTMP global and set start date
41 K ^XTMP("DGCVRPT")
42 S RNAME="DG UNSUPPORTED CV END DATE REPORT"
43 S ^XTMP("DGCVRPT",0)=$$FMADD^XLFDT(DT,60)_U_DT_U_RNAME
44 S $P(^XTMP("DGCVRPT","DATE"),U,1)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
45 S:$G(ZTSK) ZTREQ="@"
46 ; Set variables and initialize array for counts
47 S (DFN,RECCOUNT,SELCOUNT,EDITED)=0
48 S DGXTMP="^XTMP(""DGCVRPT"",""NOSUP"")"
49 ; Loop through cross-reference "E"
50 ; If patient meets report criteria, put on list
51 F S EDITED=$O(^DPT("E",EDITED)) Q:'EDITED S DFN=0 D
52 .F S DFN=$O(^DPT("E",EDITED,DFN)) Q:'DFN D CHK I CEN,CEN'=CALC D PUT
53 S $P(^XTMP("DGCVRPT","DATE"),U,2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
54 K ^XTMP("DGCVRPT","RUNNING"),DGXTMP
55 Q
56 ;
57CHK ; Calculate CV End Date, check MSE data is supporting it
58 ; INPUT: DFN - Patient file IEN
59 ; OUTPUT: CEN = CV End Date on file
60 ; CALC = Calculated CV End Date
61 N DGARRY
62 S RECCOUNT=RECCOUNT+1 D CNT
63 S CALC="",CEN=$P($G(^DPT(DFN,.52)),U,15) I 'CEN Q
64 S CALC=$$CVDATE(DFN,.DGARRY)
65 ; If OEF/OIF date's "to date" is used for the CV End date, (not the
66 ; last SSD), include it as an inconsistency on this report
67 I $G(DGARRY("OEF/OIF")),DGARRY("OEF/OIF")>$G(DGARRY(2,DFN_",",.327,"I")) S CALC=""
68 Q
69 ;
70SCH S CALC=$P($$SCH^XLFDT("24M",SSD),".",1) Q
71 ;
72PUT ; Put record on list
73 N NAM,SSN,NZERO
74 S SELCOUNT=SELCOUNT+1 D CNT
75 S NZERO=$G(^DPT(DFN,0)),NAM=$P(NZERO,U,1),SSN=$P(NZERO,U,9)
76 S @DGXTMP@("DFN",DFN,0)=NAM_U_SSN_U_CEN
77 I NAM'="" S @DGXTMP@("NAM",NAM,DFN)=""
78 Q
79 ;
80CNT S @DGXTMP@("CNT","VET")=SELCOUNT_U_RECCOUNT Q
81 ;
82EN2(DGSRT) ; Print
83 ; INPUT DGSRT - Sort order for report (Name or DFN)
84 N PG,LINE,RPTDT,CRT,OUT,DSH,CNT,MXLNE,DGXTMP,DGTOT,LOOP
85 S:$G(ZTSK) ZTREQ="@"
86 D PRTVAR
87 U IO D HDR
88 ;;
89 S LOOP="LOOP"_DGSRT
90 D @LOOP Q:OUT
91 D TOT Q:OUT
92 W ! S OUT=$$PAUSE
93 Q
94LOOPN ; Sort by name. Loop through ^XTMP("DGCVRPT","NOSUP","NAM", x-ref
95 N NM,DFN
96 S (NM,DFN)=""
97 F S NM=$O(@DGXTMP@("NAM",NM)) Q:NM=""!OUT D
98 .F S DFN=$O(@DGXTMP@("NAM",NM,DFN)) Q:DFN=""!OUT D PRINT
99 Q
100LOOPD ; Sort by DFN. Loop through ^XTMP("DGCVRPT","NOSUP","DFN", x-ref
101 N DFN S DFN=0
102 F S DFN=$O(@DGXTMP@("DFN",DFN)) Q:'DFN!OUT D PRINT
103 Q
104PRINT ; Print veteran
105 N VET
106 Q:'$D(@DGXTMP@("DFN",DFN))
107 S VET=$G(@DGXTMP@("DFN",DFN,0))
108 I LINE>MXLNE S OUT=$$PAUSE Q:OUT D HDR
109 W !,DFN,?12,$P(VET,U,2),?24,$E($P(VET,U,1),1,39),?64,$$FMTE^XLFDT($P(VET,U,3))
110 S LINE=LINE+1 Q
111TOT ; Print total records at the end of the report
112 I LINE+4>MXLNE S OUT=$$PAUSE Q:OUT D HDR
113 W !!,"Total Records Printed: ",$$RJ^XLFSTR($P(DGTOT,U,1),7)
114 W !!,"Total Records with CV End Dates:",$$RJ^XLFSTR($P(DGTOT,U,2),7)
115 Q
116PRTVAR ; Set up variables needed to print report
117 S CRT=$S($E(IOST,1,2)="C-":1,1:0)
118 S DGXTMP="^XTMP(""DGCVRPT"",""NOSUP"")"
119 S DGTOT=$G(@DGXTMP@("CNT","VET"))
120 S:$G(DGSRT)="" DGSRT="N"
121 S (PG,CNT,OUT)=0,RPTDT=$$FMTE^XLFDT(DT),MXLNE=$S(CRT:15,1:52)
122 S DSH="",$P(DSH,"=",80)=""
123 Q
124HDR ; Print report header
125 S PG=PG+1,LINE=0
126 W @IOF
127 W ?0,"Report Date: ",RPTDT,?68,"Page: ",$$RJ^XLFSTR(PG,4)
128 W !,"Sorted By: "_$S(DGSRT="N":"Name",1:"DFN")
129 W !!,$$CJ^XLFSTR("CV END DATES WITH NO SUPPORTING MS DATA REPORT",80)
130 W !!,"DFN",?12,"SSN",?24,"Veteran's Name",?64,"CV End Date"
131 W !,DSH
132 Q
133PAUSE() ; If report is sent to screen, prompt for next page or quit
134 N DIR,DIRUT,DUOUT,DTOUT,X,Y
135 I 'CRT Q 0
136 S DIR(0)="E"
137 D ^DIR I 'Y Q 1
138 Q 0
139CVDATE(DFN,DGARR,DGERR) ; Returns all values for calculating the CV End date
140 ; in DGARR (passed by reference)
141 ; AND
142 ; any error codes from the DIQ call in DGERR (passed by reference)
143 ; AND
144 ; the calculated CV End Date as the result of the function call
145 ;
146 N N,DATE,SSD,X,Y
147 S DATE=""
148 D GETS^DIQ(2,DFN_",",".327;.322012;.322018;.322021;.5294;.5295","I","DGARR","DGERR")
149 S DGARR("OEF/OIF")=$P($$LAST^DGENOEIF(DFN),U)
150 S SSD=$G(DGARRY(2,DFN_",",.327,"I"))
151 ; If OEF/OIF date later than last serv sep dt, use to date of OEF/OIF
152 I $G(DGARRY("OEF/OIF")),DGARRY("OEF/OIF")>SSD S DATE=DGARRY("OEF/OIF") G CVDATEQ
153 I SSD D
154 . Q:$E(SSD,6,7)="00"!(SSD'>2981111)
155 . ; If conflict dates exist for any of the above listed fields, use SSD
156 . S N=0 F S N=$O(DGARR(2,DFN_",",N)) Q:'N I N'=.327,$G(DGARR(2,DFN_",",N,"I"))>2981111 S DATE=SSD Q
157 ;
158CVDATEQ Q $S(DATE:$P($$SCH^XLFDT("24M",DATE),".",1),1:"")
159 ;
Note: See TracBrowser for help on using the repository browser.