EAS1A58 ;ALB/PJR/EG - INVALID ENTRIES - EAS MT LETTER FILE ; 2/18/05 7:28 AM
;;1.0;ENROLLMENT APPLICATION SYSTEM;**58**; 21-OCT-94
;This post install routine checks the EAS MT Letter File (713.3)
;for the possible existence of entries for 20 and 40 day letters.
;If found, these entries will be deleted.
Q
;
EP ;Entry point
N DA,DIE,DR,X,ZBBB,ZCNT,ZDATE,ZNUM,PURDAT,BEGTIME
;capture beginning date/time and get purge date
S BEGTIME=$$NOW^XLFDT()
S PURGDT=$$FMADD^XLFDT(BEGTIME,15)
S ZCNT=0,ZDATE=$$DT^XLFDT
S $P(^XTMP("EAS1A58","DATE"),U)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
;Check EAS MT Letter File
F ZNUM=20,40 S ZBBB=$O(^EAS(713.3,"B",ZNUM_" ")) D
.I $E(ZBBB,1,2)=ZNUM,ZBBB["DAY",ZBBB["LETTER",$E(ZBBB,3)'?1N D
..S DA=$O(^EAS(713.3,"B",ZBBB,0)) I 'DA Q
..S DIE=713.3,DR=".01////@" D ^DIE S ZCNT=ZCNT+1 Q
S $P(^XTMP("EAS1A58","DATE"),U,2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
S ZDATE=$$DT^XLFDT
D EA58 S ^XTMP("EAS1A58",0)=PURGDT_U_BEGTIME_U_X_U_ZCNT_U_ZDATE
S ^XTMP("EAS1A58","COMPLETED")=1 D MSG
Q
;
;
MSG ;create bulletin message in install file.
N TXT S (TXT(3),TXT(5))=" "
S TXT(1)="This patch checked the EAS MT Letter File (713.3)"
S TXT(2)="for the existence of entries for 20 and 40 day letters."
I ZCNT D SOME
I 'ZCNT D NONE
D BMES^XPDUTL(.TXT)
Q
SOME ;
I ZCNT=1 S TXT(4)="One entry was removed. The process is complete." Q
S TXT(4)=ZCNT_" entries were removed. The process is complete."
Q
NONE ;
S TXT(4)="No such entries were found. No action was necessary."
Q
;
EA58 S X="EAS*1.0*58 Invalid Entries in EAS MT Letter File" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS1A58 1616 printed Dec 13, 2024@01:53:32 Page 2
EAS1A58 ;ALB/PJR/EG - INVALID ENTRIES - EAS MT LETTER FILE ; 2/18/05 7:28 AM
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**58**; 21-OCT-94
+2 ;This post install routine checks the EAS MT Letter File (713.3)
+3 ;for the possible existence of entries for 20 and 40 day letters.
+4 ;If found, these entries will be deleted.
+5 QUIT
+6 ;
EP ;Entry point
+1 NEW DA,DIE,DR,X,ZBBB,ZCNT,ZDATE,ZNUM,PURDAT,BEGTIME
+2 ;capture beginning date/time and get purge date
+3 SET BEGTIME=$$NOW^XLFDT()
+4 SET PURGDT=$$FMADD^XLFDT(BEGTIME,15)
+5 SET ZCNT=0
SET ZDATE=$$DT^XLFDT
+6 SET $PIECE(^XTMP("EAS1A58","DATE"),U)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
+7 ;Check EAS MT Letter File
+8 FOR ZNUM=20,40
SET ZBBB=$ORDER(^EAS(713.3,"B",ZNUM_" "))
Begin DoDot:1
+9 IF $EXTRACT(ZBBB,1,2)=ZNUM
IF ZBBB["DAY"
IF ZBBB["LETTER"
IF $EXTRACT(ZBBB,3)'?1N
Begin DoDot:2
+10 SET DA=$ORDER(^EAS(713.3,"B",ZBBB,0))
IF 'DA
QUIT
+11 SET DIE=713.3
SET DR=".01////@"
DO ^DIE
SET ZCNT=ZCNT+1
QUIT
End DoDot:2
End DoDot:1
+12 SET $PIECE(^XTMP("EAS1A58","DATE"),U,2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
+13 SET ZDATE=$$DT^XLFDT
+14 DO EA58
SET ^XTMP("EAS1A58",0)=PURGDT_U_BEGTIME_U_X_U_ZCNT_U_ZDATE
+15 SET ^XTMP("EAS1A58","COMPLETED")=1
DO MSG
+16 QUIT
+17 ;
+18 ;
MSG ;create bulletin message in install file.
+1 NEW TXT
SET (TXT(3),TXT(5))=" "
+2 SET TXT(1)="This patch checked the EAS MT Letter File (713.3)"
+3 SET TXT(2)="for the existence of entries for 20 and 40 day letters."
+4 IF ZCNT
DO SOME
+5 IF 'ZCNT
DO NONE
+6 DO BMES^XPDUTL(.TXT)
+7 QUIT
SOME ;
+1 IF ZCNT=1
SET TXT(4)="One entry was removed. The process is complete."
QUIT
+2 SET TXT(4)=ZCNT_" entries were removed. The process is complete."
+3 QUIT
NONE ;
+1 SET TXT(4)="No such entries were found. No action was necessary."
+2 QUIT
+3 ;
EA58 SET X="EAS*1.0*58 Invalid Entries in EAS MT Letter File"
QUIT
