185 lines
6.7 KiB
Mathematica
185 lines
6.7 KiB
Mathematica
EASECEXP ;ALB/LBD - Report of Expiring or Expired LTC Copay Tests; 10-SEP-2003
|
|
;;1.0;ENROLLMENT APPLICATION SYSTEM;**40**;Mar 15, 2001
|
|
;
|
|
; This routine is called from menu option EASEC LTC COPAY TEST EXPIRE
|
|
; and will print a report of LTC Copay Tests that have expired or are
|
|
; about to expire.
|
|
;
|
|
EN ; Entry point
|
|
N EASRPT,EASUDT,EASSRT
|
|
; Select which report to print (1=Pending Expiration; 2=Expired)
|
|
S EASRPT=$$RPT Q:'EASRPT
|
|
; Select number of days (report 1) or start date (report 2)
|
|
I EASRPT=1 S EASUDT=$$DATE1
|
|
E S EASUDT=$$DATE2
|
|
Q:'EASUDT
|
|
; Sort by name or date
|
|
S EASSRT=$$SRT Q:EASSRT=""
|
|
; Run the report
|
|
D QUE
|
|
D ^%ZISC,HOME^%ZIS
|
|
Q
|
|
;
|
|
RPT() ; Select which report to print
|
|
; Input: None
|
|
; Output: Y - Report Type (1=Pending Expiration; 2=Expired; 0=Quit)
|
|
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|
W !!,"Report of LTC Copayment Tests"
|
|
S DIR(0)="S^1:Pending Expiration;2:Expired"
|
|
S DIR("A")="Enter 1 or 2"
|
|
S DIR("?",1)="Indicate whether the report should include:"
|
|
S DIR("?",2)="(1) a list of veterans whose LTC Copayment Test is pending expiration (i.e.,"
|
|
S DIR("?",3)="the anniversary date of the test is approaching) within a user-specified"
|
|
S DIR("?",4)="number of days, or"
|
|
S DIR("?",5)="(2) a list of veterans whose LTC Copayment Test has already expired (i.e.,"
|
|
S DIR("?")="the anniversary date of the test has passed) since a user-specified date."
|
|
D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
|
|
Q Y
|
|
DATE1() ; Select number of days for report 1
|
|
; Input: None
|
|
; Output: Y - Number of days to report (1-60)
|
|
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|
S DIR(0)="N^1:60",DIR("A")="Enter number of days to report"
|
|
D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
|
|
Q Y
|
|
DATE2() ; Select start date for report 2
|
|
; Input: None
|
|
; Output: Y - Report start date
|
|
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,SDT,EDT
|
|
S SDT=$$FMADD^XLFDT(DT,-365),EDT=$$FMADD^XLFDT(DT,-1)
|
|
S DIR(0)="D^"_SDT_":"_EDT_":EX",DIR("A")="Enter a start date"
|
|
D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
|
|
Q Y
|
|
SRT() ; Select sort
|
|
; Input: None
|
|
; Output: Y - Sort (N=Name; D=Date)
|
|
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|
S DIR(0)="SB^N:Name;D:Date",DIR("A")="Sort report by Name or Date"
|
|
S DIR("?",1)="Indicate whether the report should be sorted by the"
|
|
S DIR("?")="Veteran's Name or the LTC Copay Test Anniversary Date"
|
|
D ^DIR I $D(DTOUT)!($D(DUOUT)) Q ""
|
|
Q Y
|
|
;
|
|
QUE ; Get the report device, queue if requested
|
|
N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,POP
|
|
K IOP,%ZIS
|
|
S %ZIS="Q" D ^%ZIS I POP W !!,"Report Cancelled!" Q
|
|
I $D(IO("Q")) D Q
|
|
.S ZTRTN="START^EASECEXP"
|
|
.S ZTDESC="PRINT"_$S(EASRPT=1:"EXPIRING",1:"EXPIRED")_"LTC COPAY TESTS"
|
|
.S (ZTSAVE("EASRPT"),ZTSAVE("EASUDT"),ZTSAVE("EASSRT"))=""
|
|
.D ^%ZTLOAD
|
|
.W !,"Report ",$S($D(ZTSK):"Queued!",1:"Cancelled!")
|
|
D START
|
|
Q
|
|
;
|
|
START ; Generate report
|
|
; Input: EASRPT - Report Type (1=Pending Expiration; 2=Expired)
|
|
; EASUDT - Number of Days or Start Date
|
|
; EASSRT - Sort (N=Name; D=Date)
|
|
N PG,RPTDT,HDR1,HDR2,HDR3,HDRLN,CRT,LINE,OUT,MXLNE,TMP
|
|
K ^TMP("EASECEXP",$J) S:$G(ZTSK) ZTREQ="@"
|
|
D GETREC
|
|
D PRTVAR
|
|
U IO D HDR
|
|
I '$D(^TMP("EASECEXP",$J)) W !!,?10,"*** No records to print ***" Q
|
|
D PRINT I CRT S OUT=$$PAUSE
|
|
K ^TMP("EASECEXP",$J)
|
|
Q
|
|
GETREC ; Loop through Annual Means Test File #408.31 to find LTC Copay Tests
|
|
; within the date range
|
|
N EASSDT,EASEDT,EDT,ST,DFN,EASIEN
|
|
; Get start and end dates
|
|
I EASRPT=1 D
|
|
.S EASSDT=$$FMADD^XLFDT(DT,-365)
|
|
.S EASEDT=$$FMADD^XLFDT(EASSDT,EASUDT)
|
|
E D
|
|
.S EASSDT=$$FMADD^XLFDT(EASUDT,-365)
|
|
.S EASEDT=$$FMADD^XLFDT(DT,-365)
|
|
; Find records using "AS" x-ref
|
|
S ST=""
|
|
F S ST=$O(^DGMT(408.31,"AS",3,ST)) Q:ST="" S EDT=-EASEDT-1 F S EDT=$O(^DGMT(408.31,"AS",3,ST,EDT)) Q:'EDT!(EDT>-EASSDT) S DFN=0 F S DFN=$O(^DGMT(408.31,"AS",3,ST,EDT,DFN)) Q:'DFN D
|
|
.S EASIEN=$O(^DGMT(408.31,"AS",3,ST,EDT,DFN,0)) Q:'EASIEN
|
|
.Q:'$D(^DGMT(408.31,EASIEN,0))
|
|
.;If record meets criteria, save in ^TMP global
|
|
.I $$CHK(DFN,EASIEN) D SET(DFN,EASIEN,EASSRT)
|
|
Q
|
|
;
|
|
SET(DFN,IEN,SRT) ;Store data to be printed in the ^TMP global
|
|
; Input: DFN - Patient IEN
|
|
; IEN - LTC Copay Test IEN
|
|
Q:'$G(DFN) Q:'$G(IEN)
|
|
I $G(SRT)="" S SRT="D"
|
|
N NAME,SSN,STAT,REAS,ANNDT
|
|
S NAME=$$GET1^DIQ(2,DFN_",",.01),SSN=$$GET1^DIQ(2,DFN_",",.09)
|
|
S ANNDT=$$FMADD^XLFDT(+$G(^DGMT(408.31,IEN,0)),365)
|
|
S STAT=$$GET1^DIQ(408.31,IEN_",",.03) S:STAT="" STAT="INCOMPLETE"
|
|
S REAS=$E($$GET1^DIQ(408.31,IEN_",",2.07),1,41)
|
|
I SRT="D" S ^TMP("EASECEXP",$J,ANNDT,NAME,SSN)=STAT_U_REAS
|
|
E S ^TMP("EASECEXP",$J,NAME,ANNDT,SSN)=STAT_U_REAS
|
|
Q
|
|
;
|
|
CHK(DFN,EASIEN) ;Check if LTC Copay Test meets criteria for the report
|
|
; Input: DFN - Patient IEN
|
|
; EASIEN - LTC Copay Test IEN
|
|
; Output: 1 = meets criteria for report
|
|
; 0 = doesn't meet criteria for report
|
|
I '$G(DFN)!('$G(EASIEN)) Q 0
|
|
N LTC,LTCDT,LTCST,CHKDT
|
|
S CHKDT=+^DGMT(408.31,EASIEN,0)
|
|
; Don't report if veteran has had another LTC copay test within the year
|
|
S LTC=$$LST^EASECU(DFN),LTCDT=$P(LTC,U,2),LTCST=$P(LTC,U,3)
|
|
I LTCDT,LTCDT>CHKDT,$$FMDIFF^XLFDT(DT,LTCDT)<365,LTCST'="" Q 0
|
|
; Don't report if veteran is deceased
|
|
I $P($G(^DPT(DFN,.35)),U) Q 0
|
|
; Don't report if veteran is exempt due to compensable SC disability or
|
|
; LTC before 11/30/99
|
|
I "^1^4^"[(U_$P($G(^DGMT(408.31,EASIEN,2)),U,7)_U) Q 0
|
|
Q 1
|
|
;
|
|
PRTVAR ; Set up variables needed to print report
|
|
S CRT=$S($E(IOST,1,2)="C-":1,1:0)
|
|
S TMP="^TMP(""EASECEXP"",$J)"
|
|
S (PG,OUT)=0,RPTDT=$$FMTE^XLFDT(DT),MXLNE=$S(CRT:13,1:55)
|
|
S HDR1=$$CJ^XLFSTR("VETERANS WITH LONG TERM CARE COPAYMENT TESTS THAT",80)
|
|
I EASRPT=1 S HDR2=$$CJ^XLFSTR("ARE PENDING EXPIRATION IN "_EASUDT_" DAYS",80)
|
|
E S HDR2=$$CJ^XLFSTR("HAVE EXPIRED SINCE "_$$FMTE^XLFDT(EASUDT,2),80)
|
|
S HDR3="SORTED BY "_$S(EASSRT="D":"DATE",1:"NAME")
|
|
S HDRLN="",$P(HDRLN,"=",80)=""
|
|
Q
|
|
HDR ; Print report header
|
|
S PG=PG+1,LINE=0
|
|
W @IOF
|
|
W ?0,"REPORT DATE: ",RPTDT,?73,"PAGE: ",$$RJ^XLFSTR(PG,3)
|
|
W !!,HDR1,!,HDR2,!,HDR3
|
|
W !?50,"LTC Test",?66,"LTC Test"
|
|
W !,"SSN",?14,"Veteran's Name",?46,"Anniversary Date",?67,"Status"
|
|
W !,HDRLN
|
|
Q
|
|
PRINT ; Print report data
|
|
N EASI,EASJ,SSN,REC,NAME,ANNDT,STAT,REAS
|
|
S EASI=""
|
|
F S EASI=$O(@TMP@(EASI)) Q:EASI=""!OUT S EASJ="" F S EASJ=$O(@TMP@(EASI,EASJ)) Q:EASJ="" S SSN="" F S SSN=$O(@TMP@(EASI,EASJ,SSN)) Q:SSN="" D
|
|
.S REC=@TMP@(EASI,EASJ,SSN)
|
|
.S NAME=$S(EASSRT="D":EASJ,1:EASI),NAME=$E(NAME,1,30)
|
|
.S ANNDT=$S(EASSRT="D":EASI,1:EASJ),ANNDT=$$FMTDT(ANNDT)
|
|
.S STAT=$P(REC,U,1)
|
|
.S REAS=$P(REC,U,2)
|
|
.I LINE>MXLNE S OUT=$$PAUSE Q:OUT D HDR
|
|
.W !,$$SSN(SSN),?14,NAME,?50,ANNDT,?66,STAT
|
|
.S LINE=LINE+1
|
|
.I STAT="EXEMPT" W !,?30,"Reason: ",REAS S LINE=LINE+1
|
|
Q
|
|
;
|
|
FMTDT(X) ;Format date to print on report
|
|
Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
|
|
SSN(X) ; Format SSN to print on report
|
|
Q $E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,9)
|
|
;
|
|
PAUSE() ; Prompt for next page or quit, if report is sent to screen
|
|
N DIR,DIRUT,DUOUT,DTOUT,X,Y
|
|
I 'CRT Q 0
|
|
S DIR(0)="E"
|
|
D ^DIR I 'Y Q 1
|
|
Q 0
|