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 Apr 09, 2024@21:43:16 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
