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

EASSIGDT.m

Go to the documentation of this file. 
  1. EASSIGDT ; ALB/RTK/BRM - Means Test Signature detail report ; 1/23/02 12:26pm ; 07/22/02 9:40am
  1.  ;;1.0;ENROLLMENT APPLICATION SYSTEM;**4,8,13**;Mar 15, 2001
  1.  ;
  1.  ;Detail report of means test signature status.  A listing of
  1.  ;means tests from the beginning of the most recent previous 
  1.  ;calender year to date for all veterans with a status of MT Copay Exempt,
  1.  ;MT Copay Required, GMT Copay required or Pending Adjudication.
  1.  ;
  1.  N CATA,CATC,PENDA,ANO,ANUL,ADEL,CNO,CNUL,CDEL,PANO,PANUL,PADEL,CHKDT,MTIEN,CAT,MTSIG,FSSN,NSSN,SITE,MTCNT,NOW,YRSEL,NOSIG,NULLSIG,DELSIG,GMT
  1.  S NOW=$P($$NOW^XLFDT,"."),(NOSIG,NULLSIG,DELSIG)=0
  1.  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"
  1.  D ^DIR S YRSEL=Y G END:$D(DTOUT)!($D(DUOUT))
  1.  D DEVSEL
  1. END K ^TMP("EAS SIG RPT",$J) Q
  1. EN ;
  1.  ;Set start date:
  1.  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
  1.  ;Get site ID
  1.  S SITE=$P($$SITE^VASITE(NOW),"^",3)
  1.  ;Get codes for MT Copay Exempt, MT Copay Required, GMT Copay Required 
  1.  ;and Pending Adjudication
  1.  S (CATA,CATC,PENDA,GMT)="",(ANO,ANUL,ADEL,CNO,CNUL,CDEL,PANO,PANUL,PADEL,MTCNT)=0
  1.  S CATA=$O(^DG(408.32,"B","MT COPAY EXEMPT",CATA))
  1.  S CATC=$O(^DG(408.32,"B","MT COPAY REQUIRED",CATC))
  1.  S PENDA=$O(^DG(408.32,"B","PENDING ADJUDICATION",PENDA))
  1.  S GMT=$O(^DG(408.32,"B","GMT COPAY REQUIRED",GMT))
  1.  I YRSEL="A" D PASTYR
  1.  I YRSEL'="A" D OTHERYR
  1.  Q
  1. PASTYR F  S CHKDT=$O(^DGMT(408.31,"B",CHKDT)) Q:$E(CHKDT,1,3)=($E(DISPDT,1,3)+1)  D
  1.  .S MTIEN="" F  S MTIEN=$O(^DGMT(408.31,"B",CHKDT,MTIEN)) Q:MTIEN=""  D
  1.  ..;Is test primary?
  1.  ..I $G(^DGMT(408.31,MTIEN,"PRIM"))'=1 Q
  1.  ..;If MT already signed, ignore
  1.  ..I $P($G(^DGMT(408.31,MTIEN,0)),"^",29)=1 Q
  1.  ..;If not a Means Test, ignore
  1.  ..I $P($G(^DGMT(408.31,MTIEN,0)),"^",19)'=1 Q
  1.  ..;Determine category
  1.  ..S CAT=$P(^DGMT(408.31,MTIEN,0),"^",3) I CAT'=CATA,CAT'=CATC,CAT'=PENDA,CAT'=GMT Q
  1.  ..S MTSIG=$P(^DGMT(408.31,MTIEN,0),"^",29),PATPTR=$P(^DGMT(408.31,MTIEN,0),"^",2) I '$D(^DPT(PATPTR)) Q
  1.  ..S NAME=$P(^DPT(PATPTR,0),"^"),SSN=$P(^DPT(PATPTR,0),"^",9)
  1.  ..;Translate status and indicator values
  1.  ..S CATTXT=$S(CAT=CATA:"MT COPAY EXEMPT",CAT=CATC:"MT COPAY REQUIRED",CAT=PENDA:"PENDING ADJUDICATION",CAT=GMT:"GMT COPAY REQUIRED",1:"n/a"),SIGTXT=$S(MTSIG=0:"No",MTSIG="":"Null",MTSIG=9:"Deleted",1:"")
  1.  ..I MTSIG=0 S NOSIG=NOSIG+1
  1.  ..I MTSIG="" S NULLSIG=NULLSIG+1
  1.  ..I MTSIG=9 S DELSIG=DELSIG+1
  1.  ..S ^TMP("EAS SIG RPT",$J,NAME)=NAME_"^"_SSN_"^"_CATTXT_"^"_SIGTXT,MTCNT=MTCNT+1
  1.  D PRINT
  1.  Q
  1. OTHERYR F  S CHKDT=$O(^DGMT(408.31,"B",CHKDT),-1) Q:$E(CHKDT,1,3)=($E(DISPDT,1,3)-1)  D
  1.  .S MTIEN="" F  S MTIEN=$O(^DGMT(408.31,"B",CHKDT,MTIEN)) Q:MTIEN=""  D
  1.  ..;Is test primary?
  1.  ..I $G(^DGMT(408.31,MTIEN,"PRIM"))'=1 Q
  1.  ..;Is test from this site?
  1.  ..;I $P($G(^DGMT(408.31,MTIEN,2)),"^",5)'=SITE Q
  1.  ..;If MT already signed, ignore
  1.  ..I $P($G(^DGMT(408.31,MTIEN,0)),"^",29)=1 Q
  1.  ..;If not a Means Test, ignore
  1.  ..I $P($G(^DGMT(408.31,MTIEN,0)),"^",19)'=1 Q
  1.  ..;Determine category
  1.  ..S CAT=$P(^DGMT(408.31,MTIEN,0),"^",3) I CAT'=CATA,CAT'=CATC,CAT'=PENDA,CAT'=GMT Q
  1.  ..S MTSIG=$P(^DGMT(408.31,MTIEN,0),"^",29),PATPTR=$P(^DGMT(408.31,MTIEN,0),"^",2) I '$D(^DPT(PATPTR)) Q
  1.  ..S NAME=$P(^DPT(PATPTR,0),"^"),SSN=$P(^DPT(PATPTR,0),"^",9)
  1.  ..;Translate status and indicator values
  1.  ..S CATTXT=$S(CAT=CATA:"MT COPAY EXEMPT",CAT=CATC:"MT COPAY REQUIRED",CAT=PENDA:"PENDING ADJUDICATION",CAT=GMT:"GMT COPAY REQUIRED",1:"n/a"),SIGTXT=$S(MTSIG=0:"No",MTSIG="":"Null",MTSIG=9:"Deleted",1:"")
  1.  ..I MTSIG=0 S NOSIG=NOSIG+1
  1.  ..I MTSIG="" S NULLSIG=NULLSIG+1
  1.  ..I MTSIG=9 S DELSIG=DELSIG+1
  1.  ..S ^TMP("EAS SIG RPT",$J,NAME)=NAME_"^"_SSN_"^"_CATTXT_"^"_SIGTXT,MTCNT=MTCNT+1
  1.  D PRINT
  1.  Q
  1.  ;
  1. PRINT ;
  1.  U IO
  1.  W:$E(IOST,1)="C" @IOF
  1.  W !?2,"The purpose of this report is to list those veterans at a particular site for"
  1.  W !?2,"which a signature still needs to be obtained.  A veteran will ONLY be listed"
  1.  W !?2,"if NEITHER the local site NOR the primary site (if different) has obtained a"
  1.  W !?2,"signature.  Once a signature has been obtained by EITHER the local OR"
  1.  W !?2,"primary (if different) site, the veteran will be removed from this list."
  1.  W !!,?2,"Signature Status For Means Tests Dated Within Income Year ",$S(YRSEL="A":$E(NOW,1,3)+1698,YRSEL="B":$E(NOW,1,3)+1699,YRSEL="C":$E(NOW,1,3)+1700),!
  1.  W !,?2,"Veteran Name",?25,"SSN",?40,"MT Status",?60,"MT Sig Indicator"
  1.  W !,?60,"(Primary/Local Site)"
  1.  W ! F I=1:1:80 W "_"
  1.  S NAME="" F  S NAME=$O(^TMP("EAS SIG RPT",$J,NAME)) Q:NAME=""  D
  1.  .;Format SSN
  1.  .S NSSN=$P(^TMP("EAS SIG RPT",$J,NAME),"^",2),FSSN=$E(NSSN,1,3)_"-"_$E(NSSN,4,5)_"-"_$E(NSSN,6,9)
  1.  . W !,?2,$E($P(^TMP("EAS SIG RPT",$J,NAME),"^"),1,23),?25,FSSN,?40,$P(^TMP("EAS SIG RPT",$J,NAME),"^",3),?65,$P(^TMP("EAS SIG RPT",$J,NAME),"^",4)
  1.  W ! F I=1:1:80 W "_"
  1.  W !!,?2,"NO indicator = ",NOSIG
  1.  W !,?2,"NULL indicator = ",NULLSIG
  1.  W !,?2,"DELETED indicator = ",DELSIG
  1.  W !,?2,"Count of Veterans = ",MTCNT,!
  1.  D ^%ZISC
  1.  Q
  1. DEVSEL ;Select IO Device
  1.  K DIRUT
  1.  S %ZIS="Q" D ^%ZIS
  1.  I POP W !!?5,"Report cancelled!" D ^%ZISC Q
  1.  I $D(IO("Q")) D QUEUE Q
  1.  D EN
  1.  Q
  1. QUEUE ;
  1.  S ZTRTN="EN^EASSIGDT",ZTDESC="MT Signature Details Rpt"
  1.  S (ZTSAVE("YRSEL"),ZTSAVE("NOW"),ZTSAVE("NOSIG"),ZTSAVE("NULLSIG"),ZTSAVE("DELSIG"),ZTSAVE("MTCNT"))=""
  1.  D ^%ZTLOAD
  1.  I $D(ZTSK)[0 W !!?5,"Report cancelled!"
  1.  E  W !!?5,"Report queued!"
  1.  D HOME^%ZIS Q