EASMTL8 ;618/TCM ALB/SCK/PHH - AUTOMATED MEANS TEST LETTER, 20-DAY REPORT OF CONTACT FORM ; 07/17/01
;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,54**;MAR 15,2001
;
QUE ;
N EASTMP,DIR,DUOUT,DTOUT,DIRUT
;
S EASTMP="^TMP(""EASROC"",$J)"
K @EASTMP
;
START ;
S DIR(0)="PAO^713.2:EMZ",DIR("A")="Select Patient: "
S DIR("?")="Select patient or press ENTER when finished"
D ^DIR K DIR
Q:$D(DUOUT)!($D(DTOUT))
S @EASTMP@(+Y)=""
I '$D(DIRUT) G START
END ;
S ZTSAVE("EASTMP")=""
D EN^XUTMDEVQ("PRINT^EASMTL8","EAS MT REPORT OF CONTACTS",.ZTSAVE)
Q
;
PRINT ;
N EASIEN
;
S EASIEN=0
F S EASIEN=$O(@EASTMP@(EASIEN)) Q:'EASIEN D Q:$D(DIRUT)
. D FORM(EASIEN)
. I $E(IOST,1,2)="C-" D
. . S DIR(0)="E"
. . D ^DIR K DIR
. . I 'Y S DIRUT=1
. . W @IOF
K @EASTMP
Q
;
FORM(EASIEN) ; Print 20 day form
N DFN,EASDEM,EASADD,EASHDR,EASFAC,EASLIEN,ULC,ULNE,EASANV,LINE,EASOK,EASDEV,XL,EAX,EASPTR
;
S EASANV=$$GET1^DIQ(713.2,EASIEN,3,"I")
S EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I")
S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
D GETPAT^EASMTL6A(DFN,.EASDEM,.EASADD)
D GETFAC^EASMTL6(DFN,.EASFAC)
;
; Merge FileMan data arrays into more usable formats
M EASHDR("F")=EASFAC
M EASHDR("D")=EASDEM
M EASHDR("A")=EASADD
;
D HDR(.EASHDR)
;
W !?5,"Means Test Anniversary Date: ",$$FMTE^XLFDT($$ADDLEAP^EASMTUTL(EASANV),"D")
;
S EASLIEN=$O(^EAS(713.3,"C",3,0))
Q:'EASLIEN
S EALNE=0
I $D(^EAS(713.3,EASLIEN,1)) D S EASOK=1
. F S EALNE=$O(^EAS(713.3,EASLIEN,1,EALNE)) Q:'EALNE D
. . S LINE=^EAS(713.3,EASLIEN,1,EALNE,0)
. . I LINE["|ANNVDT|" W !?6,$P(LINE,"|ANNVDT|",1)," ",$$FMTE^XLFDT(EASANV,"D"),$P(LINE,"|ANNVDT|",2) Q
. . W !?6,LINE
;
I $D(^EAS(713.3,EASLIEN,2)) D S EASOK=1
. S EALNE=0
. F S EALNE=$O(^EAS(713.3,EASLIEN,2,EALNE)) Q:'EALNE D
. . S LINE=^EAS(713.3,EASLIEN,2,EALNE,0)
. . W !,LINE
;
F EAX=0:0 Q:($Y+8)>IOSL W !
W ! F XL=1:1:IOM-1 W "-"
W !,"| Division or Section",?40,"| Executed By (signature and title)",?(IOM-1),"|"
W !,"|",?40,"|",?(IOM-1),"|"
W !,"|",?40,"|",?(IOM-1),"|"
W ! F XL=1:1:IOM-1 W "-"
W !,?40,"PRINTED: ",$$FMTE^XLFDT($$NOW^XLFDT,"P")
Q
;
HDR(EASHDR) ; Print form header for report of contact
; Input
; EASHDR - Header information array
;
N EALNE,EAX,TS1,TS2,TS3,TS4
;
Q:'$D(EASHDR)
D SETLNE(.EALNE)
;
S TS2=40,TS3=58,TS4=$G(IOM)-1
;W $E(EALNE("DD"),1,IOM)
W !,"D E P A R T M E N T O F V E T E R A N A F F A I R S"
W !,$E(EALNE("DD"),1,IOM)
W !,"| REPORT OF CONTACT",?TS2,"| VA Office",?TS3,"| Identification No.",?TS4,"|"
W !,"| Note: This form must be filled out in",?TS2,"|",?TS3,"| ",?TS4,"|"
W !,"| ink or on typewriter as it becomes a"
W ?TS2,"| ",?TS3,"| ",$P(EASHDR("D",2),U,2),?TS4,"|"
W !,"| permanent record in veterans' folders.",?TS2,"|",?TS3,"|",?TS4,"|"
W !,$E(EALNE("D"),1,TS4)
W !,"| Last Name-First Name-Middle Name (Type or print)",?TS3,"| Date of Contact",?TS4,"|"
W !,"|",?TS3,"|",?TS4,"|"
W !,"| ",EASHDR("D",1),?TS3,"|",?TS4,"|"
W !,$E(EALNE("D"),1,TS4)
W !,"| Address of Veteran",?TS3,"| Telephone",?TS4,"|"
W !,"| ",EASHDR("A",1),?TS3,"| ",EASHDR("A",8),?TS4,"|"
I EASHDR("A",2)]"" W !,"| ",EASHDR("A",2),?TS3,"|",?TS4,"|"
I EASHDR("A",3)]"" W !,"| ",EASHDR("A",3),?TS3,"|",?TS4,"|"
W !,"| ",EASHDR("A",4)_", "_$P(EASHDR("A",5),U,2)_" "_$P(EASHDR("A",11),U,2),?TS3,"|",?TS4,"|"
W !,$E(EALNE("D"),1,TS4)
W !,"| Person Contacted",?TS3,"| Type of Contact",?TS4,"|"
W !,"|",?TS3,"| Personal/Telephone",?TS4,"|"
W !,"|",?TS3,"|",?TS4,"|"
W !,$E(EALNE("D"),1,TS4)
W !,"| Address of Person Contacted",?TS3,"| Telephone",?TS4,"|"
W !,"|",?TS3,"|",?TS4,"|"
W !,"|",?TS3,"|",?TS4,"|"
W !,"|",?TS3,"|",?TS4,"|"
W !,$E(EALNE("D"),1,TS4)
W !," Brief statement of information requested and given",!
EXIT Q
;
;
SETLNE(EALNE) ;
N RMAR
;
S RMAR=$G(IOM) S:'RMAR RMAR=80
S EALNE("D")="",EALNE("DD")="",EALNE("UL")=""
S $P(EALNE("D"),"-",RMAR)=""
S $P(EALNE("DD"),"=",RMAR)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASMTL8 4031 printed Dec 13, 2024@01:55:28 Page 2
EASMTL8 ;618/TCM ALB/SCK/PHH - AUTOMATED MEANS TEST LETTER, 20-DAY REPORT OF CONTACT FORM ; 07/17/01
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,54**;MAR 15,2001
+2 ;
QUE ;
+1 NEW EASTMP,DIR,DUOUT,DTOUT,DIRUT
+2 ;
+3 SET EASTMP="^TMP(""EASROC"",$J)"
+4 KILL @EASTMP
+5 ;
START ;
+1 SET DIR(0)="PAO^713.2:EMZ"
SET DIR("A")="Select Patient: "
+2 SET DIR("?")="Select patient or press ENTER when finished"
+3 DO ^DIR
KILL DIR
+4 if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+5 SET @EASTMP@(+Y)=""
+6 IF '$DATA(DIRUT)
GOTO START
END ;
+1 SET ZTSAVE("EASTMP")=""
+2 DO EN^XUTMDEVQ("PRINT^EASMTL8","EAS MT REPORT OF CONTACTS",.ZTSAVE)
+3 QUIT
+4 ;
PRINT ;
+1 NEW EASIEN
+2 ;
+3 SET EASIEN=0
+4 FOR
SET EASIEN=$ORDER(@EASTMP@(EASIEN))
if 'EASIEN
QUIT
Begin DoDot:1
+5 DO FORM(EASIEN)
+6 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:2
+7 SET DIR(0)="E"
+8 DO ^DIR
KILL DIR
+9 IF 'Y
SET DIRUT=1
+10 WRITE @IOF
End DoDot:2
End DoDot:1
if $DATA(DIRUT)
QUIT
+11 KILL @EASTMP
+12 QUIT
+13 ;
FORM(EASIEN) ; Print 20 day form
+1 NEW DFN,EASDEM,EASADD,EASHDR,EASFAC,EASLIEN,ULC,ULNE,EASANV,LINE,EASOK,EASDEV,XL,EAX,EASPTR
+2 ;
+3 SET EASANV=$$GET1^DIQ(713.2,EASIEN,3,"I")
+4 SET EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I")
+5 SET DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
+6 DO GETPAT^EASMTL6A(DFN,.EASDEM,.EASADD)
+7 DO GETFAC^EASMTL6(DFN,.EASFAC)
+8 ;
+9 ; Merge FileMan data arrays into more usable formats
+10 MERGE EASHDR("F")=EASFAC
+11 MERGE EASHDR("D")=EASDEM
+12 MERGE EASHDR("A")=EASADD
+13 ;
+14 DO HDR(.EASHDR)
+15 ;
+16 WRITE !?5,"Means Test Anniversary Date: ",$$FMTE^XLFDT($$ADDLEAP^EASMTUTL(EASANV),"D")
+17 ;
+18 SET EASLIEN=$ORDER(^EAS(713.3,"C",3,0))
+19 if 'EASLIEN
QUIT
+20 SET EALNE=0
+21 IF $DATA(^EAS(713.3,EASLIEN,1))
Begin DoDot:1
+22 FOR
SET EALNE=$ORDER(^EAS(713.3,EASLIEN,1,EALNE))
if 'EALNE
QUIT
Begin DoDot:2
+23 SET LINE=^EAS(713.3,EASLIEN,1,EALNE,0)
+24 IF LINE["|ANNVDT|"
WRITE !?6,$PIECE(LINE,"|ANNVDT|",1)," ",$$FMTE^XLFDT(EASANV,"D"),$PIECE(LINE,"|ANNVDT|",2)
QUIT
+25 WRITE !?6,LINE
End DoDot:2
End DoDot:1
SET EASOK=1
+26 ;
+27 IF $DATA(^EAS(713.3,EASLIEN,2))
Begin DoDot:1
+28 SET EALNE=0
+29 FOR
SET EALNE=$ORDER(^EAS(713.3,EASLIEN,2,EALNE))
if 'EALNE
QUIT
Begin DoDot:2
+30 SET LINE=^EAS(713.3,EASLIEN,2,EALNE,0)
+31 WRITE !,LINE
End DoDot:2
End DoDot:1
SET EASOK=1
+32 ;
+33 FOR EAX=0:0
if ($Y+8)>IOSL
QUIT
WRITE !
+34 WRITE !
FOR XL=1:1:IOM-1
WRITE "-"
+35 WRITE !,"| Division or Section",?40,"| Executed By (signature and title)",?(IOM-1),"|"
+36 WRITE !,"|",?40,"|",?(IOM-1),"|"
+37 WRITE !,"|",?40,"|",?(IOM-1),"|"
+38 WRITE !
FOR XL=1:1:IOM-1
WRITE "-"
+39 WRITE !,?40,"PRINTED: ",$$FMTE^XLFDT($$NOW^XLFDT,"P")
+40 QUIT
+41 ;
HDR(EASHDR) ; Print form header for report of contact
+1 ; Input
+2 ; EASHDR - Header information array
+3 ;
+4 NEW EALNE,EAX,TS1,TS2,TS3,TS4
+5 ;
+6 if '$DATA(EASHDR)
QUIT
+7 DO SETLNE(.EALNE)
+8 ;
+9 SET TS2=40
SET TS3=58
SET TS4=$GET(IOM)-1
+10 ;W $E(EALNE("DD"),1,IOM)
+11 WRITE !,"D E P A R T M E N T O F V E T E R A N A F F A I R S"
+12 WRITE !,$EXTRACT(EALNE("DD"),1,IOM)
+13 WRITE !,"| REPORT OF CONTACT",?TS2,"| VA Office",?TS3,"| Identification No.",?TS4,"|"
+14 WRITE !,"| Note: This form must be filled out in",?TS2,"|",?TS3,"| ",?TS4,"|"
+15 WRITE !,"| ink or on typewriter as it becomes a"
+16 WRITE ?TS2,"| ",?TS3,"| ",$PIECE(EASHDR("D",2),U,2),?TS4,"|"
+17 WRITE !,"| permanent record in veterans' folders.",?TS2,"|",?TS3,"|",?TS4,"|"
+18 WRITE !,$EXTRACT(EALNE("D"),1,TS4)
+19 WRITE !,"| Last Name-First Name-Middle Name (Type or print)",?TS3,"| Date of Contact",?TS4,"|"
+20 WRITE !,"|",?TS3,"|",?TS4,"|"
+21 WRITE !,"| ",EASHDR("D",1),?TS3,"|",?TS4,"|"
+22 WRITE !,$EXTRACT(EALNE("D"),1,TS4)
+23 WRITE !,"| Address of Veteran",?TS3,"| Telephone",?TS4,"|"
+24 WRITE !,"| ",EASHDR("A",1),?TS3,"| ",EASHDR("A",8),?TS4,"|"
+25 IF EASHDR("A",2)]""
WRITE !,"| ",EASHDR("A",2),?TS3,"|",?TS4,"|"
+26 IF EASHDR("A",3)]""
WRITE !,"| ",EASHDR("A",3),?TS3,"|",?TS4,"|"
+27 WRITE !,"| ",EASHDR("A",4)_", "_$PIECE(EASHDR("A",5),U,2)_" "_$PIECE(EASHDR("A",11),U,2),?TS3,"|",?TS4,"|"
+28 WRITE !,$EXTRACT(EALNE("D"),1,TS4)
+29 WRITE !,"| Person Contacted",?TS3,"| Type of Contact",?TS4,"|"
+30 WRITE !,"|",?TS3,"| Personal/Telephone",?TS4,"|"
+31 WRITE !,"|",?TS3,"|",?TS4,"|"
+32 WRITE !,$EXTRACT(EALNE("D"),1,TS4)
+33 WRITE !,"| Address of Person Contacted",?TS3,"| Telephone",?TS4,"|"
+34 WRITE !,"|",?TS3,"|",?TS4,"|"
+35 WRITE !,"|",?TS3,"|",?TS4,"|"
+36 WRITE !,"|",?TS3,"|",?TS4,"|"
+37 WRITE !,$EXTRACT(EALNE("D"),1,TS4)
+38 WRITE !," Brief statement of information requested and given",!
EXIT QUIT
+1 ;
+2 ;
SETLNE(EALNE) ;
+1 NEW RMAR
+2 ;
+3 SET RMAR=$GET(IOM)
if 'RMAR
SET RMAR=80
+4 SET EALNE("D")=""
SET EALNE("DD")=""
SET EALNE("UL")=""
+5 SET $PIECE(EALNE("D"),"-",RMAR)=""
+6 SET $PIECE(EALNE("DD"),"=",RMAR)=""
+7 QUIT
