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

SDES897P.m

Go to the documentation of this file. 
  1. SDES897P ;ALB/MGD,JAS - SD*5.3*897 Post Init Routine ; DEC 06, 2024
  1.  ;;5.3;SCHEDULING;**897**;AUG 13, 1993;Build 2
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;;
  1.  Q
  1.  ;
  1. EN ; Update the VS GUI version in #409.98
  1.  D FIND
  1.  D TASK
  1.  D TASK2
  1.  D TASK3
  1.  D TASK4
  1.  Q
  1.  ;
  1.  ;
  1. FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
  1.  N SDECDA,SDECDA1
  1.  D MES^XPDUTL("")
  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.63
  1.  S DA=SDECDA,DIE=409.98,DR="2///1.7.63;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.63;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. TASK ;
  1.  D MES^XPDUTL("")
  1.  D MES^XPDUTL("   SD*5.3*897 Post-Install to clear control characters from the CANCELLATION REMARKS")
  1.  D MES^XPDUTL("   (#17) field from the APPOINTMENT (#2.98) sub-file of the PATIENT (#2) file")
  1.  D MES^XPDUTL("   is being queued to run in the background.")
  1.  D MES^XPDUTL("")
  1.  N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
  1.  S ZTDESC="SD*5.3*897 Post Install Routine"
  1.  D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CLNREMRKS^SDES897P",ZTSAVE("*")="" D ^%ZTLOAD
  1.  I $D(ZTSK) D
  1.  . D MES^XPDUTL("  >>>Task "_ZTSK_" has been queued.")
  1.  . D MES^XPDUTL("")
  1.  I '$D(ZTSK) D
  1.  . D MES^XPDUTL("  UNABLE TO QUEUE THIS JOB.")
  1.  . D MES^XPDUTL("  Please contact the National Help Desk to report this issue.")
  1.  Q
  1.  ;
  1. CLNREMRKS ;
  1.  N APPTIEN,FDA,REM,SDDFN
  1.  S SDDFN=0
  1.  F  S SDDFN=$O(^DPT(SDDFN)) Q:'SDDFN  I $D(^DPT(SDDFN,"S")) D
  1.  . S APPTIEN=0
  1.  . F  S APPTIEN=$O(^DPT(SDDFN,"S",APPTIEN)) Q:'APPTIEN  D
  1.  . . S REM=$$GET1^DIQ(2.98,APPTIEN_","_SDDFN_",",17,"I")
  1.  . . I REM?.E1C.E D
  1.  . . . S REM=$$CTRL^XMXUTIL1(REM)
  1.  . . . S FDA(2.98,APPTIEN_","_SDDFN_",",17)=REM
  1.  . . . D FILE^DIE("","FDA") K FDA
  1.  Q
  1.  ;
  1. TASK2 ; tasks off process to remove control characters from Recall Reminders file
  1.  D MES^XPDUTL("")
  1.  D MES^XPDUTL("   SD*5.3*897 Post-Install to clear control characters from the COMMENT")
  1.  D MES^XPDUTL("   (#2.5) field from the RECALL REMINDERS (#403.5) file and its COMMENT")
  1.  D MES^XPDUTL("   AUDIT (#403.57) sub-file is being queued to run in the background.")
  1.  D MES^XPDUTL("")
  1.  N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
  1.  S ZTDESC="SD*5.3*897 Post Install Routine Task 2"
  1.  D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CLNRECREMS^SDES897P",ZTSAVE("*")="" D ^%ZTLOAD
  1.  I $D(ZTSK) D
  1.  . D MES^XPDUTL("  >>>Task "_ZTSK_" has been queued.")
  1.  . D MES^XPDUTL("")
  1.  I '$D(ZTSK) D
  1.  . D MES^XPDUTL("  UNABLE TO QUEUE THIS JOB.")
  1.  . D MES^XPDUTL("  Please contact the National Help Desk to report this issue.")
  1.  Q
  1.  ;
  1. CLNRECREMS ;
  1.  ;
  1.  N RECREQIEN,COMAUDIEN,COMMENT,COMMENTS,FDA
  1.  S RECREQIEN=0
  1.  F  S RECREQIEN=$O(^SD(403.5,RECREQIEN)) Q:'RECREQIEN  I $D(^SD(403.5,RECREQIEN,0)) D
  1.  . S COMMENTS=$$GET1^DIQ(403.5,RECREQIEN,2.5,"E") I COMMENTS?.E1C.E D
  1.  . . S COMMENTS=$$CTRL^XMXUTIL1(COMMENTS)
  1.  . . S FDA(403.5,RECREQIEN_",",2.5)=COMMENTS
  1.  . . D FILE^DIE("","FDA") K FDA
  1.  . . ;
  1.  . . S COMAUDIEN=0
  1.  . . F  S COMAUDIEN=$O(^SD(403.5,RECREQIEN,2,COMAUDIEN)) Q:'COMAUDIEN  D
  1.  . . . Q:'$D(^SD(403.5,RECREQIEN,2,COMAUDIEN,0))
  1.  . . . S COMMENT=$$GET1^DIQ(403.57,COMAUDIEN_","_RECREQIEN_",",2)
  1.  . . . I COMMENT?.E1C.E D
  1.  . . . . S FDA(403.57,COMAUDIEN_","_RECREQIEN_",",2)=$$CTRL^XMXUTIL1(COMMENT)
  1.  . . . . D FILE^DIE("","FDA") K FDA
  1.  Q
  1.  ;
  1. TASK3 ; tasks off process to remove control characters from SDEC Appt Request file
  1.  D MES^XPDUTL("")
  1.  D MES^XPDUTL("   SD*5.3*897 Post-Install to clear control characters from the COMMENTS")
  1.  D MES^XPDUTL("   (#25) field from the SDEC APPT REQUEST (#409.85) file and its COMMENTS")
  1.  D MES^XPDUTL("   AUDIT (#409.8527) sub-file is being queued to run in the background.")
  1.  D MES^XPDUTL("")
  1.  N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
  1.  S ZTDESC="SD*5.3*897 Post Install Routine Task 3"
  1.  D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CLNAPREQS^SDES897P",ZTSAVE("*")="" D ^%ZTLOAD
  1.  I $D(ZTSK) D
  1.  . D MES^XPDUTL("  >>>Task "_ZTSK_" has been queued.")
  1.  . D MES^XPDUTL("")
  1.  I '$D(ZTSK) D
  1.  . D MES^XPDUTL("  UNABLE TO QUEUE THIS JOB.")
  1.  . D MES^XPDUTL("  Please contact the National Help Desk to report this issue.")
  1.  Q
  1.  ;
  1. CLNAPREQS ;
  1.  ;
  1.  N APREQIEN,COMAUDIEN,COMMENT,COMMENTS,FDA
  1.  S APREQIEN=0
  1.  F  S APREQIEN=$O(^SDEC(409.85,APREQIEN)) Q:'APREQIEN  I $D(^SDEC(409.85,APREQIEN,0)) D
  1.  . Q:$$GET1^DIQ(409.85,APREQIEN,23,"I")="C"
  1.  . S COMMENTS=$$GET1^DIQ(409.85,APREQIEN,25,"E") I COMMENTS?.E1C.E D
  1.  . . S COMMENTS=$$CTRL^XMXUTIL1(COMMENTS)
  1.  . . S FDA(409.85,APREQIEN_",",25)=COMMENTS
  1.  . . D FILE^DIE("","FDA") K FDA
  1.  . . ;
  1.  . . S COMAUDIEN=0
  1.  . . F  S COMAUDIEN=$O(^SDEC(409.85,APREQIEN,"COMAUD",COMAUDIEN)) Q:'COMAUDIEN  D
  1.  . . . S COMMENT=$$GET1^DIQ(409.8527,COMAUDIEN_","_APREQIEN_",",2)
  1.  . . . I COMMENT?.E1C.E D
  1.  . . . . S FDA(409.8527,COMAUDIEN_","_APREQIEN_",",2)=$$CTRL^XMXUTIL1(COMMENT)
  1.  . . . . D FILE^DIE("","FDA") K FDA
  1.  Q
  1.  ;
  1. TASK4 ; tasks off process to remove control characters from SDEC Appointment file
  1.  D MES^XPDUTL("")
  1.  D MES^XPDUTL("   SD*5.3*897 Post-Install to clear control characters from the NOTE")
  1.  D MES^XPDUTL("   (#1) field from the SDEC APPOINTMENT (#409.84) file and its NOTE")
  1.  D MES^XPDUTL("   AUDIT (#409.847) sub-file is being queued to run in the background.")
  1.  D MES^XPDUTL("")
  1.  N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
  1.  S ZTDESC="SD*5.3*897 Post Install Routine Task 4"
  1.  D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CLNAPPTS^SDES897P",ZTSAVE("*")="" D ^%ZTLOAD
  1.  I $D(ZTSK) D
  1.  . D MES^XPDUTL("  >>>Task "_ZTSK_" has been queued.")
  1.  . D MES^XPDUTL("")
  1.  I '$D(ZTSK) D
  1.  . D MES^XPDUTL("  UNABLE TO QUEUE THIS JOB.")
  1.  . D MES^XPDUTL("  Please contact the National Help Desk to report this issue.")
  1.  Q
  1.  ;
  1. CLNAPPTS ;
  1.  ;
  1.  N APPTIEN,APREQIEN,COMAUDIEN,COMMARRAY,COMMENT,COMMENTS,COMMIEN,DATEIEN,EDITEDNOTE,FDA,REQREC
  1.  S DATEIEN=3231130.999999
  1.  F  S DATEIEN=$O(^SDEC(409.84,"B",DATEIEN)) Q:'DATEIEN  D
  1.  . S APPTIEN=0
  1.  . F  S APPTIEN=$O(^SDEC(409.84,"B",DATEIEN,APPTIEN)) Q:'APPTIEN  I $D(^SDEC(409.84,APPTIEN,1)) D
  1.  . . S REQREC=$$GET1^DIQ(409.84,APPTIEN_",",.22,"I")
  1.  . . Q:REQREC'[409.85
  1.  . . S APREQIEN=$P(REQREC,";")
  1.  . . S COMMENTS=$$GET1^DIQ(409.85,APREQIEN,25,"E") I COMMENTS?.E1C.E D
  1.  . . . ; Clean associated appt req record
  1.  . . . S COMMENTS=$$CTRL^XMXUTIL1(COMMENTS)
  1.  . . . S FDA(409.85,APREQIEN_",",25)=COMMENTS
  1.  . . . D FILE^DIE("","FDA") K FDA
  1.  . . . ;
  1.  . . . S COMAUDIEN=0
  1.  . . . F  S COMAUDIEN=$O(^SDEC(409.85,APREQIEN,"COMAUD",COMAUDIEN)) Q:'COMAUDIEN  D
  1.  . . . . S COMMENT=$$GET1^DIQ(409.8527,COMAUDIEN_","_APREQIEN_",",2)
  1.  . . . . I COMMENT?.E1C.E D
  1.  . . . . . S FDA(409.8527,COMAUDIEN_","_APREQIEN_",",2)=$$CTRL^XMXUTIL1(COMMENT)
  1.  . . . . . D FILE^DIE("","FDA") K FDA
  1.  . . ;
  1.  . . ; Now clean appt record
  1.  . . S COMMIEN=0
  1.  . . K COMMARRAY
  1.  . . F  S COMMIEN=$O(^SDEC(409.84,APPTIEN,1,COMMIEN)) Q:'COMMIEN  S COMMARRAY(COMMIEN)=^SDEC(409.84,APPTIEN,1,COMMIEN,0)
  1.  . . I $D(COMMARRAY) D
  1.  . . . S COMMENTS=$$WPSTR^SDECUTL(.COMMARRAY)
  1.  . . . I COMMENTS?.E1C.E D
  1.  . . . . S EDITEDNOTE(1)=$$CTRL^XMXUTIL1(COMMENTS)
  1.  . . . . D WP^DIE(409.84,APPTIEN_",",1,"","EDITEDNOTE")
  1.  . . . . ;
  1.  . . . . S COMAUDIEN=0
  1.  . . . . F  S COMAUDIEN=$O(^SDEC(409.84,APPTIEN,"NOTEAUD",COMAUDIEN)) Q:'COMAUDIEN  D
  1.  . . . . . S COMMENT=$$GET1^DIQ(409.847,COMAUDIEN_","_APPTIEN_",",2)
  1.  . . . . . I COMMENT?.E1C.E D
  1.  . . . . . . S FDA(409.847,COMAUDIEN_","_APPTIEN_",",2)=$$CTRL^XMXUTIL1(COMMENT)
  1.  . . . . . . D UPDATE^DIE("","FDA") K FDA
  1.  Q