SDES880P ;ALB/MGD,BWF - SD*5.3*880 Post Init Routine ; Apr 03, 2024
;;5.3;SCHEDULING;**880**;AUG 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
EN ; Update the VS GUI version in #409.98
D TASK
D FIND
Q
TASK ;
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*880 Post-Install to add missing MES subscript")
D MES^XPDUTL(" to the cancelled times in the HOSPITAL LOCATION (#44))")
D MES^XPDUTL(" file is being queued to run in the background.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*880 Post Install Routine"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="FIXCAN^SDES880P",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
FIXCAN ;
N CLIN,CANDT,CANSTART,CANENDTIME,FDA,FDAIEN,FIXCNT
K ^XTMP("SDES880P")
S ^XTMP("SDES880P",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^880 Post Install Data Repair"
S (CLIN,FIXCNT)=0 F S CLIN=$O(^SC(CLIN)) Q:'CLIN D
.S CANDT=3211201 F S CANDT=$O(^SC(CLIN,"SDCAN",CANDT)) Q:'CANDT D
..I $D(^SC(CLIN,"S",CANDT,"MES")) Q
..S CANSTART=$$GET1^DIQ(44.05,CANDT_","_CLIN_",",.01)
..S CANENDTIME=$$GET1^DIQ(44.05,CANDT_","_CLIN_",",1)
..I $$ACTIVEAPPTS(CLIN,CANDT,CANENDTIME) Q
..S FIXCNT=FIXCNT+1
..S ^XTMP("SDES880P",FIXCNT,"BEFORE","MES")=CLIN_U_CANDT_U_$$GET1^DIQ(44.001,CANDT_","_CLIN_",",1400,"E")
..I $D(^SC(CLIN,"S",CANDT)) D Q
...S FDA(44.001,CANDT_","_CLIN_",",1400)="CANCELLED UNTIL "_CANENDTIME_" (SCHEDULING PATCH 880 CLEANUP)"
...D FILE^DIE(,"FDA") K FDA
...S ^XTMP("SDES880P",FIXCNT,"AFTER","MES")=CLIN_U_CANDT_U_$$GET1^DIQ(44.001,CANDT_","_CLIN_",",1400,"E")
..S FDA(44.001,"+1,"_CLIN_",",.01)=CANDT
..S FDA(44.001,"+1,"_CLIN_",",1400)="CANCELLED UNTIL "_CANENDTIME_" (SCHEDULING PATCH 880 CLEANUP)"
..S FDAIEN(1)=CANDT
..D UPDATE^DIE(,"FDA","FDAIEN") K FDAIEN,FDA
..S ^XTMP("SDES880P",FIXCNT,"AFTER","MES")=CLIN_U_CANDT_U_$$GET1^DIQ(44.001,CANDT_","_CLIN_",",1400,"E")
Q
; try to find active appointments on the cancelled date
ACTIVEAPPTS(CLIN,CANSTART,CANENDTIME) ;
N APPTDATE,RECCNT,APPTENDDATE,APPTIEN
S RECCNT=0
S APPTDATE=CANSTART-.0001
S APPTENDDATE=$P(CANSTART,".")_"."_CANENDTIME
F S APPTDATE=$O(^SC(CLIN,"S",APPTDATE)) Q:'APPTDATE!(APPTDATE=APPTENDDATE)!(APPTDATE>APPTENDDATE) D
.S APPTIEN=0 F S APPTIEN=$O(^SC(CLIN,"S",APPTDATE,1,APPTIEN)) Q:'APPTIEN D
..I $$GET1^DIQ(44.003,APPTIEN_","_APPTDATE_","_CLIN_",",310,"I")="C" Q
..S RECCNT=RECCNT+1
Q RECCNT
;
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.57
S DA=SDECDA,DIE=409.98,DR="2///1.7.57;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.57;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES880P 3472 printed Oct 16, 2024@18:55:51 Page 2
SDES880P ;ALB/MGD,BWF - SD*5.3*880 Post Init Routine ; Apr 03, 2024
+1 ;;5.3;SCHEDULING;**880**;AUG 13, 1993;Build 5
+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 TASK
+2 DO FIND
+3 QUIT
TASK ;
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*880 Post-Install to add missing MES subscript")
+3 DO MES^XPDUTL(" to the cancelled times in the HOSPITAL LOCATION (#44))")
+4 DO MES^XPDUTL(" file 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*880 Post Install Routine"
+8 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="FIXCAN^SDES880P"
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
FIXCAN ;
+1 NEW CLIN,CANDT,CANSTART,CANENDTIME,FDA,FDAIEN,FIXCNT
+2 KILL ^XTMP("SDES880P")
+3 SET ^XTMP("SDES880P",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^880 Post Install Data Repair"
+4 SET (CLIN,FIXCNT)=0
FOR
SET CLIN=$ORDER(^SC(CLIN))
if 'CLIN
QUIT
Begin DoDot:1
+5 SET CANDT=3211201
FOR
SET CANDT=$ORDER(^SC(CLIN,"SDCAN",CANDT))
if 'CANDT
QUIT
Begin DoDot:2
+6 IF $DATA(^SC(CLIN,"S",CANDT,"MES"))
QUIT
+7 SET CANSTART=$$GET1^DIQ(44.05,CANDT_","_CLIN_",",.01)
+8 SET CANENDTIME=$$GET1^DIQ(44.05,CANDT_","_CLIN_",",1)
+9 IF $$ACTIVEAPPTS(CLIN,CANDT,CANENDTIME)
QUIT
+10 SET FIXCNT=FIXCNT+1
+11 SET ^XTMP("SDES880P",FIXCNT,"BEFORE","MES")=CLIN_U_CANDT_U_$$GET1^DIQ(44.001,CANDT_","_CLIN_",",1400,"E")
+12 IF $DATA(^SC(CLIN,"S",CANDT))
Begin DoDot:3
+13 SET FDA(44.001,CANDT_","_CLIN_",",1400)="CANCELLED UNTIL "_CANENDTIME_" (SCHEDULING PATCH 880 CLEANUP)"
+14 DO FILE^DIE(,"FDA")
KILL FDA
+15 SET ^XTMP("SDES880P",FIXCNT,"AFTER","MES")=CLIN_U_CANDT_U_$$GET1^DIQ(44.001,CANDT_","_CLIN_",",1400,"E")
End DoDot:3
QUIT
+16 SET FDA(44.001,"+1,"_CLIN_",",.01)=CANDT
+17 SET FDA(44.001,"+1,"_CLIN_",",1400)="CANCELLED UNTIL "_CANENDTIME_" (SCHEDULING PATCH 880 CLEANUP)"
+18 SET FDAIEN(1)=CANDT
+19 DO UPDATE^DIE(,"FDA","FDAIEN")
KILL FDAIEN,FDA
+20 SET ^XTMP("SDES880P",FIXCNT,"AFTER","MES")=CLIN_U_CANDT_U_$$GET1^DIQ(44.001,CANDT_","_CLIN_",",1400,"E")
End DoDot:2
End DoDot:1
+21 QUIT
+22 ; try to find active appointments on the cancelled date
ACTIVEAPPTS(CLIN,CANSTART,CANENDTIME) ;
+1 NEW APPTDATE,RECCNT,APPTENDDATE,APPTIEN
+2 SET RECCNT=0
+3 SET APPTDATE=CANSTART-.0001
+4 SET APPTENDDATE=$PIECE(CANSTART,".")_"."_CANENDTIME
+5 FOR
SET APPTDATE=$ORDER(^SC(CLIN,"S",APPTDATE))
if 'APPTDATE!(APPTDATE=APPTENDDATE)!(APPTDATE>APPTENDDATE)
QUIT
Begin DoDot:1
+6 SET APPTIEN=0
FOR
SET APPTIEN=$ORDER(^SC(CLIN,"S",APPTDATE,1,APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:2
+7 IF $$GET1^DIQ(44.003,APPTIEN_","_APPTDATE_","_CLIN_",",310,"I")="C"
QUIT
+8 SET RECCNT=RECCNT+1
End DoDot:2
End DoDot:1
+9 QUIT RECCNT
+10 ;
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.57
+1 ;update VS GUI NATIONAL
SET DA=SDECDA
SET DIE=409.98
SET DR="2///1.7.57;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.57;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
