EAS150P1 ;ALB/SCK - PATCH EAS-50 POST UTILITIES ; 28-APR-2004
;;1.0;ENROLLMENT APPLICATION SYSTEM;**50,55**;Mar 15, 2004
;
Q
QUE ;
N EACY,%I,Y,DIR,DIRUT
;
D NOW^%DTC S Y=%I(3) D DD^%DT S EACY=Y
W !!
S DIR(0)="F",DIR("B")=EACY,DIR("A")="Print UE Status Report for Calendar Year"
S DIR("?",1)=""
S DIR("?",2)="This report will display the User Enrollee Status information for all"
S DIR("?",3)="patients with a Means Test Letter pending in the selected Calendar Year."
S DIR("?")="Enter ""ALL"" for all entries."
D ^DIR K DIR
Q:$D(DIRUT)
I +Y>0!(Y="ALL") S EACY=Y
E Q
;
S ZTSAVE("DUZ")="",ZTSAVE("EACY")=""
D EN^XUTMDEVQ("EN^EAS150P1","EAS UE STATUS REPORT",.ZTSAVE)
;
Q
;
EN ; Entry point for UE Status report
N EALIEN,EACNT,EAX,EADFN,EADFN1,EANAME,EAPTR,EAS60
;
K ^TMP("EASUES",$J)
K ^TMP("SCK",$J)
F EAX=0,1,2 S EACNT(EAX)=0
S EALIEN=0
F S EALIEN=$O(^EAS(713.2,EALIEN)) Q:'EALIEN D
. Q:$D(^EAS(713.2,"AC",1,EALIEN)) ; Quit if MT has been returned
. S EAPTR=$$GET1^DIQ(713.2,EALIEN,2,"I") ; Get pointer to file #713.1
. Q:$D(^EAS(713.1,"AP",1,EAPTR)) ; Quit if Prohibit Flag is set for patch
. ; If EACY is not "ALL" then check Calendar year for 60 day letter.
. ; Quit if letter date is not in the selected CY
. S EAS60=$$GET1^DIQ(713.2,EALIEN,8,"I")
. S Y=$E(EAS60,1,3) D DD^%DT S EAS60=Y
. I +EACY>0 Q:EAS60'=EACY
. Q:$$DECEASED^EASMTUTL(EALIEN) ; Quit if patient is deceased
. S EADFN1=$$GET1^DIQ(713.2,EALIEN,2,"I")
. S EADFN=$$GET1^DIQ(713.1,EADFN1,.01,"I")
. S EANAME=$$GET1^DIQ(2,EADFN,.01)
. S ^TMP("EASUES",$J,$S(EANAME]"":EANAME,1:"UNKNOWN"),EADFN)=EALIEN_U_EAS60
D REPORT
Q
;
REPORT ;
N EANAME,EADFN,PAGE,EASABRT
;
S (EASABRT,PAGE)=0
D HDR
;
S EANAME=""
F S EANAME=$O(^TMP("EASUES",$J,EANAME)) Q:EANAME']"" D Q:$G(EASABRT)
. S EADFN=0
. F S EADFN=$O(^TMP("EASUES",$J,EANAME,EADFN)) Q:'EADFN D
. . D LINE(EANAME,EADFN,$P($G(^TMP("EASUES",$J,EANAME,EADFN)),U,2))
. . I ($Y+6)>IOSL D HDR Q:$G(EASABRT)
;
I '$G(EASABRT) D
. N XX F XX=$Y:1:IOSL-6 W !
. D FTR
Q:$G(EASABRT)
I $E(IOST,1,2)="C-" D Q:$D(DIRUT)!('Y)
. S DIR(0)="E" D ^DIR K DIR
D SUMMARY
;
Q
;
LINE(EANAME,DFN,EAS60) ;
N EAUES,VA
;
S EAUES=$$UESTAT^EASUER(DFN)
S EACNT(EAUES)=EACNT(EAUES)+1
D PID^VADPT6
W !,$E(EANAME,1,25),?28,VA("BID")
W ?35,$$GET1^DIQ(2,EADFN,.3617)
W ?42,$S(EAUES=1:"UE",EAUES=0:"Not UE",EAUES=2:"Diff. Site",1:"")
W ?54,$E($$GET1^DIQ(2,EADFN,.3618),1,18),?74,EAS60
Q
;
SUMMARY ;
N DDASH
;
W @IOF
W !,"User Enrollee Status Summary for Pending Means Test Letters"
W !,"Print Date: ",$$FMTE^XLFDT(DT)
S $P(DDASH,"=",IOM)="" W !,DDASH,!
W !?4,"Patients with User Enrollee Status at this site: ",$FN(EACNT(1),",")
W !!?4,"Patients which DO NOT have User Enrollee Status at this site: ",$FN(EACNT(2),",")
W !!?4,"Patients which do not have User Enrollee Status: ",$FN(EACNT(0),",")
W !!?4,"Total Patients Reviewed: ",$FN(EACNT(0)+EACNT(1)+EACNT(2),",")
Q
;
HDR ;
N DDASH,EASITE,EAPRNT
;
I PAGE>0,$E(IOST,1,2)="C-" D Q:$G(EASABRT)
. S DIR(0)="E"
. D ^DIR K DIR
. I 'Y S EASABRT=1
;
S EASITE=$$SITE^VASITE,EAPRNT=$$PSITE^EASUER($P(EASITE,U,3))
W @IOF
S PAGE=PAGE+1
W !,"User Enrollee Status for Pending Means Test Letters"
W !,"Calendar Year for MT Letters to Print: ",EACY
W !,"Print Date: ",$$FMTE^XLFDT(DT)
W !,"Page: ",PAGE
W !!,"Current Site: ",$P(EASITE,U,2)," Current Station#: ",$P(EASITE,U,3)
W !,"Administrative Parent for ",$P(EASITE,U,2)," is ",$$GET1^DIQ(4,EAPRNT,.01)
W !!,"Name",?28,"LAST4",?35,"UE-FY",?42,"UE Status",?54,"UE Site",?74,"LT-CY"
;
S $P(DDASH,"=",IOM)="" W !,DDASH
W !
Q
;
FTR ;
I $E(IOST,1,2)'="C-" D
. W !?5,"UE -User Enrollee Status at Site "
. W !?5,"Not UE -User is not a User Enrollee"
. W !?5,"Diff. Site -User Enrollee Status, but at Another Site."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS150P1 4007 printed Dec 13, 2024@01:53:28 Page 2
EAS150P1 ;ALB/SCK - PATCH EAS-50 POST UTILITIES ; 28-APR-2004
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**50,55**;Mar 15, 2004
+2 ;
+3 QUIT
QUE ;
+1 NEW EACY,%I,Y,DIR,DIRUT
+2 ;
+3 DO NOW^%DTC
SET Y=%I(3)
DO DD^%DT
SET EACY=Y
+4 WRITE !!
+5 SET DIR(0)="F"
SET DIR("B")=EACY
SET DIR("A")="Print UE Status Report for Calendar Year"
+6 SET DIR("?",1)=""
+7 SET DIR("?",2)="This report will display the User Enrollee Status information for all"
+8 SET DIR("?",3)="patients with a Means Test Letter pending in the selected Calendar Year."
+9 SET DIR("?")="Enter ""ALL"" for all entries."
+10 DO ^DIR
KILL DIR
+11 if $DATA(DIRUT)
QUIT
+12 IF +Y>0!(Y="ALL")
SET EACY=Y
+13 IF '$TEST
QUIT
+14 ;
+15 SET ZTSAVE("DUZ")=""
SET ZTSAVE("EACY")=""
+16 DO EN^XUTMDEVQ("EN^EAS150P1","EAS UE STATUS REPORT",.ZTSAVE)
+17 ;
+18 QUIT
+19 ;
EN ; Entry point for UE Status report
+1 NEW EALIEN,EACNT,EAX,EADFN,EADFN1,EANAME,EAPTR,EAS60
+2 ;
+3 KILL ^TMP("EASUES",$JOB)
+4 KILL ^TMP("SCK",$JOB)
+5 FOR EAX=0,1,2
SET EACNT(EAX)=0
+6 SET EALIEN=0
+7 FOR
SET EALIEN=$ORDER(^EAS(713.2,EALIEN))
if 'EALIEN
QUIT
Begin DoDot:1
+8 ; Quit if MT has been returned
if $DATA(^EAS(713.2,"AC",1,EALIEN))
QUIT
+9 ; Get pointer to file #713.1
SET EAPTR=$$GET1^DIQ(713.2,EALIEN,2,"I")
+10 ; Quit if Prohibit Flag is set for patch
if $DATA(^EAS(713.1,"AP",1,EAPTR))
QUIT
+11 ; If EACY is not "ALL" then check Calendar year for 60 day letter.
+12 ; Quit if letter date is not in the selected CY
+13 SET EAS60=$$GET1^DIQ(713.2,EALIEN,8,"I")
+14 SET Y=$EXTRACT(EAS60,1,3)
DO DD^%DT
SET EAS60=Y
+15 IF +EACY>0
if EAS60'=EACY
QUIT
+16 ; Quit if patient is deceased
if $$DECEASED^EASMTUTL(EALIEN)
QUIT
+17 SET EADFN1=$$GET1^DIQ(713.2,EALIEN,2,"I")
+18 SET EADFN=$$GET1^DIQ(713.1,EADFN1,.01,"I")
+19 SET EANAME=$$GET1^DIQ(2,EADFN,.01)
+20 SET ^TMP("EASUES",$JOB,$SELECT(EANAME]"":EANAME,1:"UNKNOWN"),EADFN)=EALIEN_U_EAS60
End DoDot:1
+21 DO REPORT
+22 QUIT
+23 ;
REPORT ;
+1 NEW EANAME,EADFN,PAGE,EASABRT
+2 ;
+3 SET (EASABRT,PAGE)=0
+4 DO HDR
+5 ;
+6 SET EANAME=""
+7 FOR
SET EANAME=$ORDER(^TMP("EASUES",$JOB,EANAME))
if EANAME']""
QUIT
Begin DoDot:1
+8 SET EADFN=0
+9 FOR
SET EADFN=$ORDER(^TMP("EASUES",$JOB,EANAME,EADFN))
if 'EADFN
QUIT
Begin DoDot:2
+10 DO LINE(EANAME,EADFN,$PIECE($GET(^TMP("EASUES",$JOB,EANAME,EADFN)),U,2))
+11 IF ($Y+6)>IOSL
DO HDR
if $GET(EASABRT)
QUIT
End DoDot:2
End DoDot:1
if $GET(EASABRT)
QUIT
+12 ;
+13 IF '$GET(EASABRT)
Begin DoDot:1
+14 NEW XX
FOR XX=$Y:1:IOSL-6
WRITE !
+15 DO FTR
End DoDot:1
+16 if $GET(EASABRT)
QUIT
+17 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+18 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
if $DATA(DIRUT)!('Y)
QUIT
+19 DO SUMMARY
+20 ;
+21 QUIT
+22 ;
LINE(EANAME,DFN,EAS60) ;
+1 NEW EAUES,VA
+2 ;
+3 SET EAUES=$$UESTAT^EASUER(DFN)
+4 SET EACNT(EAUES)=EACNT(EAUES)+1
+5 DO PID^VADPT6
+6 WRITE !,$EXTRACT(EANAME,1,25),?28,VA("BID")
+7 WRITE ?35,$$GET1^DIQ(2,EADFN,.3617)
+8 WRITE ?42,$SELECT(EAUES=1:"UE",EAUES=0:"Not UE",EAUES=2:"Diff. Site",1:"")
+9 WRITE ?54,$EXTRACT($$GET1^DIQ(2,EADFN,.3618),1,18),?74,EAS60
+10 QUIT
+11 ;
SUMMARY ;
+1 NEW DDASH
+2 ;
+3 WRITE @IOF
+4 WRITE !,"User Enrollee Status Summary for Pending Means Test Letters"
+5 WRITE !,"Print Date: ",$$FMTE^XLFDT(DT)
+6 SET $PIECE(DDASH,"=",IOM)=""
WRITE !,DDASH,!
+7 WRITE !?4,"Patients with User Enrollee Status at this site: ",$FNUMBER(EACNT(1),",")
+8 WRITE !!?4,"Patients which DO NOT have User Enrollee Status at this site: ",$FNUMBER(EACNT(2),",")
+9 WRITE !!?4,"Patients which do not have User Enrollee Status: ",$FNUMBER(EACNT(0),",")
+10 WRITE !!?4,"Total Patients Reviewed: ",$FNUMBER(EACNT(0)+EACNT(1)+EACNT(2),",")
+11 QUIT
+12 ;
HDR ;
+1 NEW DDASH,EASITE,EAPRNT
+2 ;
+3 IF PAGE>0
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+4 SET DIR(0)="E"
+5 DO ^DIR
KILL DIR
+6 IF 'Y
SET EASABRT=1
End DoDot:1
if $GET(EASABRT)
QUIT
+7 ;
+8 SET EASITE=$$SITE^VASITE
SET EAPRNT=$$PSITE^EASUER($PIECE(EASITE,U,3))
+9 WRITE @IOF
+10 SET PAGE=PAGE+1
+11 WRITE !,"User Enrollee Status for Pending Means Test Letters"
+12 WRITE !,"Calendar Year for MT Letters to Print: ",EACY
+13 WRITE !,"Print Date: ",$$FMTE^XLFDT(DT)
+14 WRITE !,"Page: ",PAGE
+15 WRITE !!,"Current Site: ",$PIECE(EASITE,U,2)," Current Station#: ",$PIECE(EASITE,U,3)
+16 WRITE !,"Administrative Parent for ",$PIECE(EASITE,U,2)," is ",$$GET1^DIQ(4,EAPRNT,.01)
+17 WRITE !!,"Name",?28,"LAST4",?35,"UE-FY",?42,"UE Status",?54,"UE Site",?74,"LT-CY"
+18 ;
+19 SET $PIECE(DDASH,"=",IOM)=""
WRITE !,DDASH
+20 WRITE !
+21 QUIT
+22 ;
FTR ;
+1 IF $EXTRACT(IOST,1,2)'="C-"
Begin DoDot:1
+2 WRITE !?5,"UE -User Enrollee Status at Site "
+3 WRITE !?5,"Not UE -User is not a User Enrollee"
+4 WRITE !?5,"Diff. Site -User Enrollee Status, but at Another Site."
End DoDot:1
+5 QUIT
