- 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 Feb 18, 2025@23:22:08 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
