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

SDEC792P.m

Go to the documentation of this file.
  1. SDEC792P ;ALB/MGD - SD*5.3*792 Post Init Routine ; Jul 14, 2021@17:45
  1. ;;5.3;SCHEDULING;**792**;AUG 13, 1993;Build 9
  1. ;
  1. FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
  1. N SDECDA,SDECDA1
  1. W !!?3,"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. D DISPOSITION
  1. Q
  1. VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.10
  1. S DA=SDECDA,DIE=409.98,DR="2///1.7.10;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.10;3///"_DT D ^DIE ;update VS GUI LOCAL
  1. K DIE,DR,DA
  1. Q
  1. ;
  1. NOFIND ;"VS GUI NATIONAL" NOT FOUND
  1. W !!?3,"VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)"
  1. Q
  1. ;
  1. DISPOSITION ;
  1. ; The DISPOSITION (#21) field in the SDEC APPT REQUEST (#409.85) file
  1. ; has been a Set of Codes with 10 entries which is the max allowed by
  1. ; the FileMan definition of a Set of Codes. Now that additional Disposition
  1. ; reasons are needed, the new SDEC DISPOSITION REASON (#409.853) file has
  1. ; been created to store all Disposition Reasons.
  1. ;
  1. ; This subroutine will loop through existing entries in the SDEC APPT REQUEST
  1. ; (#409.85) file. For any entry with an existing value in the DISPOSITION (#21)
  1. ; field the Set of Codes value will be replaced by the IEN of the corresponding
  1. ; entry in the new SDEC DISPOSITION REASON (#409.853) file.
  1. ;
  1. N U S U="^"
  1. D MSG("SD*5.3*792 Post-Install to re-map the DISPOSITION (#21) field")
  1. D MSG("in the SDEC APPT REQUEST (#409.85) file is being jobbed off")
  1. D MSG("to run as a remote process.")
  1. D MSG("")
  1. N ZTDESC,ZTRTN,ZTIO,ZTSK
  1. S ZTRTN="DISP^SDEC792P",ZTDESC="REMAPPING OF DISPOSITION (#21) IN SDEC APPT REQUEST (#409.85)",ZTIO=""
  1. 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 MES^XPDUTL(SDMES)
  1. Q
  1. ;
  1. DISP ; Re-map the DISPOSITION (#21) field in the SDEC APPT REQUEST (#409.85) file.
  1. ;
  1. N D,D40985,FDA,PID,SDIEN
  1. S SDIEN=0
  1. F S SDIEN=$O(^SDEC(409.85,SDIEN)) Q:'SDIEN D
  1. . S D=$P($G(^SDEC(409.85,SDIEN,"DIS")),U,3)
  1. . Q:D=""
  1. . ; Map existing DISPOSITION code to equivalent pointer value
  1. . S D=$S(D="D":1,D="NC":2,D="SA":3,D="CC":4,D="NN":5,D="ER":6,D="TR":7,D="CL":8,D="MC":9,D="EA":10,1:D)
  1. . S FDA(409.85,SDIEN_",",21)=D
  1. . ; If CID/PREFERRED DATE OF APPT (#22) is null, set to CREATE DATE (#1)
  1. . S D40985=$G(^SDEC(409.85,SDIEN,0))
  1. . S PID=$P(D40985,U,16)
  1. . I PID="" D
  1. . . S PID=$P(D40985,U,2)
  1. . . I PID'="" S FDA(409.85,SDIEN_",",16)=PID
  1. . D FILE^DIE(,"FDA","ERR") K FDA
  1. Q