- SDEC792P ;ALB/MGD - SD*5.3*792 Post Init Routine ; Jul 14, 2021@17:45
- ;;5.3;SCHEDULING;**792**;AUG 13, 1993;Build 9
- ;
- FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
- N SDECDA,SDECDA1
- W !!?3,"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
- D DISPOSITION
- Q
- VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.10
- S DA=SDECDA,DIE=409.98,DR="2///1.7.10;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.10;3///"_DT D ^DIE ;update VS GUI LOCAL
- K DIE,DR,DA
- Q
- ;
- NOFIND ;"VS GUI NATIONAL" NOT FOUND
- W !!?3,"VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)"
- Q
- ;
- DISPOSITION ;
- ; The DISPOSITION (#21) field in the SDEC APPT REQUEST (#409.85) file
- ; has been a Set of Codes with 10 entries which is the max allowed by
- ; the FileMan definition of a Set of Codes. Now that additional Disposition
- ; reasons are needed, the new SDEC DISPOSITION REASON (#409.853) file has
- ; been created to store all Disposition Reasons.
- ;
- ; This subroutine will loop through existing entries in the SDEC APPT REQUEST
- ; (#409.85) file. For any entry with an existing value in the DISPOSITION (#21)
- ; field the Set of Codes value will be replaced by the IEN of the corresponding
- ; entry in the new SDEC DISPOSITION REASON (#409.853) file.
- ;
- N U S U="^"
- D MSG("SD*5.3*792 Post-Install to re-map the DISPOSITION (#21) field")
- D MSG("in the SDEC APPT REQUEST (#409.85) file is being jobbed off")
- D MSG("to run as a remote process.")
- D MSG("")
- N ZTDESC,ZTRTN,ZTIO,ZTSK
- S ZTRTN="DISP^SDEC792P",ZTDESC="REMAPPING OF DISPOSITION (#21) IN SDEC APPT REQUEST (#409.85)",ZTIO=""
- 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 MES^XPDUTL(SDMES)
- Q
- ;
- DISP ; Re-map the DISPOSITION (#21) field in the SDEC APPT REQUEST (#409.85) file.
- ;
- N D,D40985,FDA,PID,SDIEN
- S SDIEN=0
- F S SDIEN=$O(^SDEC(409.85,SDIEN)) Q:'SDIEN D
- . S D=$P($G(^SDEC(409.85,SDIEN,"DIS")),U,3)
- . Q:D=""
- . ; Map existing DISPOSITION code to equivalent pointer value
- . 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)
- . S FDA(409.85,SDIEN_",",21)=D
- . ; If CID/PREFERRED DATE OF APPT (#22) is null, set to CREATE DATE (#1)
- . S D40985=$G(^SDEC(409.85,SDIEN,0))
- . S PID=$P(D40985,U,16)
- . I PID="" D
- . . S PID=$P(D40985,U,2)
- . . I PID'="" S FDA(409.85,SDIEN_",",16)=PID
- . D FILE^DIE(,"FDA","ERR") K FDA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC792P 2896 printed Feb 19, 2025@00:17:40 Page 2
- 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
- +2 ;
- FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
- +1 NEW SDECDA,SDECDA1
- +2 WRITE !!?3,"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 DO DISPOSITION
- +6 QUIT
- VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.10
- +1 ;update VS GUI NATIONAL
- SET DA=SDECDA
- SET DIE=409.98
- SET DR="2///1.7.10;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.10;3///"_DT
- DO ^DIE
- +5 KILL DIE,DR,DA
- +6 QUIT
- +7 ;
- NOFIND ;"VS GUI NATIONAL" NOT FOUND
- +1 WRITE !!?3,"VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)"
- +2 QUIT
- +3 ;
- DISPOSITION ;
- +1 ; The DISPOSITION (#21) field in the SDEC APPT REQUEST (#409.85) file
- +2 ; has been a Set of Codes with 10 entries which is the max allowed by
- +3 ; the FileMan definition of a Set of Codes. Now that additional Disposition
- +4 ; reasons are needed, the new SDEC DISPOSITION REASON (#409.853) file has
- +5 ; been created to store all Disposition Reasons.
- +6 ;
- +7 ; This subroutine will loop through existing entries in the SDEC APPT REQUEST
- +8 ; (#409.85) file. For any entry with an existing value in the DISPOSITION (#21)
- +9 ; field the Set of Codes value will be replaced by the IEN of the corresponding
- +10 ; entry in the new SDEC DISPOSITION REASON (#409.853) file.
- +11 ;
- +12 NEW U
- SET U="^"
- +13 DO MSG("SD*5.3*792 Post-Install to re-map the DISPOSITION (#21) field")
- +14 DO MSG("in the SDEC APPT REQUEST (#409.85) file is being jobbed off")
- +15 DO MSG("to run as a remote process.")
- +16 DO MSG("")
- +17 NEW ZTDESC,ZTRTN,ZTIO,ZTSK
- +18 SET ZTRTN="DISP^SDEC792P"
- SET ZTDESC="REMAPPING OF DISPOSITION (#21) IN SDEC APPT REQUEST (#409.85)"
- SET ZTIO=""
- +19 DO ^%ZTLOAD
- +20 IF $DATA(ZTSK)
- Begin DoDot:1
- +21 DO MSG(">>>Task "_ZTSK_" has been queued.")
- +22 DO MSG("")
- End DoDot:1
- +23 IF '$DATA(ZTSK)
- Begin DoDot:1
- +24 DO MSG("UNABLE TO QUEUE THIS JOB.")
- +25 DO MSG("Please contact the National Help Desk to report this issue.")
- End DoDot:1
- +26 QUIT
- +27 ;
- MSG(SDMES) ;
- +1 DO MES^XPDUTL(SDMES)
- +2 QUIT
- +3 ;
- DISP ; Re-map the DISPOSITION (#21) field in the SDEC APPT REQUEST (#409.85) file.
- +1 ;
- +2 NEW D,D40985,FDA,PID,SDIEN
- +3 SET SDIEN=0
- +4 FOR
- SET SDIEN=$ORDER(^SDEC(409.85,SDIEN))
- if 'SDIEN
- QUIT
- Begin DoDot:1
- +5 SET D=$PIECE($GET(^SDEC(409.85,SDIEN,"DIS")),U,3)
- +6 if D=""
- QUIT
- +7 ; Map existing DISPOSITION code to equivalent pointer value
- +8 SET D=$SELECT(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)
- +9 SET FDA(409.85,SDIEN_",",21)=D
- +10 ; If CID/PREFERRED DATE OF APPT (#22) is null, set to CREATE DATE (#1)
- +11 SET D40985=$GET(^SDEC(409.85,SDIEN,0))
- +12 SET PID=$PIECE(D40985,U,16)
- +13 IF PID=""
- Begin DoDot:2
- +14 SET PID=$PIECE(D40985,U,2)
- +15 IF PID'=""
- SET FDA(409.85,SDIEN_",",16)=PID
- End DoDot:2
- +16 DO FILE^DIE(,"FDA","ERR")
- KILL FDA
- End DoDot:1
- +17 QUIT