EAS155P1.m

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 ---EAS155P1   5512     printed  Mar 13, 2025@20:58:10                                                                                                                                                                                                    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