- 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 Feb 19, 2025@00:10:35 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
