SDES895P ;ALB/TJB,MGD - SD*5.3*895 Post Init Routine ; OCT 31, 2024
;;5.3;SCHEDULING;**895**;AUG 13, 1993;Build 11
;;Per VHA Directive 6402, this routine should not be modified
;;
Q
;
EN ; Update the VS GUI version in #409.98
D FIND
D TASK
D TASK2
D TASK3
Q
;
;
FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
N SDECDA,SDECDA1
D MES^XPDUTL("")
D MES^XPDUTL(" Updating SDEC SETTINGS file (#409.98)")
S SDECDA=0,SDECDA=$O(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA)) G:$G(SDECDA)="" NOFIND
D VERSION ;update GUI version number and date
Q
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.62
S DA=SDECDA,DIE=409.98,DR="2///1.7.62;3///"_DT D ^DIE ;update VS GUI NATIONAL
K DIE,DR,DA
S SDECDA1=0,SDECDA1=$O(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1)) Q:$G(SDECDA1)="" ;get DA for the VS GUI LOCAL
S DA=SDECDA1,DIE=409.98,DR="2///1.7.62;3///"_DT D ^DIE ;update VS GUI LOCAL
K DIE,DR,DA
Q
;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
D MES^XPDUTL(" VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
Q
;
;
TASK ;
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*895 Post-Install to remove INACTIVE PREFRENCE field (#1)")
D MES^XPDUTL(" in the SDEC PREFERENCES AND SPECIAL NEEDS file (#409.845)")
D MES^XPDUTL(" is being queued to run in the background.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*895 Post Install Routine"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CLEAN409845^SDES895P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
CLEAN409845 ;
;Post install to remove any SNAPs in 409.8451 that are inactive
N CIEN,SUB,SDMSG,SDFDA
S CIEN=0
F S CIEN=$O(^SDEC(409.845,CIEN)) Q:'+CIEN D
. S SUB=0
. F S SUB=$O(^SDEC(409.845,CIEN,1,SUB)) Q:'+SUB D
.. N INACT
.. S INACT=$$GET1^DIQ(409.8451,SUB_","_CIEN_",",4,"I")
.. ; Delete the inactive record
.. I INACT'="" S SDFDA=$NA(SDFDA(409.8451,SUB_","_CIEN_",")),@SDFDA@(.01)="@" D UPDATE^DIE("","SDFDA","","SDMSG")
Q
;
TASK2 ;
K ^XTMP("SDES895P")
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*895 Post-Install to correct the spelling of CANCELLED on days with")
D MES^XPDUTL(" full day cancellations (#44.005) in the HOSPITAL LOCATION file (#44) is")
D MES^XPDUTL(" being queued to run in the background.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*895 Post Install Routine"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CANCELCLEANUP^SDES895P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
CANCELCLEANUP ;
N CLINICIEN,DATE,FDA,PATTERN,CANCELMESSAGE,COUNT
;
S CLINICIEN=0,COUNT=0
F S CLINICIEN=$O(^SC(CLINICIEN)) Q:'CLINICIEN D
.S DATE=$$GETSUB^SDES2UTIL(DT)
.F S DATE=$O(^SC(CLINICIEN,"ST",DATE)) Q:'DATE D
..I '$D(^SC(CLINICIEN,"ST",DATE,"CAN")) Q
..;
..S CANCELMESSAGE=" "_$E($P(DATE,"."),6,7)_" **CANCELLED**"
..S PATTERN=$$GET1^DIQ(44.005,DATE_","_CLINICIEN_",",1)
..;
..I PATTERN["[" Q
..I PATTERN=CANCELMESSAGE Q
..;
..S FDA(44.005,DATE_","_CLINICIEN_",",1)=CANCELMESSAGE
..D FILE^DIE(,"FDA") K FDA
..S COUNT=COUNT+1
;
S ^XTMP("SDES895P",1)=""
S ^XTMP("SDES895P",2)="A total of "_COUNT_" records were corrected"
S ^XTMP("SDES895P",3)=""
S ^XTMP("SDES895P",4)="SDES895P post install has run to completion."
D MAIL
Q
;
MAIL ;
; Get Station Number
;
N STANUM,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM
S STANUM=$$KSP^XUPARAM("INST")_","
S STANUM=$$GET1^DIQ(4,STANUM,99)
S MESS1="Station: "_STANUM_" - "
;
; Send MailMan message
S XMDUZ=DUZ
S XMY(XMDUZ)=""
S XMTEXT="^XTMP(""SDES895P"","
S XMSUB=MESS1_"SD*5.3*895 post install for Cancellation Data Cleanup"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
D ^XMD
Q
;
TASK3 ;
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*895 Post-Install to populate new comment auditing multiples in the")
D MES^XPDUTL(" RECALL REMINDERS file (#403.5) and the RECALL REMINDERS REMOVED file (#403.56)")
D MES^XPDUTL(" is being queued to run in the background.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*895 Post Install Routine"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="COMMCONV^SDES895P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
COMMCONV ; Save existing Comment data into the new Comment Audit mults
;
N RRREMIEN,RECREQIEN,COMMENTS,FDA
S RECREQIEN=0
F S RECREQIEN=$O(^SD(403.5,RECREQIEN)) Q:'RECREQIEN I $D(^SD(403.5,RECREQIEN,0)) D
. S COMMENTS=$$GET1^DIQ(403.5,RECREQIEN,2.5,"E") I $L(COMMENTS) D
. . Q:$D(^SD(403.5,RECREQIEN,2))
. . S FDA(403.57,"+1,"_RECREQIEN_",",.01)=$$GET1^DIQ(403.5,RECREQIEN,7.5,"I")
. . S FDA(403.57,"+1,"_RECREQIEN_",",1)=$$GET1^DIQ(403.5,RECREQIEN,7,"I")
. . S FDA(403.57,"+1,"_RECREQIEN_",",2)=COMMENTS
. . D UPDATE^DIE("","FDA") K FDA
;
S RRREMIEN=0
F S RRREMIEN=$O(^SD(403.56,RRREMIEN)) Q:'RRREMIEN I $D(^SD(403.56,RRREMIEN,0)) D
. S COMMENTS=$$GET1^DIQ(403.56,RRREMIEN,2.5,"E") I $L(COMMENTS) D
. . Q:$D(^SD(403.56,RRREMIEN,4))
. . S FDA(403.58,"+1,"_RRREMIEN_",",.01)=$$GET1^DIQ(403.56,RRREMIEN,7.5,"I")
. . S FDA(403.58,"+1,"_RRREMIEN_",",1)=$$GET1^DIQ(403.56,RRREMIEN,7,"I")
. . S FDA(403.58,"+1,"_RRREMIEN_",",2)=COMMENTS
. . D UPDATE^DIE("","FDA") K FDA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES895P 5917 printed Aug 26, 2025@23:11:57 Page 2
SDES895P ;ALB/TJB,MGD - SD*5.3*895 Post Init Routine ; OCT 31, 2024
+1 ;;5.3;SCHEDULING;**895**;AUG 13, 1993;Build 11
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;;
+4 QUIT
+5 ;
EN ; Update the VS GUI version in #409.98
+1 DO FIND
+2 DO TASK
+3 DO TASK2
+4 DO TASK3
+5 QUIT
+6 ;
+7 ;
FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
+1 NEW SDECDA,SDECDA1
+2 DO MES^XPDUTL("")
+3 DO MES^XPDUTL(" Updating SDEC SETTINGS file (#409.98)")
+4 SET SDECDA=0
SET SDECDA=$ORDER(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA))
if $GET(SDECDA)=""
GOTO NOFIND
+5 ;update GUI version number and date
DO VERSION
+6 QUIT
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.62
+1 ;update VS GUI NATIONAL
SET DA=SDECDA
SET DIE=409.98
SET DR="2///1.7.62;3///"_DT
DO ^DIE
+2 KILL DIE,DR,DA
+3 ;get DA for the VS GUI LOCAL
SET SDECDA1=0
SET SDECDA1=$ORDER(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1))
if $GET(SDECDA1)=""
QUIT
+4 ;update VS GUI LOCAL
SET DA=SDECDA1
SET DIE=409.98
SET DR="2///1.7.62;3///"_DT
DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT
+7 ;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
+1 DO MES^XPDUTL(" VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
+2 QUIT
+3 ;
+4 ;
TASK ;
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*895 Post-Install to remove INACTIVE PREFRENCE field (#1)")
+3 DO MES^XPDUTL(" in the SDEC PREFERENCES AND SPECIAL NEEDS file (#409.845)")
+4 DO MES^XPDUTL(" is being queued to run in the background.")
+5 DO MES^XPDUTL("")
+6 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+7 SET ZTDESC="SD*5.3*895 Post Install Routine"
+8 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="CLEAN409845^SDES895P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+9 IF $DATA(ZTSK)
Begin DoDot:1
+10 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+11 DO MES^XPDUTL("")
End DoDot:1
+12 IF '$DATA(ZTSK)
Begin DoDot:1
+13 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+14 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+15 QUIT
+16 ;
CLEAN409845 ;
+1 ;Post install to remove any SNAPs in 409.8451 that are inactive
+2 NEW CIEN,SUB,SDMSG,SDFDA
+3 SET CIEN=0
+4 FOR
SET CIEN=$ORDER(^SDEC(409.845,CIEN))
if '+CIEN
QUIT
Begin DoDot:1
+5 SET SUB=0
+6 FOR
SET SUB=$ORDER(^SDEC(409.845,CIEN,1,SUB))
if '+SUB
QUIT
Begin DoDot:2
+7 NEW INACT
+8 SET INACT=$$GET1^DIQ(409.8451,SUB_","_CIEN_",",4,"I")
+9 ; Delete the inactive record
+10 IF INACT'=""
SET SDFDA=$NAME(SDFDA(409.8451,SUB_","_CIEN_","))
SET @SDFDA@(.01)="@"
DO UPDATE^DIE("","SDFDA","","SDMSG")
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
TASK2 ;
+1 KILL ^XTMP("SDES895P")
+2 DO MES^XPDUTL("")
+3 DO MES^XPDUTL(" SD*5.3*895 Post-Install to correct the spelling of CANCELLED on days with")
+4 DO MES^XPDUTL(" full day cancellations (#44.005) in the HOSPITAL LOCATION file (#44) is")
+5 DO MES^XPDUTL(" being queued to run in the background.")
+6 DO MES^XPDUTL("")
+7 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+8 SET ZTDESC="SD*5.3*895 Post Install Routine"
+9 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="CANCELCLEANUP^SDES895P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+10 IF $DATA(ZTSK)
Begin DoDot:1
+11 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+12 DO MES^XPDUTL("")
End DoDot:1
+13 IF '$DATA(ZTSK)
Begin DoDot:1
+14 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+15 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+16 QUIT
+17 ;
CANCELCLEANUP ;
+1 NEW CLINICIEN,DATE,FDA,PATTERN,CANCELMESSAGE,COUNT
+2 ;
+3 SET CLINICIEN=0
SET COUNT=0
+4 FOR
SET CLINICIEN=$ORDER(^SC(CLINICIEN))
if 'CLINICIEN
QUIT
Begin DoDot:1
+5 SET DATE=$$GETSUB^SDES2UTIL(DT)
+6 FOR
SET DATE=$ORDER(^SC(CLINICIEN,"ST",DATE))
if 'DATE
QUIT
Begin DoDot:2
+7 IF '$DATA(^SC(CLINICIEN,"ST",DATE,"CAN"))
QUIT
+8 ;
+9 SET CANCELMESSAGE=" "_$EXTRACT($PIECE(DATE,"."),6,7)_" **CANCELLED**"
+10 SET PATTERN=$$GET1^DIQ(44.005,DATE_","_CLINICIEN_",",1)
+11 ;
+12 IF PATTERN["["
QUIT
+13 IF PATTERN=CANCELMESSAGE
QUIT
+14 ;
+15 SET FDA(44.005,DATE_","_CLINICIEN_",",1)=CANCELMESSAGE
+16 DO FILE^DIE(,"FDA")
KILL FDA
+17 SET COUNT=COUNT+1
End DoDot:2
End DoDot:1
+18 ;
+19 SET ^XTMP("SDES895P",1)=""
+20 SET ^XTMP("SDES895P",2)="A total of "_COUNT_" records were corrected"
+21 SET ^XTMP("SDES895P",3)=""
+22 SET ^XTMP("SDES895P",4)="SDES895P post install has run to completion."
+23 DO MAIL
+24 QUIT
+25 ;
MAIL ;
+1 ; Get Station Number
+2 ;
+3 NEW STANUM,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM
+4 SET STANUM=$$KSP^XUPARAM("INST")_","
+5 SET STANUM=$$GET1^DIQ(4,STANUM,99)
+6 SET MESS1="Station: "_STANUM_" - "
+7 ;
+8 ; Send MailMan message
+9 SET XMDUZ=DUZ
+10 SET XMY(XMDUZ)=""
+11 SET XMTEXT="^XTMP(""SDES895P"","
+12 SET XMSUB=MESS1_"SD*5.3*895 post install for Cancellation Data Cleanup"
+13 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+14 DO ^XMD
+15 QUIT
+16 ;
TASK3 ;
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*895 Post-Install to populate new comment auditing multiples in the")
+3 DO MES^XPDUTL(" RECALL REMINDERS file (#403.5) and the RECALL REMINDERS REMOVED file (#403.56)")
+4 DO MES^XPDUTL(" is being queued to run in the background.")
+5 DO MES^XPDUTL("")
+6 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+7 SET ZTDESC="SD*5.3*895 Post Install Routine"
+8 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="COMMCONV^SDES895P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+9 IF $DATA(ZTSK)
Begin DoDot:1
+10 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+11 DO MES^XPDUTL("")
End DoDot:1
+12 IF '$DATA(ZTSK)
Begin DoDot:1
+13 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+14 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+15 QUIT
+16 ;
COMMCONV ; Save existing Comment data into the new Comment Audit mults
+1 ;
+2 NEW RRREMIEN,RECREQIEN,COMMENTS,FDA
+3 SET RECREQIEN=0
+4 FOR
SET RECREQIEN=$ORDER(^SD(403.5,RECREQIEN))
if 'RECREQIEN
QUIT
IF $DATA(^SD(403.5,RECREQIEN,0))
Begin DoDot:1
+5 SET COMMENTS=$$GET1^DIQ(403.5,RECREQIEN,2.5,"E")
IF $LENGTH(COMMENTS)
Begin DoDot:2
+6 if $DATA(^SD(403.5,RECREQIEN,2))
QUIT
+7 SET FDA(403.57,"+1,"_RECREQIEN_",",.01)=$$GET1^DIQ(403.5,RECREQIEN,7.5,"I")
+8 SET FDA(403.57,"+1,"_RECREQIEN_",",1)=$$GET1^DIQ(403.5,RECREQIEN,7,"I")
+9 SET FDA(403.57,"+1,"_RECREQIEN_",",2)=COMMENTS
+10 DO UPDATE^DIE("","FDA")
KILL FDA
End DoDot:2
End DoDot:1
+11 ;
+12 SET RRREMIEN=0
+13 FOR
SET RRREMIEN=$ORDER(^SD(403.56,RRREMIEN))
if 'RRREMIEN
QUIT
IF $DATA(^SD(403.56,RRREMIEN,0))
Begin DoDot:1
+14 SET COMMENTS=$$GET1^DIQ(403.56,RRREMIEN,2.5,"E")
IF $LENGTH(COMMENTS)
Begin DoDot:2
+15 if $DATA(^SD(403.56,RRREMIEN,4))
QUIT
+16 SET FDA(403.58,"+1,"_RRREMIEN_",",.01)=$$GET1^DIQ(403.56,RRREMIEN,7.5,"I")
+17 SET FDA(403.58,"+1,"_RRREMIEN_",",1)=$$GET1^DIQ(403.56,RRREMIEN,7,"I")
+18 SET FDA(403.58,"+1,"_RRREMIEN_",",2)=COMMENTS
+19 DO UPDATE^DIE("","FDA")
KILL FDA
End DoDot:2
End DoDot:1
+20 QUIT
