EAS122PT ; ALB/SCK - POST INSTALL CLEANUP PATCH EAS*1*22 ; 12/13/2002
;;1.0;ENROLLMENT APPLICATION SYSTEM;**22**;MAR 15,2001
;
QUE ; Queued entry point for post install processing
N ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTIO
;
S ZTRTN="EN^EAS122PT"
S ZTDESC="PATCH EAS*1*22 POST INSTALL"
S XMDUZ="EAS MT LETTERS"
S ZTSAVE("DUZ")=""
S ZTIO=""
;
D ^%ZTLOAD
I $D(ZTSK)'>0 D BMES^XPDUTL("Post-Install was not tasked off")
E D BMES^XPDUTL("Post-Install tasked: ["_$G(ZTSK)_"]")
D HOME^%ZIS
Q
;
EN ; Main entry point for post install processing
K ^TMP("EAS22",$J),^TMP("EAS22A",$J)
D POST
D MAIL1
D MAIL2
K ^TMP("EAS22",$J),^TMP("EAS22A",$J)
Q
;
POST ; Process files and generate cleanup list
N DGIEN,DIK,DA,CNT,DFN,VA,EASMTDT
;
; Process EAS MT LETTER STATUS File, (#713.2)
S DGIEN=0
F S DGIEN=$O(^EAS(713.2,"C",-1,DGIEN)) Q:'DGIEN D
. S ^TMP("EAS22",$J,DGIEN)=$P($G(^EAS(713.2,DGIEN,0)),U,1)
. I $D(^EAS(713.2,DGIEN)) D ; if data entry exists, delete it
. . S DIK="^EAS(713.2,",DA=DGIEN
. . D ^DIK
. E D ; if no data entry, only xref, kill off the xref
. . K ^EAS(713.2,"C",-1,DGIEN)
;
I $$S^%ZTLOAD D Q ; Check for stop request
. S ^TMP("EAS22",$J,0)="STOP"
;
POST2 ;Process EAS MT PATIENT STATUS File (#713.1)
S DGIEN=0,CNT=1
F S DGIEN=$O(^EAS(713.1,DGIEN)) Q:'DGIEN D Q:$D(^TMP("EAS22",$J,0))
. S CNT=CNT+1 I (CNT#100)=0,$$S^ZTLOAD D Q ; Check for stop request
. . S ^TMP("EAS22",$J,0)="STOP"
. Q:$D(^EAS(713.1,"AP",1,DGIEN))
. I '$D(^EAS(713.2,"C",DGIEN)) D
. . S DFN=$P($G(^EAS(713.1,DGIEN,0)),U,1)
. . D PID^VADPT
. . S EASMTDT=$$LST^DGMTU(DFN)
. . I +EASMTDT>0 S EASMTDT=$$FMTE^XLFDT($P(EASMTDT,U,2))
. . I DFN>0 S ^TMP("EAS22A",$J,DGIEN)=$$GET1^DIQ(2,DFN,.01)_" ("_VA("BID")_")"_" "_EASMTDT
Q
;
MAIL1 ; Generate mail message with number of removed entries
N XMY,XMSUB,XMTEXT,XMDUZ,MSG,DGIEN,DGDT,DGPRCDT,X
;
S XMSUB="Post Install - EAS*1*22"
S XMY("G.EAS MTLETTERS")=""
S XMY("DUZ")=""
S XMDUZ="PATCH EAS-1-22"
;
S DGIEN=0
F S DGIEN=$O(^TMP("EAS22",$J,DGIEN)) Q:'DGIEN D
. Q:^TMP("EAS22",$J,DGIEN)'>0 ; Check for valid date value for DGRPCDT
. S DGPRCDT(^TMP("EAS22",$J,DGIEN))=$G(DGPRCDT(^TMP("EAS22",$J,DGIEN)))+1
;
S MSG(.1)="Entries were removed from the EAS MT LETTER STATUS File (#713.2)"
S MSG(.2)="which did not have a valid pointer to the EAS MT PATIENT STATUS"
S MSG(.3)="File (#713.1). The entries removed were for the processing dates"
S MSG(.4)="listed below. This is provided as information only."
S MSG(.5)=""
S X=$$SETSTR^VALM1("Date Processed","",5,18)
S X=$$SETSTR^VALM1("Records Removed",X,25,18)
S MSG(.6)=X
S DGDT=0
F S DGDT=$O(DGPRCDT(DGDT)) Q:'DGDT D
. S X=$$SETSTR^VALM1($$FMTE^XLFDT(DGDT,"2D"),"",5,18)
. S X=$$SETSTR^VALM1(+$G(DGPRCDT(DGDT)),X,25,18)
. S MSG(DGDT)=X
S XMTEXT="MSG("
D ^XMD
Q
;
MAIL2 ; Generate file cross-check message on patient names
N XMY,XMSUB,XMTEXT,XMDUZ,MSG,DGIEN,DGDT
;
S XMSUB="Post Install - EAS*1*22"
S XMY("G.EAS MTLETTERS")=""
S XMY("DUZ")=""
S XMDUZ="PATCH EAS-1-22"
;
S ^TMP("EAS22A",$J,.1)="The following patients in the EAS MT PATIENT STATUS File (#713.1)"
S ^TMP("EAS22A",$J,.2)="do not have a corresponding entry in the EAS MT LETTER STATUS File (#713.2)."
S ^TMP("EAS22A",$J,.3)="You can try re-generating the Means Test Letter dates for these"
S ^TMP("EAS22A",$J,.4)="patients by running the REGEN procedure from the post-install"
S ^TMP("EAS22A",$J,.5)="routine by entering 'D REGEN^EAS122PT' at the programmer prompt."
S ^TMP("EAS22A",$J,.6)="See the Patch Instructions for more details."
S ^TMP("EAS22A",$J,.7)=""
S XMTEXT="^TMP(""EAS22A"",$J,"
D ^XMD
Q
;
REGEN ;
N DGIEN,MTLST,MTDT,DFN,CNT,EASDT,EADT,DIR,Y
;
S DIR(0)="YAO",DIR("B")="NO"
S DIR("A",1)="Re-generate Means Test Letter Dates for patients"
S DIR("A")="identified in patch EAS*1*22 cleanup? "
D ^DIR K DIR
Q:'Y
;
K ^TMP("EAS22A",$J)
D POST2
;
S EADT=$$DT^XLFDT
S DGIEN=0
F S DGIEN=$O(^TMP("EAS22A",$J,DGIEN)) Q:'DGIEN D
. S DFN=$P($G(^EAS(713.1,DGIEN,0)),U,1)
. S MTLST=$$LST^DGMTU(DFN)
. S MTDT=$P(MTLST,U,2)
. Q:'$G(MTDT)
. S EASDT("ANV")=$$FMADD^XLFDT(MTDT)
. S EASDT("60")=$$FMADD^XLFDT(EASDT("ANV"),305)
. S EASDT("30")=$$FMADD^XLFDT(EASDT("ANV"),335)
. S EASDT("0")=$$FMADD^XLFDT(EASDT("ANV"),365)
. I $$NEWLTR^EASMTL2(DGIEN,.EASDT)
K ^TMP("EAS22A",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS122PT 4459 printed Dec 13, 2024@01:53:23 Page 2
EAS122PT ; ALB/SCK - POST INSTALL CLEANUP PATCH EAS*1*22 ; 12/13/2002
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**22**;MAR 15,2001
+2 ;
QUE ; Queued entry point for post install processing
+1 NEW ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTIO
+2 ;
+3 SET ZTRTN="EN^EAS122PT"
+4 SET ZTDESC="PATCH EAS*1*22 POST INSTALL"
+5 SET XMDUZ="EAS MT LETTERS"
+6 SET ZTSAVE("DUZ")=""
+7 SET ZTIO=""
+8 ;
+9 DO ^%ZTLOAD
+10 IF $DATA(ZTSK)'>0
DO BMES^XPDUTL("Post-Install was not tasked off")
+11 IF '$TEST
DO BMES^XPDUTL("Post-Install tasked: ["_$GET(ZTSK)_"]")
+12 DO HOME^%ZIS
+13 QUIT
+14 ;
EN ; Main entry point for post install processing
+1 KILL ^TMP("EAS22",$JOB),^TMP("EAS22A",$JOB)
+2 DO POST
+3 DO MAIL1
+4 DO MAIL2
+5 KILL ^TMP("EAS22",$JOB),^TMP("EAS22A",$JOB)
+6 QUIT
+7 ;
POST ; Process files and generate cleanup list
+1 NEW DGIEN,DIK,DA,CNT,DFN,VA,EASMTDT
+2 ;
+3 ; Process EAS MT LETTER STATUS File, (#713.2)
+4 SET DGIEN=0
+5 FOR
SET DGIEN=$ORDER(^EAS(713.2,"C",-1,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+6 SET ^TMP("EAS22",$JOB,DGIEN)=$PIECE($GET(^EAS(713.2,DGIEN,0)),U,1)
+7 ; if data entry exists, delete it
IF $DATA(^EAS(713.2,DGIEN))
Begin DoDot:2
+8 SET DIK="^EAS(713.2,"
SET DA=DGIEN
+9 DO ^DIK
End DoDot:2
+10 ; if no data entry, only xref, kill off the xref
IF '$TEST
Begin DoDot:2
+11 KILL ^EAS(713.2,"C",-1,DGIEN)
End DoDot:2
End DoDot:1
+12 ;
+13 ; Check for stop request
IF $$S^%ZTLOAD
Begin DoDot:1
+14 SET ^TMP("EAS22",$JOB,0)="STOP"
End DoDot:1
QUIT
+15 ;
POST2 ;Process EAS MT PATIENT STATUS File (#713.1)
+1 SET DGIEN=0
SET CNT=1
+2 FOR
SET DGIEN=$ORDER(^EAS(713.1,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+3 ; Check for stop request
SET CNT=CNT+1
IF (CNT#100)=0
IF $$S^ZTLOAD
Begin DoDot:2
+4 SET ^TMP("EAS22",$JOB,0)="STOP"
End DoDot:2
QUIT
+5 if $DATA(^EAS(713.1,"AP",1,DGIEN))
QUIT
+6 IF '$DATA(^EAS(713.2,"C",DGIEN))
Begin DoDot:2
+7 SET DFN=$PIECE($GET(^EAS(713.1,DGIEN,0)),U,1)
+8 DO PID^VADPT
+9 SET EASMTDT=$$LST^DGMTU(DFN)
+10 IF +EASMTDT>0
SET EASMTDT=$$FMTE^XLFDT($PIECE(EASMTDT,U,2))
+11 IF DFN>0
SET ^TMP("EAS22A",$JOB,DGIEN)=$$GET1^DIQ(2,DFN,.01)_" ("_VA("BID")_")"_" "_EASMTDT
End DoDot:2
End DoDot:1
if $DATA(^TMP("EAS22",$JOB,0))
QUIT
+12 QUIT
+13 ;
MAIL1 ; Generate mail message with number of removed entries
+1 NEW XMY,XMSUB,XMTEXT,XMDUZ,MSG,DGIEN,DGDT,DGPRCDT,X
+2 ;
+3 SET XMSUB="Post Install - EAS*1*22"
+4 SET XMY("G.EAS MTLETTERS")=""
+5 SET XMY("DUZ")=""
+6 SET XMDUZ="PATCH EAS-1-22"
+7 ;
+8 SET DGIEN=0
+9 FOR
SET DGIEN=$ORDER(^TMP("EAS22",$JOB,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+10 ; Check for valid date value for DGRPCDT
if ^TMP("EAS22",$JOB,DGIEN)'>0
QUIT
+11 SET DGPRCDT(^TMP("EAS22",$JOB,DGIEN))=$GET(DGPRCDT(^TMP("EAS22",$JOB,DGIEN)))+1
End DoDot:1
+12 ;
+13 SET MSG(.1)="Entries were removed from the EAS MT LETTER STATUS File (#713.2)"
+14 SET MSG(.2)="which did not have a valid pointer to the EAS MT PATIENT STATUS"
+15 SET MSG(.3)="File (#713.1). The entries removed were for the processing dates"
+16 SET MSG(.4)="listed below. This is provided as information only."
+17 SET MSG(.5)=""
+18 SET X=$$SETSTR^VALM1("Date Processed","",5,18)
+19 SET X=$$SETSTR^VALM1("Records Removed",X,25,18)
+20 SET MSG(.6)=X
+21 SET DGDT=0
+22 FOR
SET DGDT=$ORDER(DGPRCDT(DGDT))
if 'DGDT
QUIT
Begin DoDot:1
+23 SET X=$$SETSTR^VALM1($$FMTE^XLFDT(DGDT,"2D"),"",5,18)
+24 SET X=$$SETSTR^VALM1(+$GET(DGPRCDT(DGDT)),X,25,18)
+25 SET MSG(DGDT)=X
End DoDot:1
+26 SET XMTEXT="MSG("
+27 DO ^XMD
+28 QUIT
+29 ;
MAIL2 ; Generate file cross-check message on patient names
+1 NEW XMY,XMSUB,XMTEXT,XMDUZ,MSG,DGIEN,DGDT
+2 ;
+3 SET XMSUB="Post Install - EAS*1*22"
+4 SET XMY("G.EAS MTLETTERS")=""
+5 SET XMY("DUZ")=""
+6 SET XMDUZ="PATCH EAS-1-22"
+7 ;
+8 SET ^TMP("EAS22A",$JOB,.1)="The following patients in the EAS MT PATIENT STATUS File (#713.1)"
+9 SET ^TMP("EAS22A",$JOB,.2)="do not have a corresponding entry in the EAS MT LETTER STATUS File (#713.2)."
+10 SET ^TMP("EAS22A",$JOB,.3)="You can try re-generating the Means Test Letter dates for these"
+11 SET ^TMP("EAS22A",$JOB,.4)="patients by running the REGEN procedure from the post-install"
+12 SET ^TMP("EAS22A",$JOB,.5)="routine by entering 'D REGEN^EAS122PT' at the programmer prompt."
+13 SET ^TMP("EAS22A",$JOB,.6)="See the Patch Instructions for more details."
+14 SET ^TMP("EAS22A",$JOB,.7)=""
+15 SET XMTEXT="^TMP(""EAS22A"",$J,"
+16 DO ^XMD
+17 QUIT
+18 ;
REGEN ;
+1 NEW DGIEN,MTLST,MTDT,DFN,CNT,EASDT,EADT,DIR,Y
+2 ;
+3 SET DIR(0)="YAO"
SET DIR("B")="NO"
+4 SET DIR("A",1)="Re-generate Means Test Letter Dates for patients"
+5 SET DIR("A")="identified in patch EAS*1*22 cleanup? "
+6 DO ^DIR
KILL DIR
+7 if 'Y
QUIT
+8 ;
+9 KILL ^TMP("EAS22A",$JOB)
+10 DO POST2
+11 ;
+12 SET EADT=$$DT^XLFDT
+13 SET DGIEN=0
+14 FOR
SET DGIEN=$ORDER(^TMP("EAS22A",$JOB,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+15 SET DFN=$PIECE($GET(^EAS(713.1,DGIEN,0)),U,1)
+16 SET MTLST=$$LST^DGMTU(DFN)
+17 SET MTDT=$PIECE(MTLST,U,2)
+18 if '$GET(MTDT)
QUIT
+19 SET EASDT("ANV")=$$FMADD^XLFDT(MTDT)
+20 SET EASDT("60")=$$FMADD^XLFDT(EASDT("ANV"),305)
+21 SET EASDT("30")=$$FMADD^XLFDT(EASDT("ANV"),335)
+22 SET EASDT("0")=$$FMADD^XLFDT(EASDT("ANV"),365)
+23 IF $$NEWLTR^EASMTL2(DGIEN,.EASDT)
End DoDot:1
+24 KILL ^TMP("EAS22A",$JOB)
+25 QUIT
