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