source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASSIGDT.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.3 KB
Line 
1EASSIGDT ; ALB/RTK/BRM - Means Test Signature detail report ; 1/23/02 12:26pm ; 07/22/02 9:40am
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**4,8,13**;Mar 15, 2001
3 ;
4 ;Detail report of means test signature status. A listing of
5 ;means tests from the beginning of the most recent previous
6 ;calender year to date for all veterans with a status of MT Copay Exempt,
7 ;MT Copay Required, GMT Copay required or Pending Adjudication.
8 ;
9 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
10 S NOW=$P($$NOW^XLFDT,"."),(NOSIG,NULLSIG,DELSIG)=0
11 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"
12 D ^DIR S YRSEL=Y G END:$D(DTOUT)!($D(DUOUT))
13 D DEVSEL
14END K ^TMP("EAS SIG RPT",$J) Q
15EN ;
16 ;Set start date:
17 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
18 ;Get site ID
19 S SITE=$P($$SITE^VASITE(NOW),"^",3)
20 ;Get codes for MT Copay Exempt, MT Copay Required, GMT Copay Required
21 ;and Pending Adjudication
22 S (CATA,CATC,PENDA,GMT)="",(ANO,ANUL,ADEL,CNO,CNUL,CDEL,PANO,PANUL,PADEL,MTCNT)=0
23 S CATA=$O(^DG(408.32,"B","MT COPAY EXEMPT",CATA))
24 S CATC=$O(^DG(408.32,"B","MT COPAY REQUIRED",CATC))
25 S PENDA=$O(^DG(408.32,"B","PENDING ADJUDICATION",PENDA))
26 S GMT=$O(^DG(408.32,"B","GMT COPAY REQUIRED",GMT))
27 I YRSEL="A" D PASTYR
28 I YRSEL'="A" D OTHERYR
29 Q
30PASTYR F S CHKDT=$O(^DGMT(408.31,"B",CHKDT)) Q:$E(CHKDT,1,3)=($E(DISPDT,1,3)+1) D
31 .S MTIEN="" F S MTIEN=$O(^DGMT(408.31,"B",CHKDT,MTIEN)) Q:MTIEN="" D
32 ..;Is test primary?
33 ..I $G(^DGMT(408.31,MTIEN,"PRIM"))'=1 Q
34 ..;If MT already signed, ignore
35 ..I $P($G(^DGMT(408.31,MTIEN,0)),"^",29)=1 Q
36 ..;If not a Means Test, ignore
37 ..I $P($G(^DGMT(408.31,MTIEN,0)),"^",19)'=1 Q
38 ..;Determine category
39 ..S CAT=$P(^DGMT(408.31,MTIEN,0),"^",3) I CAT'=CATA,CAT'=CATC,CAT'=PENDA,CAT'=GMT Q
40 ..S MTSIG=$P(^DGMT(408.31,MTIEN,0),"^",29),PATPTR=$P(^DGMT(408.31,MTIEN,0),"^",2) I '$D(^DPT(PATPTR)) Q
41 ..S NAME=$P(^DPT(PATPTR,0),"^"),SSN=$P(^DPT(PATPTR,0),"^",9)
42 ..;Translate status and indicator values
43 ..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:"")
44 ..I MTSIG=0 S NOSIG=NOSIG+1
45 ..I MTSIG="" S NULLSIG=NULLSIG+1
46 ..I MTSIG=9 S DELSIG=DELSIG+1
47 ..S ^TMP("EAS SIG RPT",$J,NAME)=NAME_"^"_SSN_"^"_CATTXT_"^"_SIGTXT,MTCNT=MTCNT+1
48 D PRINT
49 Q
50OTHERYR F S CHKDT=$O(^DGMT(408.31,"B",CHKDT),-1) Q:$E(CHKDT,1,3)=($E(DISPDT,1,3)-1) D
51 .S MTIEN="" F S MTIEN=$O(^DGMT(408.31,"B",CHKDT,MTIEN)) Q:MTIEN="" D
52 ..;Is test primary?
53 ..I $G(^DGMT(408.31,MTIEN,"PRIM"))'=1 Q
54 ..;Is test from this site?
55 ..;I $P($G(^DGMT(408.31,MTIEN,2)),"^",5)'=SITE Q
56 ..;If MT already signed, ignore
57 ..I $P($G(^DGMT(408.31,MTIEN,0)),"^",29)=1 Q
58 ..;If not a Means Test, ignore
59 ..I $P($G(^DGMT(408.31,MTIEN,0)),"^",19)'=1 Q
60 ..;Determine category
61 ..S CAT=$P(^DGMT(408.31,MTIEN,0),"^",3) I CAT'=CATA,CAT'=CATC,CAT'=PENDA,CAT'=GMT Q
62 ..S MTSIG=$P(^DGMT(408.31,MTIEN,0),"^",29),PATPTR=$P(^DGMT(408.31,MTIEN,0),"^",2) I '$D(^DPT(PATPTR)) Q
63 ..S NAME=$P(^DPT(PATPTR,0),"^"),SSN=$P(^DPT(PATPTR,0),"^",9)
64 ..;Translate status and indicator values
65 ..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:"")
66 ..I MTSIG=0 S NOSIG=NOSIG+1
67 ..I MTSIG="" S NULLSIG=NULLSIG+1
68 ..I MTSIG=9 S DELSIG=DELSIG+1
69 ..S ^TMP("EAS SIG RPT",$J,NAME)=NAME_"^"_SSN_"^"_CATTXT_"^"_SIGTXT,MTCNT=MTCNT+1
70 D PRINT
71 Q
72 ;
73PRINT ;
74 U IO
75 W:$E(IOST,1)="C" @IOF
76 W !?2,"The purpose of this report is to list those veterans at a particular site for"
77 W !?2,"which a signature still needs to be obtained. A veteran will ONLY be listed"
78 W !?2,"if NEITHER the local site NOR the primary site (if different) has obtained a"
79 W !?2,"signature. Once a signature has been obtained by EITHER the local OR"
80 W !?2,"primary (if different) site, the veteran will be removed from this list."
81 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),!
82 W !,?2,"Veteran Name",?25,"SSN",?40,"MT Status",?60,"MT Sig Indicator"
83 W !,?60,"(Primary/Local Site)"
84 W ! F I=1:1:80 W "_"
85 S NAME="" F S NAME=$O(^TMP("EAS SIG RPT",$J,NAME)) Q:NAME="" D
86 .;Format SSN
87 .S NSSN=$P(^TMP("EAS SIG RPT",$J,NAME),"^",2),FSSN=$E(NSSN,1,3)_"-"_$E(NSSN,4,5)_"-"_$E(NSSN,6,9)
88 . 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)
89 W ! F I=1:1:80 W "_"
90 W !!,?2,"NO indicator = ",NOSIG
91 W !,?2,"NULL indicator = ",NULLSIG
92 W !,?2,"DELETED indicator = ",DELSIG
93 W !,?2,"Count of Veterans = ",MTCNT,!
94 D ^%ZISC
95 Q
96DEVSEL ;Select IO Device
97 K DIRUT
98 S %ZIS="Q" D ^%ZIS
99 I POP W !!?5,"Report cancelled!" D ^%ZISC Q
100 I $D(IO("Q")) D QUEUE Q
101 D EN
102 Q
103QUEUE ;
104 S ZTRTN="EN^EASSIGDT",ZTDESC="MT Signature Details Rpt"
105 S (ZTSAVE("YRSEL"),ZTSAVE("NOW"),ZTSAVE("NOSIG"),ZTSAVE("NULLSIG"),ZTSAVE("DELSIG"),ZTSAVE("MTCNT"))=""
106 D ^%ZTLOAD
107 I $D(ZTSK)[0 W !!?5,"Report cancelled!"
108 E W !!?5,"Report queued!"
109 D HOME^%ZIS Q
Note: See TracBrowser for help on using the repository browser.