EASMT65 ; ALB/SCK - MEANS TEST LETTER PRINT FOR USER ENROLLEE STATUS ; 25-JUL-2007
;;1.0;ENROLLMENT APPLICATION SYSTEM;**65**;MAR 15,2001;Build 1
;
QUE ;
N UES,LTRGRP,ZTSAVE,RETZTSK,ZTSK
;
I '$D(^XUSEC("EAS MT UES OVERRIDE",DUZ)) D Q
. W !!,"You have not been assigned the required key to use this option."
. W !,"Please contact IRM or the Means Test Coordinator at your site"
. W !,"for assistance.",!!
;
W:$D(IOF) @IOF
S UES=$$GETSITE Q:'UES
S LTRGRP=$$LTRS Q:LTRGRP=0
;
S RETZTSK=1
S ZTSAVE("UES")="",ZTSAVE("LTRGRP")=""
D EN^XUTMDEVQ("EN^EASMT65","MT letters, UES print",.ZTSAVE)
W !,"Job has been tasked: ",$G(ZTSK)
Q
;
EN ;
N LTRCNT,EAX
;
Q:'$G(UES)
Q:'$G(LTRGRP)
;
K ^TMP("EASUE",$J)
F EAX=1,2,4 S LTRCNT(EAX)=0
;
D BUILD(UES,LTRGRP)
D PRINT(LTRGRP)
D FINAL(UES,LTRGRP)
;
K ^TMP("EASUE",$J)
D ^%ZISC
Q
;
GETSITE() ; Select User Enrollee Site
N DIR,X,Y,DIRUT,DTOUT,DUOUT,RSLT
;
W !,"This option will allow the override of the current filters on the User"
W !,"Enrollee site. By selecting a site, letters for veterans that are"
W !,"listed as a User Enrollee of that site can be printed."
W !,"This option should be used with care!",!
;
S DIR(0)="PAO^4:EMZ"
S DIR("A")="Select the User Enrollee site to print letters for: "
D ^DIR K DIR
S RSLT=+Y
I $D(DIRUT) S RSLT=0
Q $G(RSLT)
;
LTRS() ; Select letter group to print
N DIR,DIRUT,DUOUT,DTOUT,X,Y
;
S DIR(0)="SO^1:60-Day Letters;2:30-Day Letters;4:0-Day Letters;ALL:All Letters"
S DIR("L",1)="Select the group of Letters to print:"
S DIR("L",2)=""
S DIR("L",3)=" 1: 60-Day 2: 30-Day Letters 4: 0-Day Letters"
S DIR("L")=" ALL: All Letters"
S DIR("?",1)=""
S DIR("?",2)="Select the group of letters to print: enter 1 for 60 day letters, "
S DIR("?",3)="enter 2 for 30 day lettes, or enter 4 for 0 day letters."
S DIR("?")="Entering 'All' will print all pending letters for 60, 30, and 0 days."
D ^DIR K DIR
I $D(DIRUT) S Y=0
I Y="ALL" S Y=5
Q $G(Y)
;
BUILD(UES,LTRGRP) ; Build list of letters to print
N IEN,DFN,EAX,PFLAGS,ABRT
;
I '$D(ZTQUEUED) W !,"Collecting "_$S(LTRGRP=1:"60-Day",LTRGRP=2:"30-Day",LTRGRP=4:"0-Day",1:"All ")_" letters"
S IEN=0
F S IEN=$O(^EAS(713.2,"AC",0,IEN)) Q:'IEN D
. S EAX=$$GET1^DIQ(713.2,IEN,2,"I")
. S DFN=$$GET1^DIQ(713.1,EAX,.01,"I")
. Q:'$$UESITE(UES,DFN) ; Check if UE Site matches selected site to print letters for
. I $D(^EAS(713.1,"AP",1,EAX)) D Q ; Check for Prohibit flag
. . D CLRFLG^EASMTUTL(0,IEN)
. . S ^TMP("EASUE",$J,"ERR",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^1~Prohibit Flag is set for the Veteran"
. I $$DECEASED^EASMTUTL(IEN) D Q ; Check if veteran is deceased
. . D CLRFLG^EASMTUTL(0,IEN)
. . S ^TMP("EASUE",$J,"ERR",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^2~Veteran is deceased"
. I $$FUTMT^EASMTUTL(IEN) D Q ; Check if a future dated MT is in place
. . D CLRFLG^EASMTUTL(0,IEN)
. . S ^TMP("EASUE",$J,"ERR",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^3~Veteran has a future dated Means Test"
. I $$CHKADR^EASMTL6A(EAX) D Q ; Check for a valid address
. . S ^TMP("EASUE",$J,"ERR",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^4~Invalid address or Bad Address Flag"
. S PFLAGS=$$LGROUP(IEN,LTRGRP)
. S ^TMP("EASUE",$J,"PRNT",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^"_PFLAGS
Q
;
UESITE(UES,DFN) ; Determine UE Status
; Input
; UES - Selected User Enrollee Site
; DFN - Patient DFN
;
; Returns a '1' if UE Status is 'Diff. Site' and USER ENROLLEE SITE, Field #.3618, File #2
; matches the UE Site passed in. otherwise returns a '0'
;
N RSLT
;
I $$UESTAT^EASUER(DFN)=2 D
. S:$$GET1^DIQ(2,DFN,.3618,"I")=UES RSLT=1
Q $G(RSLT)
;
LGROUP(IEN,LTRGRP) ; Check whether the letter group has a pending letter or not.
; Input - Ien in 713.2
; - LTRGRP - Letter group selected: 60/30/0/All
;
; Output - Returns a '1' it there is a pending letter for that letter group and
; a '0' if there is not. Format is: 60-Day~30-Day~0-Day~All
;
N NODE6,NODE4,NODEZ,RSLT
;
S NODE6=$G(^EAS(713.2,IEN,6))
S NODE4=$G(^EAS(713.2,IEN,4))
S NODEZ=$G(^EAS(713.2,IEN,"Z"))
;
S $P(RSLT,"~",1)=+$P(NODE6,U,2)
S $P(RSLT,"~",2)=+$P(NODE4,U,2)
S $P(RSLT,"~",4)=+$P(NODEZ,U,2)
S $P(RSLT,"~",5)=$S(LTRGRP=5:1,1:0)
;
Q $G(RSLT)
;
PRINT(LTRGRP) ; Print Letter
N NAME,IEN,DFN,PFLAGS,EAX,EATYP
;
S NAME="",LTRCNT=0
F S NAME=$O(^TMP("EASUE",$J,"PRNT",NAME)) Q:NAME']"" D
. K IEN,DFN,PFLAGS
. S IEN=$P(^TMP("EASUE",$J,"PRNT",NAME),U,1)
. S DFN=$P(^TMP("EASUE",$J,"PRNT",NAME),U,2)
. S PFLAGS=$P(^TMP("EASUE",$J,"PRNT",NAME),U,3)
. I LTRGRP=5 D
. . F EAX=1,2,4 D
. . . I $P(PFLAGS,"~",EAX) D
. . . . D LETTER^EASMTL6A(IEN,EAX)
. . . . S LTRCNT(EAX)=LTRCNT(EAX)+1
. . . . D UPDSTAT^EASMTL6(IEN,EAX)
. E D
. . I $P(PFLAGS,"~",LTRGRP) D
. . . D LETTER^EASMTL6A(IEN,LTRGRP)
. . . S LTRCNT(LTRGRP)=LTRCNT(LTRGRP)+1
. . . D UPDSTAT^EASMTL6(IEN,LTRGRP)
Q
;
FINAL(UES,LTRGRP) ; Final wrap up
N MSG,LINECNT,XMSUB,XMTEXT,XMY,XMDUZ,TOT
;
I $D(^TMP("EASUE",$J,"ERR")) D ERRPT(UES,LTRGRP)
;
S MSG(1)="Count of Means Test letters printed for a User Enrollee Site"
S MSG(2)=""
S MSG(5)="User Enrollee Site: "_$$GET1^DIQ(4,UES,.01)
S MSG(10)=" Letter Group: "_$S(LTRGRP=1:"60-Day",LTRGRP=2:"30-Day",LTRGRP=4:"0-Day",1:"All")_" letters."
S MSG(15)=""
S MSG(20)=" 60-day letters printed: "_+$G(LTRCNT(1))
S MSG(22)=" 30-day letters printed: "_+$G(LTRCNT(2))
S MSG(24)=" 0-day letters printed: "_+$G(LTRCNT(4))
S TOT=$G(LTRCNT(1))+$G(LTRCNT(2))+$G(LTRCNT(4))
S MSG(26)=" Total: "_TOT
;
S XMSUB="EAS LETTER RESULTS BY UE SITE "
S XMTEXT="MSG("
S XMY("G.EAS MTLETTERS")=""
S XMDUZ="EAS MT LETTERS"
D ^XMD
Q
;
ERRPT(UES,LTRGRP) ; send error report to MT letters mail group
N MSG,NAME,DFN,IEN,ERROR,LINE,LINECNT,VA,SPACE,XMSUB,XMTEXT,XMY,XMDUZ
;
S NAME="",LINECNT=100
F S NAME=$O(^TMP("EASUE",$J,"ERR",NAME)) Q:NAME']"" D
. S IEN=$P(^TMP("EASUE",$J,"ERR",NAME),U,1)
. S DFN=$P(^TMP("EASUE",$J,"ERR",NAME),U,2)
. S ERROR=$P(^TMP("EASUE",$J,"ERR",NAME),U,3)
. S LINE=$E(NAME,1,25)
. D PID^VADPT6 S LINE=LINE_" ("_VA("BID")_")" K VA
. S SPACE="",$P(SPACE," ",32-$L(LINE))=""
. S LINE=LINE_SPACE_$P(ERROR,"~",2)
. S MSG(LINECNT)=LINE,LINECNT=LINECNT+1
;
S MSG(1)="The following errors were encountered during the processing of "
S MSG(2)="the Means Test Letters for the "_$$GET1^DIQ(4,UES,.01)_" User Enrollee Site."
S MSG(4)=""
S MSG(10)="Letter Group: "_$S(LTRGRP=1:"60-Day",LTRGRP=2:"30-Day",LTRGRP=4:"0-Day",1:"All")_" letters."
S MSG(30)=""
;
S XMSUB="EAS PRINT LETTERS BY UE SITE"
S XMTEXT="MSG("
S XMY("G.EAS MTLETTERS")=""
S XMDUZ="EAS MT LETTERS"
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASMT65 6870 printed Oct 16, 2024@17:56:08 Page 2
EASMT65 ; ALB/SCK - MEANS TEST LETTER PRINT FOR USER ENROLLEE STATUS ; 25-JUL-2007
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**65**;MAR 15,2001;Build 1
+2 ;
QUE ;
+1 NEW UES,LTRGRP,ZTSAVE,RETZTSK,ZTSK
+2 ;
+3 IF '$DATA(^XUSEC("EAS MT UES OVERRIDE",DUZ))
Begin DoDot:1
+4 WRITE !!,"You have not been assigned the required key to use this option."
+5 WRITE !,"Please contact IRM or the Means Test Coordinator at your site"
+6 WRITE !,"for assistance.",!!
End DoDot:1
QUIT
+7 ;
+8 if $DATA(IOF)
WRITE @IOF
+9 SET UES=$$GETSITE
if 'UES
QUIT
+10 SET LTRGRP=$$LTRS
if LTRGRP=0
QUIT
+11 ;
+12 SET RETZTSK=1
+13 SET ZTSAVE("UES")=""
SET ZTSAVE("LTRGRP")=""
+14 DO EN^XUTMDEVQ("EN^EASMT65","MT letters, UES print",.ZTSAVE)
+15 WRITE !,"Job has been tasked: ",$GET(ZTSK)
+16 QUIT
+17 ;
EN ;
+1 NEW LTRCNT,EAX
+2 ;
+3 if '$GET(UES)
QUIT
+4 if '$GET(LTRGRP)
QUIT
+5 ;
+6 KILL ^TMP("EASUE",$JOB)
+7 FOR EAX=1,2,4
SET LTRCNT(EAX)=0
+8 ;
+9 DO BUILD(UES,LTRGRP)
+10 DO PRINT(LTRGRP)
+11 DO FINAL(UES,LTRGRP)
+12 ;
+13 KILL ^TMP("EASUE",$JOB)
+14 DO ^%ZISC
+15 QUIT
+16 ;
GETSITE() ; Select User Enrollee Site
+1 NEW DIR,X,Y,DIRUT,DTOUT,DUOUT,RSLT
+2 ;
+3 WRITE !,"This option will allow the override of the current filters on the User"
+4 WRITE !,"Enrollee site. By selecting a site, letters for veterans that are"
+5 WRITE !,"listed as a User Enrollee of that site can be printed."
+6 WRITE !,"This option should be used with care!",!
+7 ;
+8 SET DIR(0)="PAO^4:EMZ"
+9 SET DIR("A")="Select the User Enrollee site to print letters for: "
+10 DO ^DIR
KILL DIR
+11 SET RSLT=+Y
+12 IF $DATA(DIRUT)
SET RSLT=0
+13 QUIT $GET(RSLT)
+14 ;
LTRS() ; Select letter group to print
+1 NEW DIR,DIRUT,DUOUT,DTOUT,X,Y
+2 ;
+3 SET DIR(0)="SO^1:60-Day Letters;2:30-Day Letters;4:0-Day Letters;ALL:All Letters"
+4 SET DIR("L",1)="Select the group of Letters to print:"
+5 SET DIR("L",2)=""
+6 SET DIR("L",3)=" 1: 60-Day 2: 30-Day Letters 4: 0-Day Letters"
+7 SET DIR("L")=" ALL: All Letters"
+8 SET DIR("?",1)=""
+9 SET DIR("?",2)="Select the group of letters to print: enter 1 for 60 day letters, "
+10 SET DIR("?",3)="enter 2 for 30 day lettes, or enter 4 for 0 day letters."
+11 SET DIR("?")="Entering 'All' will print all pending letters for 60, 30, and 0 days."
+12 DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
SET Y=0
+14 IF Y="ALL"
SET Y=5
+15 QUIT $GET(Y)
+16 ;
BUILD(UES,LTRGRP) ; Build list of letters to print
+1 NEW IEN,DFN,EAX,PFLAGS,ABRT
+2 ;
+3 IF '$DATA(ZTQUEUED)
WRITE !,"Collecting "_$SELECT(LTRGRP=1:"60-Day",LTRGRP=2:"30-Day",LTRGRP=4:"0-Day",1:"All ")_" letters"
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^EAS(713.2,"AC",0,IEN))
if 'IEN
QUIT
Begin DoDot:1
+6 SET EAX=$$GET1^DIQ(713.2,IEN,2,"I")
+7 SET DFN=$$GET1^DIQ(713.1,EAX,.01,"I")
+8 ; Check if UE Site matches selected site to print letters for
if '$$UESITE(UES,DFN)
QUIT
+9 ; Check for Prohibit flag
IF $DATA(^EAS(713.1,"AP",1,EAX))
Begin DoDot:2
+10 DO CLRFLG^EASMTUTL(0,IEN)
+11 SET ^TMP("EASUE",$JOB,"ERR",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^1~Prohibit Flag is set for the Veteran"
End DoDot:2
QUIT
+12 ; Check if veteran is deceased
IF $$DECEASED^EASMTUTL(IEN)
Begin DoDot:2
+13 DO CLRFLG^EASMTUTL(0,IEN)
+14 SET ^TMP("EASUE",$JOB,"ERR",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^2~Veteran is deceased"
End DoDot:2
QUIT
+15 ; Check if a future dated MT is in place
IF $$FUTMT^EASMTUTL(IEN)
Begin DoDot:2
+16 DO CLRFLG^EASMTUTL(0,IEN)
+17 SET ^TMP("EASUE",$JOB,"ERR",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^3~Veteran has a future dated Means Test"
End DoDot:2
QUIT
+18 ; Check for a valid address
IF $$CHKADR^EASMTL6A(EAX)
Begin DoDot:2
+19 SET ^TMP("EASUE",$JOB,"ERR",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^4~Invalid address or Bad Address Flag"
End DoDot:2
QUIT
+20 SET PFLAGS=$$LGROUP(IEN,LTRGRP)
+21 SET ^TMP("EASUE",$JOB,"PRNT",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^"_PFLAGS
End DoDot:1
+22 QUIT
+23 ;
UESITE(UES,DFN) ; Determine UE Status
+1 ; Input
+2 ; UES - Selected User Enrollee Site
+3 ; DFN - Patient DFN
+4 ;
+5 ; Returns a '1' if UE Status is 'Diff. Site' and USER ENROLLEE SITE, Field #.3618, File #2
+6 ; matches the UE Site passed in. otherwise returns a '0'
+7 ;
+8 NEW RSLT
+9 ;
+10 IF $$UESTAT^EASUER(DFN)=2
Begin DoDot:1
+11 if $$GET1^DIQ(2,DFN,.3618,"I")=UES
SET RSLT=1
End DoDot:1
+12 QUIT $GET(RSLT)
+13 ;
LGROUP(IEN,LTRGRP) ; Check whether the letter group has a pending letter or not.
+1 ; Input - Ien in 713.2
+2 ; - LTRGRP - Letter group selected: 60/30/0/All
+3 ;
+4 ; Output - Returns a '1' it there is a pending letter for that letter group and
+5 ; a '0' if there is not. Format is: 60-Day~30-Day~0-Day~All
+6 ;
+7 NEW NODE6,NODE4,NODEZ,RSLT
+8 ;
+9 SET NODE6=$GET(^EAS(713.2,IEN,6))
+10 SET NODE4=$GET(^EAS(713.2,IEN,4))
+11 SET NODEZ=$GET(^EAS(713.2,IEN,"Z"))
+12 ;
+13 SET $PIECE(RSLT,"~",1)=+$PIECE(NODE6,U,2)
+14 SET $PIECE(RSLT,"~",2)=+$PIECE(NODE4,U,2)
+15 SET $PIECE(RSLT,"~",4)=+$PIECE(NODEZ,U,2)
+16 SET $PIECE(RSLT,"~",5)=$SELECT(LTRGRP=5:1,1:0)
+17 ;
+18 QUIT $GET(RSLT)
+19 ;
PRINT(LTRGRP) ; Print Letter
+1 NEW NAME,IEN,DFN,PFLAGS,EAX,EATYP
+2 ;
+3 SET NAME=""
SET LTRCNT=0
+4 FOR
SET NAME=$ORDER(^TMP("EASUE",$JOB,"PRNT",NAME))
if NAME']""
QUIT
Begin DoDot:1
+5 KILL IEN,DFN,PFLAGS
+6 SET IEN=$PIECE(^TMP("EASUE",$JOB,"PRNT",NAME),U,1)
+7 SET DFN=$PIECE(^TMP("EASUE",$JOB,"PRNT",NAME),U,2)
+8 SET PFLAGS=$PIECE(^TMP("EASUE",$JOB,"PRNT",NAME),U,3)
+9 IF LTRGRP=5
Begin DoDot:2
+10 FOR EAX=1,2,4
Begin DoDot:3
+11 IF $PIECE(PFLAGS,"~",EAX)
Begin DoDot:4
+12 DO LETTER^EASMTL6A(IEN,EAX)
+13 SET LTRCNT(EAX)=LTRCNT(EAX)+1
+14 DO UPDSTAT^EASMTL6(IEN,EAX)
End DoDot:4
End DoDot:3
End DoDot:2
+15 IF '$TEST
Begin DoDot:2
+16 IF $PIECE(PFLAGS,"~",LTRGRP)
Begin DoDot:3
+17 DO LETTER^EASMTL6A(IEN,LTRGRP)
+18 SET LTRCNT(LTRGRP)=LTRCNT(LTRGRP)+1
+19 DO UPDSTAT^EASMTL6(IEN,LTRGRP)
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
FINAL(UES,LTRGRP) ; Final wrap up
+1 NEW MSG,LINECNT,XMSUB,XMTEXT,XMY,XMDUZ,TOT
+2 ;
+3 IF $DATA(^TMP("EASUE",$JOB,"ERR"))
DO ERRPT(UES,LTRGRP)
+4 ;
+5 SET MSG(1)="Count of Means Test letters printed for a User Enrollee Site"
+6 SET MSG(2)=""
+7 SET MSG(5)="User Enrollee Site: "_$$GET1^DIQ(4,UES,.01)
+8 SET MSG(10)=" Letter Group: "_$SELECT(LTRGRP=1:"60-Day",LTRGRP=2:"30-Day",LTRGRP=4:"0-Day",1:"All")_" letters."
+9 SET MSG(15)=""
+10 SET MSG(20)=" 60-day letters printed: "_+$GET(LTRCNT(1))
+11 SET MSG(22)=" 30-day letters printed: "_+$GET(LTRCNT(2))
+12 SET MSG(24)=" 0-day letters printed: "_+$GET(LTRCNT(4))
+13 SET TOT=$GET(LTRCNT(1))+$GET(LTRCNT(2))+$GET(LTRCNT(4))
+14 SET MSG(26)=" Total: "_TOT
+15 ;
+16 SET XMSUB="EAS LETTER RESULTS BY UE SITE "
+17 SET XMTEXT="MSG("
+18 SET XMY("G.EAS MTLETTERS")=""
+19 SET XMDUZ="EAS MT LETTERS"
+20 DO ^XMD
+21 QUIT
+22 ;
ERRPT(UES,LTRGRP) ; send error report to MT letters mail group
+1 NEW MSG,NAME,DFN,IEN,ERROR,LINE,LINECNT,VA,SPACE,XMSUB,XMTEXT,XMY,XMDUZ
+2 ;
+3 SET NAME=""
SET LINECNT=100
+4 FOR
SET NAME=$ORDER(^TMP("EASUE",$JOB,"ERR",NAME))
if NAME']""
QUIT
Begin DoDot:1
+5 SET IEN=$PIECE(^TMP("EASUE",$JOB,"ERR",NAME),U,1)
+6 SET DFN=$PIECE(^TMP("EASUE",$JOB,"ERR",NAME),U,2)
+7 SET ERROR=$PIECE(^TMP("EASUE",$JOB,"ERR",NAME),U,3)
+8 SET LINE=$EXTRACT(NAME,1,25)
+9 DO PID^VADPT6
SET LINE=LINE_" ("_VA("BID")_")"
KILL VA
+10 SET SPACE=""
SET $PIECE(SPACE," ",32-$LENGTH(LINE))=""
+11 SET LINE=LINE_SPACE_$PIECE(ERROR,"~",2)
+12 SET MSG(LINECNT)=LINE
SET LINECNT=LINECNT+1
End DoDot:1
+13 ;
+14 SET MSG(1)="The following errors were encountered during the processing of "
+15 SET MSG(2)="the Means Test Letters for the "_$$GET1^DIQ(4,UES,.01)_" User Enrollee Site."
+16 SET MSG(4)=""
+17 SET MSG(10)="Letter Group: "_$SELECT(LTRGRP=1:"60-Day",LTRGRP=2:"30-Day",LTRGRP=4:"0-Day",1:"All")_" letters."
+18 SET MSG(30)=""
+19 ;
+20 SET XMSUB="EAS PRINT LETTERS BY UE SITE"
+21 SET XMTEXT="MSG("
+22 SET XMY("G.EAS MTLETTERS")=""
+23 SET XMDUZ="EAS MT LETTERS"
+24 DO ^XMD
+25 QUIT
