Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGCVRPT

DGCVRPT.m

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