SDEC826P ;ALB/MGD/DJS - SD*5.3*826 Post Init Routine ; Oct 17, 2022
;;5.3;SCHEDULING;**826**;AUG 13, 1993;Build 18
;;Per VHA Directive 6402, this routine should not be modified
;
D FIND,RA,TASK
Q
;
FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
N SDECDA,SDECDA1
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.32
S DA=SDECDA,DIE=409.98,DR="2///1.7.32;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.32;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
;
RA ; Update Remote Application Entry
N ARY,MSG
D MSG("Beginning update of Remote Application Entry.")
D MSG("")
N IEN
S IEN=$$FIND1^DIC(8994.5,"","X","ENTERPRISE APPOINTMENT SERVICE","B","","ERROR")
I 'IEN D RAMSG Q
S ARY(8994.5,IEN_",",.03)="Gb03w41EsF0EQkvaVOftqh4FBIHQADuCjZ0zdwQwZE0=" ; New
;S ARY(8994.5,IEN_",",.03)="I3u6b0H0Rc3Qk5CV5GoGqnQ+6Gi6uF6pzyN9q7foKA4=" ; Old
D UPDATE^DIE("","ARY","","MSG")
I $D(MSG) D RAMSG Q
D MSG("Remote Application Entry successfully updated.")
D MSG("")
Q
;
RAMSG ;
D MSG("Remote Application Entry was not updated.")
D MSG("Please contact the National Help Desk to report this issue.")
D MSG("")
Q
;
TASK ;
D MSG("SD*5.3*826 Post-Install to fix incorrect check-in dates")
D MSG("in the SDEC APPOINTMENT (#409.84) file")
D MSG("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*826 Post Install Routine"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="VPS^SDEC826P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MSG(">>>Task "_ZTSK_" has been queued.")
. D MSG("")
I '$D(ZTSK) D
. D MSG("UNABLE TO QUEUE THIS JOB.")
. D MSG("Please contact the National Help Desk to report this issue.")
Q
;
MSG(SDMES) ;
D BMES^XPDUTL(SDMES)
Q
;
; CORRECT CHECK-IN TIME IN SDES APPOINTMENT FILE (#409.84)
VPS ;
N APTDT,APTIEN,RESOURCE,HOSPLOC,DFN,HLAPPT,HLCHKIN,STOPDT,NOCHECKIN,APPTCHK,UPDAPPT,INSTLIEN,DTIENS,STATUS
S ^XTMP("SDEC826P",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"Logging of repaired check-in times."
S ^XTMP("SDEC826P","VPS","CNT")=0
S STOPDT=$$NOW^XLFDT
S INSTLIEN="",INSTLIEN=$O(^XPD(9.7,"B","VPS*1.0*21",INSTLIEN))
I INSTLIEN="" Q
S DTIENS=INSTLIEN_","
S STATUS=$$GET1^DIQ(9.7,DTIENS,.02)
I STATUS'="Install Completed" Q
S APTDT=$$GET1^DIQ(9.7,DTIENS,17,"I")
S APTDT=$E(APTDT,1,7)
S (NOCHECKIN,UPDAPPT)=0
F S APTDT=$O(^SDEC(409.84,"B",APTDT)) Q:'APTDT!(APTDT>STOPDT) D
.S APTIEN=0 F S APTIEN=$O(^SDEC(409.84,"B",APTDT,APTIEN)) Q:APTIEN="" D
..; B index exists, but there is no data at the IEN.
..Q:'$D(^SDEC(409.84,APTIEN))
..; If cancelled, do not process
..I $P($G(^SDEC(409.84,APTIEN,0)),U,12) Q
..; quit if no-show
..I $P($G(^SDEC(409.84,APTIEN,0)),U,10) Q
..; quit if Walk-in
..I $P($G(^SDEC(409.84,APTIEN,0)),U,13)="y" Q
..I $P($G(^SDEC(409.84,APTIEN,0)),U,3)="" S NOCHECKIN=1 ;Appt. has not been checked in
..S APPTCHK=$P($G(^SDEC(409.84,APTIEN,0)),U,3)
..I $P($G(^SDEC(409.84,APTIEN,0)),U,1)=APPTCHK!(APPTCHK="") S UPDAPPT=1 D ;ApptCheckin=ApptStartTime
...S RESOURCE=$P(^SDEC(409.84,APTIEN,0),U,7) Q:'RESOURCE
...Q:'$D(^SDEC(409.831,RESOURCE))
...S HOSPLOC=$P(^SDEC(409.831,RESOURCE,0),U,4)
...S DFN=$P(^SDEC(409.84,APTIEN,0),U,5)
...S HLAPPT=0,HLCHKIN=""
...F S HLAPPT=$O(^SC(HOSPLOC,"S",APTDT,1,HLAPPT)) Q:'HLAPPT D
....; quit if not the same patient
....I $P($G(^SC(HOSPLOC,"S",APTDT,1,HLAPPT,0)),U)'=DFN Q
....; quit if the appointment was cancelled
....I $P($G(^SC(HOSPLOC,"S",APTDT,1,HLAPPT,0)),U,9)]"" Q
....; quit if there is no check-in
....I $D(^SC(HOSPLOC,"S",APTDT,1,HLAPPT,"C")) S HLCHKIN=$P($G(^SC(HOSPLOC,"S",APTDT,1,HLAPPT,"C")),U) Q:HLCHKIN=""&NOCHECKIN Q:HLCHKIN="" D
.....; check if appt. checked in & if it matches Hospital Location file
.....I $G(UPDAPPT),APPTCHK=HLCHKIN Q ;no update needed
.....I ($G(UPDAPPT)&(APPTCHK'=HLCHKIN))!(HLCHKIN'=""&NOCHECKIN) D
......S ^XTMP("SDEC826P","VPS",APTIEN,"BEFORE","CHECK-IN")=$P($G(^SDEC(409.84,APTIEN,0)),U,3)
......S ^XTMP("SDEC826P","VPS",APTIEN,"BEFORE","CHECK-IN ENTERED")=$P($G(^SDEC(409.84,APTIEN,0)),U,4)
......S $P(^SDEC(409.84,APTIEN,0),U,3)=HLCHKIN
......S $P(^SDEC(409.84,APTIEN,0),U,4)=HLCHKIN
......S ^XTMP("SDEC826P",APTIEN)=HLCHKIN
......S ^XTMP("SDEC826P","VPS",APTIEN,"AFTER","CHECK-IN")=$P($G(^SDEC(409.84,APTIEN,0)),U,3)
......S ^XTMP("SDEC826P","VPS",APTIEN,"AFTER","CHECK-IN ENTERED")=$P($G(^SDEC(409.84,APTIEN,0)),U,4)
......S ^XTMP("SDEC826P","VPS",APTIEN,"SOURCE")=HLCHKIN
......S ^XTMP("SDEC826P","VPS","CNT")=$G(^XTMP("SDEC826P","VPS","CNT"))+1
......S NOCHECKIN=0
D MAIL
Q
MAIL ;
; Get Station Number
;
N STANUM,MESS1,XMTEXT,TEXT,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 XMTEXT="TEXT("
S TEXT(1)="The SD*5.3*826 post install has run to completion."
S TEXT(2)="The data was reviewed and updated without any issues."
S XMSUB=MESS1_"SD*5.3*826 - Post Install Update"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC826P 5569 printed Dec 13, 2024@02:51:34 Page 2
SDEC826P ;ALB/MGD/DJS - SD*5.3*826 Post Init Routine ; Oct 17, 2022
+1 ;;5.3;SCHEDULING;**826**;AUG 13, 1993;Build 18
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 DO FIND
DO RA
DO TASK
+5 QUIT
+6 ;
FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
+1 NEW SDECDA,SDECDA1
+2 DO MES^XPDUTL("Updating SDEC SETTINGS file (#409.98)")
+3 SET SDECDA=0
SET SDECDA=$ORDER(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA))
if $GET(SDECDA)=""
GOTO NOFIND
+4 ;update GUI version number and date
DO VERSION
+5 QUIT
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.32
+1 ;update VS GUI NATIONAL
SET DA=SDECDA
SET DIE=409.98
SET DR="2///1.7.32;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.32;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 ;
RA ; Update Remote Application Entry
+1 NEW ARY,MSG
+2 DO MSG("Beginning update of Remote Application Entry.")
+3 DO MSG("")
+4 NEW IEN
+5 SET IEN=$$FIND1^DIC(8994.5,"","X","ENTERPRISE APPOINTMENT SERVICE","B","","ERROR")
+6 IF 'IEN
DO RAMSG
QUIT
+7 ; New
SET ARY(8994.5,IEN_",",.03)="Gb03w41EsF0EQkvaVOftqh4FBIHQADuCjZ0zdwQwZE0="
+8 ;S ARY(8994.5,IEN_",",.03)="I3u6b0H0Rc3Qk5CV5GoGqnQ+6Gi6uF6pzyN9q7foKA4=" ; Old
+9 DO UPDATE^DIE("","ARY","","MSG")
+10 IF $DATA(MSG)
DO RAMSG
QUIT
+11 DO MSG("Remote Application Entry successfully updated.")
+12 DO MSG("")
+13 QUIT
+14 ;
RAMSG ;
+1 DO MSG("Remote Application Entry was not updated.")
+2 DO MSG("Please contact the National Help Desk to report this issue.")
+3 DO MSG("")
+4 QUIT
+5 ;
TASK ;
+1 DO MSG("SD*5.3*826 Post-Install to fix incorrect check-in dates")
+2 DO MSG("in the SDEC APPOINTMENT (#409.84) file")
+3 DO MSG("")
+4 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+5 SET ZTDESC="SD*5.3*826 Post Install Routine"
+6 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="VPS^SDEC826P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+7 IF $DATA(ZTSK)
Begin DoDot:1
+8 DO MSG(">>>Task "_ZTSK_" has been queued.")
+9 DO MSG("")
End DoDot:1
+10 IF '$DATA(ZTSK)
Begin DoDot:1
+11 DO MSG("UNABLE TO QUEUE THIS JOB.")
+12 DO MSG("Please contact the National Help Desk to report this issue.")
End DoDot:1
+13 QUIT
+14 ;
MSG(SDMES) ;
+1 DO BMES^XPDUTL(SDMES)
+2 QUIT
+3 ;
+4 ; CORRECT CHECK-IN TIME IN SDES APPOINTMENT FILE (#409.84)
VPS ;
+1 NEW APTDT,APTIEN,RESOURCE,HOSPLOC,DFN,HLAPPT,HLCHKIN,STOPDT,NOCHECKIN,APPTCHK,UPDAPPT,INSTLIEN,DTIENS,STATUS
+2 SET ^XTMP("SDEC826P",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"Logging of repaired check-in times."
+3 SET ^XTMP("SDEC826P","VPS","CNT")=0
+4 SET STOPDT=$$NOW^XLFDT
+5 SET INSTLIEN=""
SET INSTLIEN=$ORDER(^XPD(9.7,"B","VPS*1.0*21",INSTLIEN))
+6 IF INSTLIEN=""
QUIT
+7 SET DTIENS=INSTLIEN_","
+8 SET STATUS=$$GET1^DIQ(9.7,DTIENS,.02)
+9 IF STATUS'="Install Completed"
QUIT
+10 SET APTDT=$$GET1^DIQ(9.7,DTIENS,17,"I")
+11 SET APTDT=$EXTRACT(APTDT,1,7)
+12 SET (NOCHECKIN,UPDAPPT)=0
+13 FOR
SET APTDT=$ORDER(^SDEC(409.84,"B",APTDT))
if 'APTDT!(APTDT>STOPDT)
QUIT
Begin DoDot:1
+14 SET APTIEN=0
FOR
SET APTIEN=$ORDER(^SDEC(409.84,"B",APTDT,APTIEN))
if APTIEN=""
QUIT
Begin DoDot:2
+15 ; B index exists, but there is no data at the IEN.
+16 if '$DATA(^SDEC(409.84,APTIEN))
QUIT
+17 ; If cancelled, do not process
+18 IF $PIECE($GET(^SDEC(409.84,APTIEN,0)),U,12)
QUIT
+19 ; quit if no-show
+20 IF $PIECE($GET(^SDEC(409.84,APTIEN,0)),U,10)
QUIT
+21 ; quit if Walk-in
+22 IF $PIECE($GET(^SDEC(409.84,APTIEN,0)),U,13)="y"
QUIT
+23 ;Appt. has not been checked in
IF $PIECE($GET(^SDEC(409.84,APTIEN,0)),U,3)=""
SET NOCHECKIN=1
+24 SET APPTCHK=$PIECE($GET(^SDEC(409.84,APTIEN,0)),U,3)
+25 ;ApptCheckin=ApptStartTime
IF $PIECE($GET(^SDEC(409.84,APTIEN,0)),U,1)=APPTCHK!(APPTCHK="")
SET UPDAPPT=1
Begin DoDot:3
+26 SET RESOURCE=$PIECE(^SDEC(409.84,APTIEN,0),U,7)
if 'RESOURCE
QUIT
+27 if '$DATA(^SDEC(409.831,RESOURCE))
QUIT
+28 SET HOSPLOC=$PIECE(^SDEC(409.831,RESOURCE,0),U,4)
+29 SET DFN=$PIECE(^SDEC(409.84,APTIEN,0),U,5)
+30 SET HLAPPT=0
SET HLCHKIN=""
+31 FOR
SET HLAPPT=$ORDER(^SC(HOSPLOC,"S",APTDT,1,HLAPPT))
if 'HLAPPT
QUIT
Begin DoDot:4
+32 ; quit if not the same patient
+33 IF $PIECE($GET(^SC(HOSPLOC,"S",APTDT,1,HLAPPT,0)),U)'=DFN
QUIT
+34 ; quit if the appointment was cancelled
+35 IF $PIECE($GET(^SC(HOSPLOC,"S",APTDT,1,HLAPPT,0)),U,9)]""
QUIT
+36 ; quit if there is no check-in
+37 IF $DATA(^SC(HOSPLOC,"S",APTDT,1,HLAPPT,"C"))
SET HLCHKIN=$PIECE($GET(^SC(HOSPLOC,"S",APTDT,1,HLAPPT,"C")),U)
if HLCHKIN=""&NOCHECKIN
QUIT
if HLCHKIN=""
QUIT
Begin DoDot:5
+38 ; check if appt. checked in & if it matches Hospital Location file
+39 ;no update needed
IF $GET(UPDAPPT)
IF APPTCHK=HLCHKIN
QUIT
+40 IF ($GET(UPDAPPT)&(APPTCHK'=HLCHKIN))!(HLCHKIN'=""&NOCHECKIN)
Begin DoDot:6
+41 SET ^XTMP("SDEC826P","VPS",APTIEN,"BEFORE","CHECK-IN")=$PIECE($GET(^SDEC(409.84,APTIEN,0)),U,3)
+42 SET ^XTMP("SDEC826P","VPS",APTIEN,"BEFORE","CHECK-IN ENTERED")=$PIECE($GET(^SDEC(409.84,APTIEN,0)),U,4)
+43 SET $PIECE(^SDEC(409.84,APTIEN,0),U,3)=HLCHKIN
+44 SET $PIECE(^SDEC(409.84,APTIEN,0),U,4)=HLCHKIN
+45 SET ^XTMP("SDEC826P",APTIEN)=HLCHKIN
+46 SET ^XTMP("SDEC826P","VPS",APTIEN,"AFTER","CHECK-IN")=$PIECE($GET(^SDEC(409.84,APTIEN,0)),U,3)
+47 SET ^XTMP("SDEC826P","VPS",APTIEN,"AFTER","CHECK-IN ENTERED")=$PIECE($GET(^SDEC(409.84,APTIEN,0)),U,4)
+48 SET ^XTMP("SDEC826P","VPS",APTIEN,"SOURCE")=HLCHKIN
+49 SET ^XTMP("SDEC826P","VPS","CNT")=$GET(^XTMP("SDEC826P","VPS","CNT"))+1
+50 SET NOCHECKIN=0
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+51 DO MAIL
+52 QUIT
MAIL ;
+1 ; Get Station Number
+2 ;
+3 NEW STANUM,MESS1,XMTEXT,TEXT,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 XMTEXT="TEXT("
+11 SET TEXT(1)="The SD*5.3*826 post install has run to completion."
+12 SET TEXT(2)="The data was reviewed and updated without any issues."
+13 SET XMSUB=MESS1_"SD*5.3*826 - Post Install Update"
+14 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+15 DO ^XMD
+16 QUIT
