DGMT141A ;ALB/ABR - SC 0% MT CHANGES REPORT (PATCH DG*5.3*141) ; 9/25/97
;;5.3;Registration;**141**;Aug 13, 1993
;
EN ; entry point
N DGREPT,I,DIR,POP,TXT,X,Y,%ZIS,ZTSK,ZTSAVE,ZTDESC,ZTRTN
;
F I=1:1 S TXT=$P($T(TXT+I),";;",2) Q:TXT["$END" D MES^XPDUTL(TXT) ; print TXT
;
S DIR(0)="SM^1:Veterans who now REQUIRE a Means Test;2:Veterans who no longer require a Means Test;3:ALL"
S DIR("B")="ALL",DIR("A")="Select REPORT"
D ^DIR
I '$G(Y) D BMES^XPDUTL(" >> No Report Selected") Q
S DGREPT=Y
;check for data
I DGREPT=3,'$D(^XTMP("DG53141G",1)),'$D(^XTMP("DG53141G",3)) D BMES^XPDUTL(" No entries to print") D EXIT Q
I DGREPT=1,'$D(^XTMP("DG53141G",1)) D BMES^XPDUTL(" No entries to print") D EXIT Q
I DGREPT=2,'$D(^XTMP("DG53141G",3)) D BMES^XPDUTL(" No entries to print") D EXIT Q
; select device,queuing
S %ZIS="QM" D ^%ZIS I POP D BMES^XPDUTL(" Try again later.") Q
; if queueing
I $D(IO("Q")) D Q
. S ZTRTN="RPT^DGMT141A",ZTDESC="SC 0% MT CHANGES REPORT",ZTSAVE("DGREPT")=""
. D ^%ZTLOAD I '$G(ZTSK) D BMES^XPDUTL(" Report cancelled. Try again later.") Q
. D BMES^XPDUTL(" ==> Task "_ZTSK_" queued.")
;
U IO
D RPT ; report display entry point
D ^%ZISC
D EXIT
Q
RPT ; run report
N DGDTTI,DGHOME,DGST,DGTOT,DGTOT1,DGTOT3,HDR,PAGE,MTSTAT,LID,NAME,COP,COPAY,PRST,PRSTA
N DGPT,DGSRT,STR,DGI
I IO=IO(0)&($E(IOST,1,2)["C-") S DGHOME=1 ; if home device, to check for paging prompt
S DGSRT(1)="Outpatient Encounters: ",DGSRT(2)="Inpatients: ",DGSRT(3)="Future Appointements: ",DGSRT(4)="Current MT or Copay test on file: "
;
I DGREPT#2 D D REQ ; vets require mt
. S DGTOT1=0 F DGI=1:1:4 S DGTOT1=DGTOT1+$G(^XTMP("DG53141G",1,DGI,0))
I $G(DGST) Q ; if ^-out to page prompt
I DGREPT>1 D D NOTREQ ; not require mt
. S DGTOT3=0 F DGI=1:1:4 S DGTOT3=DGTOT3+$G(^XTMP("DG53141G",3,DGI,0))
Q
REQ ; vets require mt
S MTSTAT=1
S DGDTTI=$$HTE^XLFDT($H) ; set date/time of report
S HDR="SC 0% VETERANS WHO NOW REQUIRE A MEANS TEST: ("_DGTOT1_" vets)",PAGE=0
;
D PRINT
Q
NOTREQ ; vets don't require mt
S MTSTAT=3
S DGDTTI=$$HTE^XLFDT($H) ; set date/time of report
S HDR="SC 0% VETERANS WHO NO LONGER REQUIRE A MEANS TEST: ("_DGTOT3_" vets)",PAGE=0
;
D PRINT
Q
PRINT ; report printing
N DGPT
F DGSRT=1:1:4 Q:$G(DGST) S DGPT=0 I $O(^XTMP("DG53141G",MTSTAT,DGSRT,DGPT))]"" D
. S DGSRT(DGSRT)=DGSRT(DGSRT)_+$G(^XTMP("DG53141G",MTSTAT,DGSRT,0))_" veteran(s)"
. D HDR F S DGPT=$O(^XTMP("DG53141G",MTSTAT,DGSRT,DGPT)) Q:DGPT="" S STR=^(DGPT) D Q:$G(DGST)
.. S NAME=$P(DGPT,"_"),PRST=+STR,LID=$P(STR,U,2),COP=$P(STR,U,3)
.. S PRSTA=$P($G(^DG(408.32,PRST,0)),U)
.. W !,NAME,?48,LID,?60,PRSTA
.. I COP S COPAY=$P(^DG(408.32,COP,0),U) W ?82,COPAY
.. I $Y>(IOSL-2) D HDR
Q
HDR ; header and paging
S PAGE=PAGE+1 I PAGE>1&$G(DGHOME) D Q:$G(DGST)
. N X,Y,DIR,CTR
. S DIR(0)="E" D ^DIR S DGST='Y
W @IOF,!?(IOM-$L(HDR)\2),HDR,!!,"page ",PAGE,?(IOM-23),DGDTTI
W !!,"Name",?48,"Long ID",?60,"Previous MT Status",?82,"Current COPAY status, if changed"
W ! F I=1:1:IOM-1 W "-"
S CTR=IOM-(28+$L(DGSRT(DGSRT)))\2
W !,?CTR,"** MT Changes found from ",DGSRT(DGSRT),!
Q
;
EXIT ; clean up variables
K DGREPT
TXT ; report description
;;
;;This report will list those veterans, SC<50%, SC 0% whose Means Test status
;;was changed as a result of the revised Secondary Eligibility checks.
;;
;;The source for this listing is the clean-up that was run as part of
;;patch DG*5.3*141. There are 2 possible reports:
;;
;; 1 - Veterans who now REQUIRE a Means Test
;; 2 - Veterans who no longer require a Means Test.
;;
;;Each of these reports has been divided into 3 parts, based on why
;;the veteran's status was reviewed:
;;
;; If, during the timeframe between the installation of the Tricare
;; patch and the date the clean-up was run, the Veteran:
;; 1) had an Outpatient Encounter.
;; 2) was an inpatient.
;; 3) had a future appointment made.
;; 4) has current Means Test or Copay test on file
;;
;; ** This report requires 132 columns! **
;;
;;$END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMT141A 4134 printed Dec 13, 2024@02:44:32 Page 2
DGMT141A ;ALB/ABR - SC 0% MT CHANGES REPORT (PATCH DG*5.3*141) ; 9/25/97
+1 ;;5.3;Registration;**141**;Aug 13, 1993
+2 ;
EN ; entry point
+1 NEW DGREPT,I,DIR,POP,TXT,X,Y,%ZIS,ZTSK,ZTSAVE,ZTDESC,ZTRTN
+2 ;
+3 ; print TXT
FOR I=1:1
SET TXT=$PIECE($TEXT(TXT+I),";;",2)
if TXT["$END"
QUIT
DO MES^XPDUTL(TXT)
+4 ;
+5 SET DIR(0)="SM^1:Veterans who now REQUIRE a Means Test;2:Veterans who no longer require a Means Test;3:ALL"
+6 SET DIR("B")="ALL"
SET DIR("A")="Select REPORT"
+7 DO ^DIR
+8 IF '$GET(Y)
DO BMES^XPDUTL(" >> No Report Selected")
QUIT
+9 SET DGREPT=Y
+10 ;check for data
+11 IF DGREPT=3
IF '$DATA(^XTMP("DG53141G",1))
IF '$DATA(^XTMP("DG53141G",3))
DO BMES^XPDUTL(" No entries to print")
DO EXIT
QUIT
+12 IF DGREPT=1
IF '$DATA(^XTMP("DG53141G",1))
DO BMES^XPDUTL(" No entries to print")
DO EXIT
QUIT
+13 IF DGREPT=2
IF '$DATA(^XTMP("DG53141G",3))
DO BMES^XPDUTL(" No entries to print")
DO EXIT
QUIT
+14 ; select device,queuing
+15 SET %ZIS="QM"
DO ^%ZIS
IF POP
DO BMES^XPDUTL(" Try again later.")
QUIT
+16 ; if queueing
+17 IF $DATA(IO("Q"))
Begin DoDot:1
+18 SET ZTRTN="RPT^DGMT141A"
SET ZTDESC="SC 0% MT CHANGES REPORT"
SET ZTSAVE("DGREPT")=""
+19 DO ^%ZTLOAD
IF '$GET(ZTSK)
DO BMES^XPDUTL(" Report cancelled. Try again later.")
QUIT
+20 DO BMES^XPDUTL(" ==> Task "_ZTSK_" queued.")
End DoDot:1
QUIT
+21 ;
+22 USE IO
+23 ; report display entry point
DO RPT
+24 DO ^%ZISC
+25 DO EXIT
+26 QUIT
RPT ; run report
+1 NEW DGDTTI,DGHOME,DGST,DGTOT,DGTOT1,DGTOT3,HDR,PAGE,MTSTAT,LID,NAME,COP,COPAY,PRST,PRSTA
+2 NEW DGPT,DGSRT,STR,DGI
+3 ; if home device, to check for paging prompt
IF IO=IO(0)&($EXTRACT(IOST,1,2)["C-")
SET DGHOME=1
+4 SET DGSRT(1)="Outpatient Encounters: "
SET DGSRT(2)="Inpatients: "
SET DGSRT(3)="Future Appointements: "
SET DGSRT(4)="Current MT or Copay test on file: "
+5 ;
+6 ; vets require mt
IF DGREPT#2
Begin DoDot:1
+7 SET DGTOT1=0
FOR DGI=1:1:4
SET DGTOT1=DGTOT1+$GET(^XTMP("DG53141G",1,DGI,0))
End DoDot:1
DO REQ
+8 ; if ^-out to page prompt
IF $GET(DGST)
QUIT
+9 ; not require mt
IF DGREPT>1
Begin DoDot:1
+10 SET DGTOT3=0
FOR DGI=1:1:4
SET DGTOT3=DGTOT3+$GET(^XTMP("DG53141G",3,DGI,0))
End DoDot:1
DO NOTREQ
+11 QUIT
REQ ; vets require mt
+1 SET MTSTAT=1
+2 ; set date/time of report
SET DGDTTI=$$HTE^XLFDT($HOROLOG)
+3 SET HDR="SC 0% VETERANS WHO NOW REQUIRE A MEANS TEST: ("_DGTOT1_" vets)"
SET PAGE=0
+4 ;
+5 DO PRINT
+6 QUIT
NOTREQ ; vets don't require mt
+1 SET MTSTAT=3
+2 ; set date/time of report
SET DGDTTI=$$HTE^XLFDT($HOROLOG)
+3 SET HDR="SC 0% VETERANS WHO NO LONGER REQUIRE A MEANS TEST: ("_DGTOT3_" vets)"
SET PAGE=0
+4 ;
+5 DO PRINT
+6 QUIT
PRINT ; report printing
+1 NEW DGPT
+2 FOR DGSRT=1:1:4
if $GET(DGST)
QUIT
SET DGPT=0
IF $ORDER(^XTMP("DG53141G",MTSTAT,DGSRT,DGPT))]""
Begin DoDot:1
+3 SET DGSRT(DGSRT)=DGSRT(DGSRT)_+$GET(^XTMP("DG53141G",MTSTAT,DGSRT,0))_" veteran(s)"
+4 DO HDR
FOR
SET DGPT=$ORDER(^XTMP("DG53141G",MTSTAT,DGSRT,DGPT))
if DGPT=""
QUIT
SET STR=^(DGPT)
Begin DoDot:2
+5 SET NAME=$PIECE(DGPT,"_")
SET PRST=+STR
SET LID=$PIECE(STR,U,2)
SET COP=$PIECE(STR,U,3)
+6 SET PRSTA=$PIECE($GET(^DG(408.32,PRST,0)),U)
+7 WRITE !,NAME,?48,LID,?60,PRSTA
+8 IF COP
SET COPAY=$PIECE(^DG(408.32,COP,0),U)
WRITE ?82,COPAY
+9 IF $Y>(IOSL-2)
DO HDR
End DoDot:2
if $GET(DGST)
QUIT
End DoDot:1
+10 QUIT
HDR ; header and paging
+1 SET PAGE=PAGE+1
IF PAGE>1&$GET(DGHOME)
Begin DoDot:1
+2 NEW X,Y,DIR,CTR
+3 SET DIR(0)="E"
DO ^DIR
SET DGST='Y
End DoDot:1
if $GET(DGST)
QUIT
+4 WRITE @IOF,!?(IOM-$LENGTH(HDR)\2),HDR,!!,"page ",PAGE,?(IOM-23),DGDTTI
+5 WRITE !!,"Name",?48,"Long ID",?60,"Previous MT Status",?82,"Current COPAY status, if changed"
+6 WRITE !
FOR I=1:1:IOM-1
WRITE "-"
+7 SET CTR=IOM-(28+$LENGTH(DGSRT(DGSRT)))\2
+8 WRITE !,?CTR,"** MT Changes found from ",DGSRT(DGSRT),!
+9 QUIT
+10 ;
EXIT ; clean up variables
+1 KILL DGREPT
TXT ; report description
+1 ;;
+2 ;;This report will list those veterans, SC<50%, SC 0% whose Means Test status
+3 ;;was changed as a result of the revised Secondary Eligibility checks.
+4 ;;
+5 ;;The source for this listing is the clean-up that was run as part of
+6 ;;patch DG*5.3*141. There are 2 possible reports:
+7 ;;
+8 ;; 1 - Veterans who now REQUIRE a Means Test
+9 ;; 2 - Veterans who no longer require a Means Test.
+10 ;;
+11 ;;Each of these reports has been divided into 3 parts, based on why
+12 ;;the veteran's status was reviewed:
+13 ;;
+14 ;; If, during the timeframe between the installation of the Tricare
+15 ;; patch and the date the clean-up was run, the Veteran:
+16 ;; 1) had an Outpatient Encounter.
+17 ;; 2) was an inpatient.
+18 ;; 3) had a future appointment made.
+19 ;; 4) has current Means Test or Copay test on file
+20 ;;
+21 ;; ** This report requires 132 columns! **
+22 ;;
+23 ;;$END
