EAS155P1 ;;ALB/SCK - MT LETTERS BAD POINTERS CLEAN UP ;07/22/2004
;;1.0;ENROLLMENT APPLICATION SYSTEM;**55**;MAR 15,2001
;
; This routine was initally run as the post-install for patch EAS*1*55
; Running this routine from programmer mode will initiate another
; reporting cycle. You should not run this routine unless advised
; by customer support.
Q
;
EN ; Entry point from programmer mode
N MSG,XCNT,DIR,X,Y,DIRUT
;
F XCNT=1:1 S LINE=$P($T(TEXT+XCNT),";;",2) Q:LINE="$$END" S MSG(XCNT)=LINE
W @IOF
S XCNT=0 F S XCNT=$O(MSG(XCNT)) Q:'XCNT W !?3,MSG(XCNT)
W !
I '$$CHKPREV Q
;
S DIR(0)="Y",DIR("B")="YES",DIR("A")="Continue with scan"
S DIR("?")="Press ENTER to continue, enter ""NO"" to exit."
D ^DIR K DIR
I Y D QUE Q
W !?3,"Exiting scan..."
Q
;
QUE ;
K ZTRTN,ZTDESC,ZTSAVE
S ZTRTN="BLD^EAS155P1"
S ZTDESC="EAS MT LTR BAD PTR SCAN"
S ZTSAVE("DUZ")=""
S ZTIO=""
D ^%ZTLOAD
I $D(ZTSK)[0 D
. W:'$G(EASQ) !!?3,"Scan canceled"
E D
. I $G(EASQ) D BMES^XPDUTL("Scan Queued: "_ZTSK)
. E W !!?3,"Scan Queued: "_ZTSK
Q
;
BLD ; Entry point scan and cleanup. Do not call directly, call from the EN entry point.
D SCAN,CLNUP,ALERT
S ^XTMP("EASBADPTRS",0,"END")=$H
Q
;
POST ; Post Install entry point. This entry point is intended to be called from the KIDS build.
N MSG,XCNT,EASQ
;
F XCNT=1:1 S LINE=$P($T(TEXT+XCNT),";;",2) Q:LINE="$$END" D
. S MSG(XCNT)=LINE
D MES^XPDUTL(.MSG)
S EASQ=1 D QUE
Q
;
SCAN ; Begin scanning for any bad pointers in the MT Letter Files
N EAIEN
;
K ^XTMP("EASBADPTRS")
S ^XTMP("EASBADPTRS",0)=$$FMADD^XLFDT($$DT^XLFDT,30)_U_$$DT^XLFDT_U_"EAS MT LETTERS BAD POINTERS SCAN"
S ^XTMP("EASBADPTRS",0,"START")=$H,^XTMP("EASBADPTRS",0,"DUZ")=DUZ
S EAIEN=0
F S EAIEN=$O(^EAS(713.2,"AC",0,EAIEN)) Q:'EAIEN D
. I $$GET1^DIQ(713.2,EAIEN,2)']"" S ^XTMP("EASBADPTRS",EAIEN)=""
S ^XTMP("EASBADPTRS",0,"SCAN COMPLETE")=$H
Q
;
CLNUP ; Disable letters in MT Letter Status file with suspicious pointers
; Do not delete, but flag as "bad"
N EAIEN,EAFDA,ERR,DIE,DA,DR
;
S EAIEN=0
F S EAIEN=$O(^XTMP("EASBADPTRS",EAIEN)) Q:'EAIEN D
. S DIE="^EAS(713.2,",DA=EAIEN
. S DR="4///YES;5///TODAY;6////.5;7///LETTER DISABLED, BAD POINTERS?;9///NO;12///NO;18///NO"
. D ^DIE K DIE,DR,DA
;
S ^XTMP("EASBADPTRS",0,"CLEANUP COMPLETE")=$H
Q
;
ALERT ; Send an alert to user that the scan has completed.
K XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQDATA,XQAFLAG
;
S XQA(DUZ)="",XQAID="EAS",XQAROU="REPORT^EAS155P1"
S XQAMSG="EAS MT LTRs Bad Pointers Scan Complete, Print Report"
D SETUP^XQALERT
Q
;
REPORT ; Print Bad Pointers Report setup
K ZTSAVE S ZTSAVE("DUZ")=""
D EN^XUTMDEVQ("P^EAS155P1","Print EAS Bad Pointers Report",.ZTSAVE)
Q
;
P ; Print report
N LINE,EAIEN,PAGE,EAX,DFN
;
S (PAGE,EAIEN)=0
D HDR
F S EAIEN=$O(^XTMP("EASBADPTRS",EAIEN)) Q:'EAIEN D Q:$G(EASABRT)
. S LINE=""
. S LINE=$$SETSTR^VALM1(EAIEN,"",20,15)
. S EAX=$$GET1^DIQ(713.2,EAIEN,2,"I")
. S LINE=$$SETSTR^VALM1(EAX,LINE,40,15)
. S DFN=$$GET1^DIQ(713.1,EAX,.01,"I")
. S LINE=$$SETSTR^VALM1(DFN,LINE,60,15)
. W !,LINE
. I $Y+5>IOSL D Q:$G(EASABRT)
. . I $E(IOST,1,2)="C-" D Q:$G(EASABRT)
. . . S DIR(0)="E" D ^DIR K DIR
. . . I 'Y S EASABRT=1 Q
. . D HDR
Q
;
HDR ; PRINT REPORT HEADER
N LINE,DDASH,TEXT,TEXT1
;
S PAGE=PAGE+1
W:$E(IOST,1,2)="C-" @IOF
W "Results of Possible Bad Pointers Report for EAS MT Letters"
S TEXT="Date Scan Run: "_$$HTE^XLFDT(^XTMP("EASBADPTRS",0,"END"))
S TEXT1="Run by: "_$$GET1^DIQ(200,^XTMP("EASBADPTRS",0,"DUZ"),.01)
S SPACE=(IOM-($L(TEXT)+$L(TEXT1)))
S $P(LINE," ",SPACE-2)=""
W !,TEXT,LINE,TEXT1
;
S TEXT="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
S TEXT1="Page: "_PAGE
S SPACE=(IOM-($L(TEXT)+$L(TEXT1)))
S $P(LINE," ",SPACE-2)=""
W !,TEXT,LINE,TEXT1,!
;
S $P(DDASH,"=",IOM-10)=""
S LINE=$$SETSTR^VALM1("File IEN's","",5,12)
S LINE=$$SETSTR^VALM1("713.2",LINE,20,5)
S LINE=$$SETSTR^VALM1("713.1",LINE,40,5)
S LINE=$$SETSTR^VALM1("DFN",LINE,60,5)
W !,LINE
W !?5,DDASH
Q
;
CHKPREV() ; Check for a previous scan in XTMP
N RSLT,EASDUZ
;
S RSLT=1
I $D(^XTMP("EASBADPTRS")) D
. I '$D(^XTMP("EASBADPTRS",0,"END")) D
. . W !?3,$CHAR(7),"The EAS MT LTRs Bad Pointer scan is currently running."
. . S EASDUZ=$G(^XTMP("EASBADPTRS",0,"DUZ"))
. . I EASDUZ>0 W !?3,"started by ",$$GET1^DIQ(200,EASDUZ,.01)
. . I $D(^XTMP("EASBADPTRS",0,"START")) W " on ",$$HTE^XLFDT(^XTMP("EASBADPTRS",0,"START"))
. . S RSLT=0
. E D
. . W !?3,"Data from a previous scan exists. "
. . I $D(^XTMP("EASBADPTRS",0,"END")) W "Last Run: ",$$HTE^XLFDT(^XTMP("EASBADPTRS",0,"END"))
. . W !?3,"Answering ""YES"" will cause this data to be erased and a new"
. . W !?3,"scan started!",!
Q $G(RSLT)
;
TEXT ;
;;Running this routine will scan the EAS MT PATIENT STATUS File (#713.1)
;;and the EAS MT LETTER STATUS File (#713.2) for any bad pointers
;;linking to the PATIENT File (#2). This routine WILL NOT clean up
;;these pointers, but will flag the appropriate MT Letter entry as
;;'MT RETURNED' and enter a comment of 'Bad Pointer'. Your local
;;IRM may take additional cleanup actions.
;;
;;Data from this scan will be retained in the ^XTMP("EASBADPTRS")
;;global for 30 days. You may run REPORT^EAS155P1 at a programmer
;;prompt to re-print a formatted report. You will be alerted when the
;;scan is complete.
;;$$END
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS155P1 5512 printed Apr 09, 2024@20:59:53 Page 2
EAS155P1 ;;ALB/SCK - MT LETTERS BAD POINTERS CLEAN UP ;07/22/2004
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**55**;MAR 15,2001
+2 ;
+3 ; This routine was initally run as the post-install for patch EAS*1*55
+4 ; Running this routine from programmer mode will initiate another
+5 ; reporting cycle. You should not run this routine unless advised
+6 ; by customer support.
+7 QUIT
+8 ;
EN ; Entry point from programmer mode
+1 NEW MSG,XCNT,DIR,X,Y,DIRUT
+2 ;
+3 FOR XCNT=1:1
SET LINE=$PIECE($TEXT(TEXT+XCNT),";;",2)
if LINE="$$END"
QUIT
SET MSG(XCNT)=LINE
+4 WRITE @IOF
+5 SET XCNT=0
FOR
SET XCNT=$ORDER(MSG(XCNT))
if 'XCNT
QUIT
WRITE !?3,MSG(XCNT)
+6 WRITE !
+7 IF '$$CHKPREV
QUIT
+8 ;
+9 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Continue with scan"
+10 SET DIR("?")="Press ENTER to continue, enter ""NO"" to exit."
+11 DO ^DIR
KILL DIR
+12 IF Y
DO QUE
QUIT
+13 WRITE !?3,"Exiting scan..."
+14 QUIT
+15 ;
QUE ;
+1 KILL ZTRTN,ZTDESC,ZTSAVE
+2 SET ZTRTN="BLD^EAS155P1"
+3 SET ZTDESC="EAS MT LTR BAD PTR SCAN"
+4 SET ZTSAVE("DUZ")=""
+5 SET ZTIO=""
+6 DO ^%ZTLOAD
+7 IF $DATA(ZTSK)[0
Begin DoDot:1
+8 if '$GET(EASQ)
WRITE !!?3,"Scan canceled"
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 IF $GET(EASQ)
DO BMES^XPDUTL("Scan Queued: "_ZTSK)
+11 IF '$TEST
WRITE !!?3,"Scan Queued: "_ZTSK
End DoDot:1
+12 QUIT
+13 ;
BLD ; Entry point scan and cleanup. Do not call directly, call from the EN entry point.
+1 DO SCAN
DO CLNUP
DO ALERT
+2 SET ^XTMP("EASBADPTRS",0,"END")=$HOROLOG
+3 QUIT
+4 ;
POST ; Post Install entry point. This entry point is intended to be called from the KIDS build.
+1 NEW MSG,XCNT,EASQ
+2 ;
+3 FOR XCNT=1:1
SET LINE=$PIECE($TEXT(TEXT+XCNT),";;",2)
if LINE="$$END"
QUIT
Begin DoDot:1
+4 SET MSG(XCNT)=LINE
End DoDot:1
+5 DO MES^XPDUTL(.MSG)
+6 SET EASQ=1
DO QUE
+7 QUIT
+8 ;
SCAN ; Begin scanning for any bad pointers in the MT Letter Files
+1 NEW EAIEN
+2 ;
+3 KILL ^XTMP("EASBADPTRS")
+4 SET ^XTMP("EASBADPTRS",0)=$$FMADD^XLFDT($$DT^XLFDT,30)_U_$$DT^XLFDT_U_"EAS MT LETTERS BAD POINTERS SCAN"
+5 SET ^XTMP("EASBADPTRS",0,"START")=$HOROLOG
SET ^XTMP("EASBADPTRS",0,"DUZ")=DUZ
+6 SET EAIEN=0
+7 FOR
SET EAIEN=$ORDER(^EAS(713.2,"AC",0,EAIEN))
if 'EAIEN
QUIT
Begin DoDot:1
+8 IF $$GET1^DIQ(713.2,EAIEN,2)']""
SET ^XTMP("EASBADPTRS",EAIEN)=""
End DoDot:1
+9 SET ^XTMP("EASBADPTRS",0,"SCAN COMPLETE")=$HOROLOG
+10 QUIT
+11 ;
CLNUP ; Disable letters in MT Letter Status file with suspicious pointers
+1 ; Do not delete, but flag as "bad"
+2 NEW EAIEN,EAFDA,ERR,DIE,DA,DR
+3 ;
+4 SET EAIEN=0
+5 FOR
SET EAIEN=$ORDER(^XTMP("EASBADPTRS",EAIEN))
if 'EAIEN
QUIT
Begin DoDot:1
+6 SET DIE="^EAS(713.2,"
SET DA=EAIEN
+7 SET DR="4///YES;5///TODAY;6////.5;7///LETTER DISABLED, BAD POINTERS?;9///NO;12///NO;18///NO"
+8 DO ^DIE
KILL DIE,DR,DA
End DoDot:1
+9 ;
+10 SET ^XTMP("EASBADPTRS",0,"CLEANUP COMPLETE")=$HOROLOG
+11 QUIT
+12 ;
ALERT ; Send an alert to user that the scan has completed.
+1 KILL XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQDATA,XQAFLAG
+2 ;
+3 SET XQA(DUZ)=""
SET XQAID="EAS"
SET XQAROU="REPORT^EAS155P1"
+4 SET XQAMSG="EAS MT LTRs Bad Pointers Scan Complete, Print Report"
+5 DO SETUP^XQALERT
+6 QUIT
+7 ;
REPORT ; Print Bad Pointers Report setup
+1 KILL ZTSAVE
SET ZTSAVE("DUZ")=""
+2 DO EN^XUTMDEVQ("P^EAS155P1","Print EAS Bad Pointers Report",.ZTSAVE)
+3 QUIT
+4 ;
P ; Print report
+1 NEW LINE,EAIEN,PAGE,EAX,DFN
+2 ;
+3 SET (PAGE,EAIEN)=0
+4 DO HDR
+5 FOR
SET EAIEN=$ORDER(^XTMP("EASBADPTRS",EAIEN))
if 'EAIEN
QUIT
Begin DoDot:1
+6 SET LINE=""
+7 SET LINE=$$SETSTR^VALM1(EAIEN,"",20,15)
+8 SET EAX=$$GET1^DIQ(713.2,EAIEN,2,"I")
+9 SET LINE=$$SETSTR^VALM1(EAX,LINE,40,15)
+10 SET DFN=$$GET1^DIQ(713.1,EAX,.01,"I")
+11 SET LINE=$$SETSTR^VALM1(DFN,LINE,60,15)
+12 WRITE !,LINE
+13 IF $Y+5>IOSL
Begin DoDot:2
+14 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:3
+15 SET DIR(0)="E"
DO ^DIR
KILL DIR
+16 IF 'Y
SET EASABRT=1
QUIT
End DoDot:3
if $GET(EASABRT)
QUIT
+17 DO HDR
End DoDot:2
if $GET(EASABRT)
QUIT
End DoDot:1
if $GET(EASABRT)
QUIT
+18 QUIT
+19 ;
HDR ; PRINT REPORT HEADER
+1 NEW LINE,DDASH,TEXT,TEXT1
+2 ;
+3 SET PAGE=PAGE+1
+4 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+5 WRITE "Results of Possible Bad Pointers Report for EAS MT Letters"
+6 SET TEXT="Date Scan Run: "_$$HTE^XLFDT(^XTMP("EASBADPTRS",0,"END"))
+7 SET TEXT1="Run by: "_$$GET1^DIQ(200,^XTMP("EASBADPTRS",0,"DUZ"),.01)
+8 SET SPACE=(IOM-($LENGTH(TEXT)+$LENGTH(TEXT1)))
+9 SET $PIECE(LINE," ",SPACE-2)=""
+10 WRITE !,TEXT,LINE,TEXT1
+11 ;
+12 SET TEXT="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
+13 SET TEXT1="Page: "_PAGE
+14 SET SPACE=(IOM-($LENGTH(TEXT)+$LENGTH(TEXT1)))
+15 SET $PIECE(LINE," ",SPACE-2)=""
+16 WRITE !,TEXT,LINE,TEXT1,!
+17 ;
+18 SET $PIECE(DDASH,"=",IOM-10)=""
+19 SET LINE=$$SETSTR^VALM1("File IEN's","",5,12)
+20 SET LINE=$$SETSTR^VALM1("713.2",LINE,20,5)
+21 SET LINE=$$SETSTR^VALM1("713.1",LINE,40,5)
+22 SET LINE=$$SETSTR^VALM1("DFN",LINE,60,5)
+23 WRITE !,LINE
+24 WRITE !?5,DDASH
+25 QUIT
+26 ;
CHKPREV() ; Check for a previous scan in XTMP
+1 NEW RSLT,EASDUZ
+2 ;
+3 SET RSLT=1
+4 IF $DATA(^XTMP("EASBADPTRS"))
Begin DoDot:1
+5 IF '$DATA(^XTMP("EASBADPTRS",0,"END"))
Begin DoDot:2
+6 WRITE !?3,$CHAR(7),"The EAS MT LTRs Bad Pointer scan is currently running."
+7 SET EASDUZ=$GET(^XTMP("EASBADPTRS",0,"DUZ"))
+8 IF EASDUZ>0
WRITE !?3,"started by ",$$GET1^DIQ(200,EASDUZ,.01)
+9 IF $DATA(^XTMP("EASBADPTRS",0,"START"))
WRITE " on ",$$HTE^XLFDT(^XTMP("EASBADPTRS",0,"START"))
+10 SET RSLT=0
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 WRITE !?3,"Data from a previous scan exists. "
+13 IF $DATA(^XTMP("EASBADPTRS",0,"END"))
WRITE "Last Run: ",$$HTE^XLFDT(^XTMP("EASBADPTRS",0,"END"))
+14 WRITE !?3,"Answering ""YES"" will cause this data to be erased and a new"
+15 WRITE !?3,"scan started!",!
End DoDot:2
End DoDot:1
+16 QUIT $GET(RSLT)
+17 ;
TEXT ;
+1 ;;Running this routine will scan the EAS MT PATIENT STATUS File (#713.1)
+2 ;;and the EAS MT LETTER STATUS File (#713.2) for any bad pointers
+3 ;;linking to the PATIENT File (#2). This routine WILL NOT clean up
+4 ;;these pointers, but will flag the appropriate MT Letter entry as
+5 ;;'MT RETURNED' and enter a comment of 'Bad Pointer'. Your local
+6 ;;IRM may take additional cleanup actions.
+7 ;;
+8 ;;Data from this scan will be retained in the ^XTMP("EASBADPTRS")
+9 ;;global for 30 days. You may run REPORT^EAS155P1 at a programmer
+10 ;;prompt to re-print a formatted report. You will be alerted when the
+11 ;;scan is complete.
+12 ;;$$END
+13 QUIT
