Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDEC826P

SDEC826P.m

Go to the documentation of this file. 
  1. SDEC826P ;ALB/MGD/DJS - SD*5.3*826 Post Init Routine ; Oct 17, 2022
  1.  ;;5.3;SCHEDULING;**826**;AUG 13, 1993;Build 18
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  D FIND,RA,TASK
  1.  Q
  1.  ;
  1. FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
  1.  N SDECDA,SDECDA1
  1.  D MES^XPDUTL("Updating SDEC SETTINGS file (#409.98)")
  1.  S SDECDA=0,SDECDA=$O(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA)) G:$G(SDECDA)="" NOFIND
  1.  D VERSION   ;update GUI version number and date
  1.  Q
  1. VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.32
  1.  S DA=SDECDA,DIE=409.98,DR="2///1.7.32;3///"_DT D ^DIE  ;update VS GUI NATIONAL
  1.  K DIE,DR,DA
  1.  S SDECDA1=0,SDECDA1=$O(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1)) Q:$G(SDECDA1)=""    ;get DA for the VS GUI LOCAL
  1.  S DA=SDECDA1,DIE=409.98,DR="2///1.7.32;3///"_DT D ^DIE  ;update VS GUI LOCAL
  1.  K DIE,DR,DA
  1.  Q
  1.  ;
  1. NOFIND ;"VS GUI NATIONAL" NOT FOUND
  1.  D MES^XPDUTL("VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
  1.  Q
  1.  ;
  1. RA ; Update Remote Application Entry
  1.  N ARY,MSG
  1.  D MSG("Beginning update of Remote Application Entry.")
  1.  D MSG("")
  1.  N IEN
  1.  S IEN=$$FIND1^DIC(8994.5,"","X","ENTERPRISE APPOINTMENT SERVICE","B","","ERROR")
  1.  I 'IEN D RAMSG Q
  1.  S ARY(8994.5,IEN_",",.03)="Gb03w41EsF0EQkvaVOftqh4FBIHQADuCjZ0zdwQwZE0=" ; New
  1.  ;S ARY(8994.5,IEN_",",.03)="I3u6b0H0Rc3Qk5CV5GoGqnQ+6Gi6uF6pzyN9q7foKA4=" ; Old
  1.  D UPDATE^DIE("","ARY","","MSG")
  1.  I $D(MSG) D RAMSG Q
  1.  D MSG("Remote Application Entry successfully updated.")
  1.  D MSG("")
  1.  Q
  1.  ;
  1. RAMSG ;
  1.  D MSG("Remote Application Entry was not updated.")
  1.  D MSG("Please contact the National Help Desk to report this issue.")
  1.  D MSG("")
  1.  Q
  1.  ;
  1. TASK ;
  1.  D MSG("SD*5.3*826 Post-Install to fix incorrect check-in dates")
  1.  D MSG("in the SDEC APPOINTMENT (#409.84) file")
  1.  D MSG("")
  1.  N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
  1.  S ZTDESC="SD*5.3*826 Post Install Routine"
  1.  D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="VPS^SDEC826P",ZTSAVE("*")="" D ^%ZTLOAD
  1.  I $D(ZTSK) D
  1.  . D MSG(">>>Task "_ZTSK_" has been queued.")
  1.  . D MSG("")
  1.  I '$D(ZTSK) D
  1.  . D MSG("UNABLE TO QUEUE THIS JOB.")
  1.  . D MSG("Please contact the National Help Desk to report this issue.")
  1.  Q
  1.  ;
  1. MSG(SDMES) ;
  1.  D BMES^XPDUTL(SDMES)
  1.  Q
  1.  ;
  1.  ; CORRECT CHECK-IN TIME IN SDES APPOINTMENT FILE (#409.84)
  1. VPS ;
  1.  N APTDT,APTIEN,RESOURCE,HOSPLOC,DFN,HLAPPT,HLCHKIN,STOPDT,NOCHECKIN,APPTCHK,UPDAPPT,INSTLIEN,DTIENS,STATUS
  1.  S ^XTMP("SDEC826P",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"Logging of repaired check-in times."
  1.  S ^XTMP("SDEC826P","VPS","CNT")=0
  1.  S STOPDT=$$NOW^XLFDT
  1.  S INSTLIEN="",INSTLIEN=$O(^XPD(9.7,"B","VPS*1.0*21",INSTLIEN))
  1.  I INSTLIEN="" Q
  1.  S DTIENS=INSTLIEN_","
  1.  S STATUS=$$GET1^DIQ(9.7,DTIENS,.02)
  1.  I STATUS'="Install Completed" Q
  1.  S APTDT=$$GET1^DIQ(9.7,DTIENS,17,"I")
  1.  S APTDT=$E(APTDT,1,7)
  1.  S (NOCHECKIN,UPDAPPT)=0
  1.  F  S APTDT=$O(^SDEC(409.84,"B",APTDT)) Q:'APTDT!(APTDT>STOPDT)  D
  1.  .S APTIEN=0 F  S APTIEN=$O(^SDEC(409.84,"B",APTDT,APTIEN)) Q:APTIEN=""  D
  1.  ..; B index exists, but there is no data at the IEN.
  1.  ..Q:'$D(^SDEC(409.84,APTIEN))
  1.  ..; If cancelled, do not process
  1.  ..I $P($G(^SDEC(409.84,APTIEN,0)),U,12) Q
  1.  ..; quit if no-show
  1.  ..I $P($G(^SDEC(409.84,APTIEN,0)),U,10) Q
  1.  ..; quit if Walk-in
  1.  ..I $P($G(^SDEC(409.84,APTIEN,0)),U,13)="y" Q
  1.  ..I $P($G(^SDEC(409.84,APTIEN,0)),U,3)="" S NOCHECKIN=1  ;Appt. has not been checked in
  1.  ..S APPTCHK=$P($G(^SDEC(409.84,APTIEN,0)),U,3)
  1.  ..I $P($G(^SDEC(409.84,APTIEN,0)),U,1)=APPTCHK!(APPTCHK="") S UPDAPPT=1 D  ;ApptCheckin=ApptStartTime
  1.  ...S RESOURCE=$P(^SDEC(409.84,APTIEN,0),U,7) Q:'RESOURCE
  1.  ...Q:'$D(^SDEC(409.831,RESOURCE))
  1.  ...S HOSPLOC=$P(^SDEC(409.831,RESOURCE,0),U,4)
  1.  ...S DFN=$P(^SDEC(409.84,APTIEN,0),U,5)
  1.  ...S HLAPPT=0,HLCHKIN=""
  1.  ...F  S HLAPPT=$O(^SC(HOSPLOC,"S",APTDT,1,HLAPPT)) Q:'HLAPPT  D
  1.  ....; quit if not the same patient
  1.  ....I $P($G(^SC(HOSPLOC,"S",APTDT,1,HLAPPT,0)),U)'=DFN Q
  1.  ....; quit if the appointment was cancelled
  1.  ....I $P($G(^SC(HOSPLOC,"S",APTDT,1,HLAPPT,0)),U,9)]"" Q
  1.  ....; quit if there is no check-in
  1.  ....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
  1.  .....; check if appt. checked in & if it matches Hospital Location file
  1.  .....I $G(UPDAPPT),APPTCHK=HLCHKIN Q  ;no update needed
  1.  .....I ($G(UPDAPPT)&(APPTCHK'=HLCHKIN))!(HLCHKIN'=""&NOCHECKIN) D
  1.  ......S ^XTMP("SDEC826P","VPS",APTIEN,"BEFORE","CHECK-IN")=$P($G(^SDEC(409.84,APTIEN,0)),U,3)
  1.  ......S ^XTMP("SDEC826P","VPS",APTIEN,"BEFORE","CHECK-IN ENTERED")=$P($G(^SDEC(409.84,APTIEN,0)),U,4)
  1.  ......S $P(^SDEC(409.84,APTIEN,0),U,3)=HLCHKIN
  1.  ......S $P(^SDEC(409.84,APTIEN,0),U,4)=HLCHKIN
  1.  ......S ^XTMP("SDEC826P",APTIEN)=HLCHKIN
  1.  ......S ^XTMP("SDEC826P","VPS",APTIEN,"AFTER","CHECK-IN")=$P($G(^SDEC(409.84,APTIEN,0)),U,3)
  1.  ......S ^XTMP("SDEC826P","VPS",APTIEN,"AFTER","CHECK-IN ENTERED")=$P($G(^SDEC(409.84,APTIEN,0)),U,4)
  1.  ......S ^XTMP("SDEC826P","VPS",APTIEN,"SOURCE")=HLCHKIN
  1.  ......S ^XTMP("SDEC826P","VPS","CNT")=$G(^XTMP("SDEC826P","VPS","CNT"))+1
  1.  ......S NOCHECKIN=0
  1.  D MAIL
  1.  Q
  1. MAIL ;
  1.  ; Get Station Number
  1.  ;
  1.  N STANUM,MESS1,XMTEXT,TEXT,XMSUB,XMY,XMDUZ,DIFROM
  1.  S STANUM=$$KSP^XUPARAM("INST")_","
  1.  S STANUM=$$GET1^DIQ(4,STANUM,99)
  1.  S MESS1="Station: "_STANUM_" - "
  1.  ;
  1.  ; Send MailMan message
  1.  S XMDUZ=DUZ
  1.  S XMTEXT="TEXT("
  1.  S TEXT(1)="The SD*5.3*826 post install has run to completion."
  1.  S TEXT(2)="The data was reviewed and updated without any issues."
  1.  S XMSUB=MESS1_"SD*5.3*826 - Post Install Update"
  1.  S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
  1.  D ^XMD
  1.  Q