EASSIGOV ; ALB/RTK - Means Test Signature summary report ; 1/29/02 11:33am ; 07/22/02 9:40am
;;1.0;ENROLLMENT APPLICATION SYSTEM;**4,8,13,28**;Mar 15, 2001
;
N YRSEL,SIGYES,SIGNO,SIGDEL,SIGNUL,CHKDT,MTIEN,MTSIG,NOW,SITE,CATA,CATC,PENDA,GMT
S NOW=$P($$NOW^XLFDT,"."),SITE=$P($$SITE^VASITE,"^",3)
S (SIGYES,SIGNO,SIGDEL,SIGNUL)=0
N DIR S DIR("A")="Please select income year",DIR(0)="SM^A:PREVIOUS INCOME YEAR;B:CURRENT INCOME YEAR;C:NEXT INCOME YEAR",DIR("B")="B"
D ^DIR S YRSEL=Y G END:$D(DTOUT)!($D(DUOUT))
D DEVSEL
END Q
EN W:$E(IOST,1)="C" @IOF
S (CATA,CATC,PENDA,GMT)=""
S CATA=$O(^DG(408.32,"B","MT COPAY EXEMPT",CATA))
S CATC=$O(^DG(408.32,"B","MT COPAY REQUIRED",CATC))
S PENDA=$O(^DG(408.32,"B","PENDING ADJUDICATION",PENDA))
S GMT=$O(^DG(408.32,"B","GMT COPAY REQUIRED",GMT))
;Set start date:
S CHKDT=$S(YRSEL="A":($E(NOW,1,3)-1)_"0100",YRSEL="B":$E(NOW,1,3)_"1232",YRSEL="C":($E(NOW,1,3)+1)_"1232",1:""),DISPDT=CHKDT
I YRSEL="A" D PASTYR
I YRSEL'="A" D OTHERYR
Q
PASTYR F S CHKDT=$O(^DGMT(408.31,"B",CHKDT)) Q:$E(CHKDT,1,3)=($E(DISPDT,1,3)+1) D
.S MTIEN="" F S MTIEN=$O(^DGMT(408.31,"B",CHKDT,MTIEN)) Q:+MTIEN=0 D
..;Is test primary?
..I $G(^DGMT(408.31,MTIEN,"PRIM"))'=1 Q
..;Is test from this site?
..I +$P($G(^DGMT(408.31,MTIEN,2)),"^",5)'=SITE Q
..;If not a Means Test, ignore
..I $P($G(^DGMT(408.31,MTIEN,0)),"^",19)'=1 Q
..;Check category
..S CAT=$P(^DGMT(408.31,MTIEN,0),"^",3) I CAT'=CATA,CAT'=CATC,CAT'=PENDA,CAT'=GMT Q
..S MTSIG=$P(^DGMT(408.31,MTIEN,0),"^",29)
..;Set counters
..I MTSIG=1 S SIGYES=SIGYES+1 Q
..I MTSIG=0 S SIGNO=SIGNO+1 Q
..I MTSIG=9 S SIGDEL=SIGDEL+1 Q
..I MTSIG="" S SIGNUL=SIGNUL+1
D PRINT
Q
OTHERYR F S CHKDT=$O(^DGMT(408.31,"B",CHKDT),-1) Q:$E(CHKDT,1,3)=($E(DISPDT,1,3)-1) D
.S MTIEN="" F S MTIEN=$O(^DGMT(408.31,"B",CHKDT,MTIEN)) Q:+MTIEN=0 D
..;Is test primary?
..I $G(^DGMT(408.31,MTIEN,"PRIM"))'=1 Q
..;Is test from this site?
..I +$P($G(^DGMT(408.31,MTIEN,2)),"^",5)'=SITE Q
..;If not a Means Test, ignore
..I $P($G(^DGMT(408.31,MTIEN,0)),"^",19)'=1 Q
..;Check category
..S CAT=$P(^DGMT(408.31,MTIEN,0),"^",3) I CAT'=CATA,CAT'=CATC,CAT'=PENDA,CAT'=GMT Q
..S MTSIG=$P(^DGMT(408.31,MTIEN,0),"^",29)
..;Set counters
..I MTSIG=1 S SIGYES=SIGYES+1 Q
..I MTSIG=0 S SIGNO=SIGNO+1 Q
..I MTSIG=9 S SIGDEL=SIGDEL+1 Q
..I MTSIG="" S SIGNUL=SIGNUL+1
D PRINT
Q
PRINT ;
U IO
W !,?2,"The purpose of this report is to help sites monitor the Means Test images"
W !?2,"returned to them by the HEC. The report only shows signature indicators"
W !?2,"for MTs that were submitted by the local site (which may or may not be"
W !?2,"designated as the primary site). It does NOT take into account that the"
W !?2,"HEC may already have a signature on file for the vet as sent from a"
W !?2,"different, primary site."
W !!,?2,"Means Test Signature Data for Income Year ",$E(DISPDT,1,3)+1699,":",!
W !,?2,"Local Site Means Test with Signature Indicator = YES",?60,SIGYES
W !,?2,"Local Site Means Test with Signature Indicator = NO",?60,SIGNO
W !,?2,"Local Site Means Test with Signature Indicator = DELETED",?60,SIGDEL
W !,?2,"Local Site Means Test with Signature Indicator = NULL",?60,SIGNUL
W ! F I=1:1:80 W "_"
W !,?50,"Total",?60,(SIGYES+SIGNO+SIGDEL+SIGNUL)
D ^%ZISC
Q
DEVSEL ;Select IO Device
K DIRUT
S %ZIS="Q" D ^%ZIS
I POP W !!?5,"Report cancelled!" D ^%ZISC Q
I $D(IO("Q")) D QUEUE Q
D EN
Q
QUEUE ;
S ZTRTN="EN^EASSIGOV",ZTDESC="MT Signature Summary Rpt"
S (ZTSAVE("YRSEL"),ZTSAVE("NOW"),ZTSAVE("SIGNO"),ZTSAVE("SIGNUL"),ZTSAVE("SIGYES"),ZTSAVE("SIGDEL"),ZTSAVE("SITE"))=""
D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Report cancelled!"
E W !!?5,"Report queued!"
D HOME^%ZIS Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASSIGOV 3775 printed Nov 22, 2024@17:05:51 Page 2
EASSIGOV ; ALB/RTK - Means Test Signature summary report ; 1/29/02 11:33am ; 07/22/02 9:40am
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**4,8,13,28**;Mar 15, 2001
+2 ;
+3 NEW YRSEL,SIGYES,SIGNO,SIGDEL,SIGNUL,CHKDT,MTIEN,MTSIG,NOW,SITE,CATA,CATC,PENDA,GMT
+4 SET NOW=$PIECE($$NOW^XLFDT,".")
SET SITE=$PIECE($$SITE^VASITE,"^",3)
+5 SET (SIGYES,SIGNO,SIGDEL,SIGNUL)=0
+6 NEW DIR
SET DIR("A")="Please select income year"
SET DIR(0)="SM^A:PREVIOUS INCOME YEAR;B:CURRENT INCOME YEAR;C:NEXT INCOME YEAR"
SET DIR("B")="B"
+7 DO ^DIR
SET YRSEL=Y
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO END
+8 DO DEVSEL
END QUIT
EN if $EXTRACT(IOST,1)="C"
WRITE @IOF
+1 SET (CATA,CATC,PENDA,GMT)=""
+2 SET CATA=$ORDER(^DG(408.32,"B","MT COPAY EXEMPT",CATA))
+3 SET CATC=$ORDER(^DG(408.32,"B","MT COPAY REQUIRED",CATC))
+4 SET PENDA=$ORDER(^DG(408.32,"B","PENDING ADJUDICATION",PENDA))
+5 SET GMT=$ORDER(^DG(408.32,"B","GMT COPAY REQUIRED",GMT))
+6 ;Set start date:
+7 SET CHKDT=$SELECT(YRSEL="A":($EXTRACT(NOW,1,3)-1)_"0100",YRSEL="B":$EXTRACT(NOW,1,3)_"1232",YRSEL="C":($EXTRACT(NOW,1,3)+1)_"1232",1:"")
SET DISPDT=CHKDT
+8 IF YRSEL="A"
DO PASTYR
+9 IF YRSEL'="A"
DO OTHERYR
+10 QUIT
PASTYR FOR
SET CHKDT=$ORDER(^DGMT(408.31,"B",CHKDT))
if $EXTRACT(CHKDT,1,3)=($EXTRACT(DISPDT,1,3)+1)
QUIT
Begin DoDot:1
+1 SET MTIEN=""
FOR
SET MTIEN=$ORDER(^DGMT(408.31,"B",CHKDT,MTIEN))
if +MTIEN=0
QUIT
Begin DoDot:2
+2 ;Is test primary?
+3 IF $GET(^DGMT(408.31,MTIEN,"PRIM"))'=1
QUIT
+4 ;Is test from this site?
+5 IF +$PIECE($GET(^DGMT(408.31,MTIEN,2)),"^",5)'=SITE
QUIT
+6 ;If not a Means Test, ignore
+7 IF $PIECE($GET(^DGMT(408.31,MTIEN,0)),"^",19)'=1
QUIT
+8 ;Check category
+9 SET CAT=$PIECE(^DGMT(408.31,MTIEN,0),"^",3)
IF CAT'=CATA
IF CAT'=CATC
IF CAT'=PENDA
IF CAT'=GMT
QUIT
+10 SET MTSIG=$PIECE(^DGMT(408.31,MTIEN,0),"^",29)
+11 ;Set counters
+12 IF MTSIG=1
SET SIGYES=SIGYES+1
QUIT
+13 IF MTSIG=0
SET SIGNO=SIGNO+1
QUIT
+14 IF MTSIG=9
SET SIGDEL=SIGDEL+1
QUIT
+15 IF MTSIG=""
SET SIGNUL=SIGNUL+1
End DoDot:2
End DoDot:1
+16 DO PRINT
+17 QUIT
OTHERYR FOR
SET CHKDT=$ORDER(^DGMT(408.31,"B",CHKDT),-1)
if $EXTRACT(CHKDT,1,3)=($EXTRACT(DISPDT,1,3)-1)
QUIT
Begin DoDot:1
+1 SET MTIEN=""
FOR
SET MTIEN=$ORDER(^DGMT(408.31,"B",CHKDT,MTIEN))
if +MTIEN=0
QUIT
Begin DoDot:2
+2 ;Is test primary?
+3 IF $GET(^DGMT(408.31,MTIEN,"PRIM"))'=1
QUIT
+4 ;Is test from this site?
+5 IF +$PIECE($GET(^DGMT(408.31,MTIEN,2)),"^",5)'=SITE
QUIT
+6 ;If not a Means Test, ignore
+7 IF $PIECE($GET(^DGMT(408.31,MTIEN,0)),"^",19)'=1
QUIT
+8 ;Check category
+9 SET CAT=$PIECE(^DGMT(408.31,MTIEN,0),"^",3)
IF CAT'=CATA
IF CAT'=CATC
IF CAT'=PENDA
IF CAT'=GMT
QUIT
+10 SET MTSIG=$PIECE(^DGMT(408.31,MTIEN,0),"^",29)
+11 ;Set counters
+12 IF MTSIG=1
SET SIGYES=SIGYES+1
QUIT
+13 IF MTSIG=0
SET SIGNO=SIGNO+1
QUIT
+14 IF MTSIG=9
SET SIGDEL=SIGDEL+1
QUIT
+15 IF MTSIG=""
SET SIGNUL=SIGNUL+1
End DoDot:2
End DoDot:1
+16 DO PRINT
+17 QUIT
PRINT ;
+1 USE IO
+2 WRITE !,?2,"The purpose of this report is to help sites monitor the Means Test images"
+3 WRITE !?2,"returned to them by the HEC. The report only shows signature indicators"
+4 WRITE !?2,"for MTs that were submitted by the local site (which may or may not be"
+5 WRITE !?2,"designated as the primary site). It does NOT take into account that the"
+6 WRITE !?2,"HEC may already have a signature on file for the vet as sent from a"
+7 WRITE !?2,"different, primary site."
+8 WRITE !!,?2,"Means Test Signature Data for Income Year ",$EXTRACT(DISPDT,1,3)+1699,":",!
+9 WRITE !,?2,"Local Site Means Test with Signature Indicator = YES",?60,SIGYES
+10 WRITE !,?2,"Local Site Means Test with Signature Indicator = NO",?60,SIGNO
+11 WRITE !,?2,"Local Site Means Test with Signature Indicator = DELETED",?60,SIGDEL
+12 WRITE !,?2,"Local Site Means Test with Signature Indicator = NULL",?60,SIGNUL
+13 WRITE !
FOR I=1:1:80
WRITE "_"
+14 WRITE !,?50,"Total",?60,(SIGYES+SIGNO+SIGDEL+SIGNUL)
+15 DO ^%ZISC
+16 QUIT
DEVSEL ;Select IO Device
+1 KILL DIRUT
+2 SET %ZIS="Q"
DO ^%ZIS
+3 IF POP
WRITE !!?5,"Report cancelled!"
DO ^%ZISC
QUIT
+4 IF $DATA(IO("Q"))
DO QUEUE
QUIT
+5 DO EN
+6 QUIT
QUEUE ;
+1 SET ZTRTN="EN^EASSIGOV"
SET ZTDESC="MT Signature Summary Rpt"
+2 SET (ZTSAVE("YRSEL"),ZTSAVE("NOW"),ZTSAVE("SIGNO"),ZTSAVE("SIGNUL"),ZTSAVE("SIGYES"),ZTSAVE("SIGDEL"),ZTSAVE("SITE"))=""
+3 DO ^%ZTLOAD
+4 IF $DATA(ZTSK)[0
WRITE !!?5,"Report cancelled!"
+5 IF '$TEST
WRITE !!?5,"Report queued!"
+6 DO HOME^%ZIS
QUIT
