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

DGCVRPT ;ALB/PJR - Unsupported CV End Dates Report;  ; 6/10/04 12:15pm
 ;;5.3;Registration;**564,731**; Aug 13,1993;Build 8
 ;
EN ; Called from DG UNSUPPORTED CV END DATES RPT option
 N DGSRT
 S DGSRT=$$SRT I DGSRT="" Q
 D RPTQUE Q
SRT() ; Get sort order
 ; OUPUT: Y - Sort (N=Name; D=DFN)
 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
 S DIR(0)="SA^N:Name;D:DFN (Internal ID)"
 S DIR("A")="Sort report by Name or DFN (Internal ID): ",DIR("B")="NAME"
 S DIR("?",1)="Indicate whether the report should be sorted by the"
 S DIR("?")="Veteran's Name or the Internal ID (DFN) of the Veteran"
 D ^DIR I $D(DTOUT)!($D(DUOUT)) Q ""
 Q Y
 ;
RPTQUE ; Get report device. Queue report if requested.
 N POP,ZTRTN,ZTDESC,ZTSAVE,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
 K IOP,%ZIS
 S %ZIS="MQ"
 W !
 D ^%ZIS I POP W !!,*7,"Report Cancelled!",! S DIR(0)="E" D ^DIR Q
 I $D(IO("Q")) D  Q
 .S ZTRTN="RPT^DGCVRPT(DGSRT)"
 .S ZTDESC="Print Unsupported CV End Dates Report"
 .S ZTSAVE("DGSRT")=""
 .D ^%ZTLOAD
 .W !!,"Report "_$S($D(ZTSK):"Queued!",1:"Cancelled!")
 .W ! S DIR(0)="E" D ^DIR
 .D HOME^%ZIS
 D RPT(DGSRT)
 D ^%ZISC
 Q
 ;
RPT(DGSRT) ; Entry point to produce report
 D EN1,EN2(DGSRT) Q
EN1 ; Extract
 N RNAME,DFN,RECCOUNT,SELCOUNT,DGXTMP,RES,CEN,CALC,EDITED
 ; Initialize ^XTMP global and set start date
 K ^XTMP("DGCVRPT")
 S RNAME="DG UNSUPPORTED CV END DATE REPORT"
 S ^XTMP("DGCVRPT",0)=$$FMADD^XLFDT(DT,60)_U_DT_U_RNAME
 S $P(^XTMP("DGCVRPT","DATE"),U,1)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
 S:$G(ZTSK) ZTREQ="@"
 ; Set variables and initialize array for counts
 S (DFN,RECCOUNT,SELCOUNT,EDITED)=0
 S DGXTMP="^XTMP(""DGCVRPT"",""NOSUP"")"
 ; Loop through cross-reference "E"
 ; If patient meets report criteria, put on list
 F  S EDITED=$O(^DPT("E",EDITED)) Q:'EDITED  S DFN=0 D
 .F  S DFN=$O(^DPT("E",EDITED,DFN)) Q:'DFN  D CHK I CEN,CEN'=CALC D PUT
 S $P(^XTMP("DGCVRPT","DATE"),U,2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
 K ^XTMP("DGCVRPT","RUNNING"),DGXTMP
 Q
 ;
CHK ; Calculate CV End Date, check MSE data is supporting it
 ; INPUT: DFN - Patient file IEN
 ; OUTPUT: CEN  = CV End Date on file
 ;         CALC = Calculated CV End Date
 N DGARRY
 S RECCOUNT=RECCOUNT+1 D CNT
 S CALC="",CEN=$P($G(^DPT(DFN,.52)),U,15) I 'CEN Q
 S CALC=$$CVDATE(DFN,.DGARRY)
 ; If OEF/OIF date's "to date" is used for the CV End date, (not the
 ;   last SSD), include it as an inconsistency on this report
 I $G(DGARRY("OEF/OIF")),DGARRY("OEF/OIF")>$G(DGARRY(2,DFN_",",.327,"I")) S CALC=""
 Q
 ;
SCH S CALC=$P($$SCH^XLFDT("24M",SSD),".",1) Q
 ;
PUT ; Put record on list
 N NAM,SSN,NZERO
 S SELCOUNT=SELCOUNT+1 D CNT
 S NZERO=$G(^DPT(DFN,0)),NAM=$P(NZERO,U,1),SSN=$P(NZERO,U,9)
 S @DGXTMP@("DFN",DFN,0)=NAM_U_SSN_U_CEN
 I NAM'="" S @DGXTMP@("NAM",NAM,DFN)=""
 Q
 ;
CNT S @DGXTMP@("CNT","VET")=SELCOUNT_U_RECCOUNT Q
 ;
EN2(DGSRT) ; Print
 ; INPUT    DGSRT - Sort order for report (Name or DFN)
 N PG,LINE,RPTDT,CRT,OUT,DSH,CNT,MXLNE,DGXTMP,DGTOT,LOOP
 S:$G(ZTSK) ZTREQ="@"
 D PRTVAR
 U IO D HDR
 ;;
 S LOOP="LOOP"_DGSRT
 D @LOOP Q:OUT
 D TOT Q:OUT
 W ! S OUT=$$PAUSE
 Q
LOOPN ; Sort by name. Loop through ^XTMP("DGCVRPT","NOSUP","NAM", x-ref
 N NM,DFN
 S (NM,DFN)=""
 F  S NM=$O(@DGXTMP@("NAM",NM)) Q:NM=""!OUT  D
 .F  S DFN=$O(@DGXTMP@("NAM",NM,DFN)) Q:DFN=""!OUT  D PRINT
 Q
LOOPD ; Sort by DFN. Loop through ^XTMP("DGCVRPT","NOSUP","DFN", x-ref
 N DFN S DFN=0
 F  S DFN=$O(@DGXTMP@("DFN",DFN)) Q:'DFN!OUT  D PRINT
 Q
PRINT ; Print veteran
 N VET
 Q:'$D(@DGXTMP@("DFN",DFN))
 S VET=$G(@DGXTMP@("DFN",DFN,0))
 I LINE>MXLNE S OUT=$$PAUSE Q:OUT  D HDR
 W !,DFN,?12,$P(VET,U,2),?24,$E($P(VET,U,1),1,39),?64,$$FMTE^XLFDT($P(VET,U,3))
 S LINE=LINE+1 Q
TOT ; Print total records at the end of the report
 I LINE+4>MXLNE S OUT=$$PAUSE Q:OUT  D HDR
 W !!,"Total Records Printed:          ",$$RJ^XLFSTR($P(DGTOT,U,1),7)
 W !!,"Total Records with CV End Dates:",$$RJ^XLFSTR($P(DGTOT,U,2),7)
 Q
PRTVAR ; Set up variables needed to print report
 S CRT=$S($E(IOST,1,2)="C-":1,1:0)
 S DGXTMP="^XTMP(""DGCVRPT"",""NOSUP"")"
 S DGTOT=$G(@DGXTMP@("CNT","VET"))
 S:$G(DGSRT)="" DGSRT="N"
 S (PG,CNT,OUT)=0,RPTDT=$$FMTE^XLFDT(DT),MXLNE=$S(CRT:15,1:52)
 S DSH="",$P(DSH,"=",80)=""
 Q
HDR ; Print report header
 S PG=PG+1,LINE=0
 W @IOF
 W ?0,"Report Date: ",RPTDT,?68,"Page: ",$$RJ^XLFSTR(PG,4)
 W !,"Sorted By: "_$S(DGSRT="N":"Name",1:"DFN")
 W !!,$$CJ^XLFSTR("CV END DATES WITH NO SUPPORTING MS DATA REPORT",80)
 W !!,"DFN",?12,"SSN",?24,"Veteran's Name",?64,"CV End Date"
 W !,DSH
 Q
PAUSE() ; If report is sent to screen, prompt for next page or quit
 N DIR,DIRUT,DUOUT,DTOUT,X,Y
 I 'CRT Q 0
 S DIR(0)="E"
 D ^DIR I 'Y Q 1
 Q 0
CVDATE(DFN,DGARR,DGERR) ; Returns all values for calculating the CV End date
 ; in DGARR (passed by reference)
 ;   AND
 ; any error codes from the DIQ call in DGERR (passed by reference)
 ;   AND
 ; the calculated CV End Date as the result of the function call
 ;
 N N,DATE,SSD,X,Y
 S DATE=""
 D GETS^DIQ(2,DFN_",",".327;.322012;.322018;.322021;.5294;.5295","I","DGARR","DGERR")
 S DGARR("OEF/OIF")=$P($$LAST^DGENOEIF(DFN),U)
 S SSD=$G(DGARRY(2,DFN_",",.327,"I"))
 ; If OEF/OIF date later than last serv sep dt, use to date of OEF/OIF
 I $G(DGARRY("OEF/OIF")),DGARRY("OEF/OIF")>SSD S DATE=DGARRY("OEF/OIF") G CVDATEQ
 I SSD D
 . Q:$E(SSD,6,7)="00"!(SSD'>2981111)
 . ; If conflict dates exist for any of the above listed fields, use SSD 
 . 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
 ;
CVDATEQ Q $S(DATE:$P($$SCH^XLFDT("24M",DATE),".",1),1:"")
 ;