RAIPS135 ;HISC/GJC post-install routine ;28 Mar 2018 1:59 PM
;;5.0;Radiology/Nuclear Medicine;**135**;Mar 16, 1998;Build 7
;
;Routine IA Type
;-------------------------------------
; ^%ZTLOAD 10063 (S)
; $$FIND1^DIC 2051 (S)
; $$FMADD^XLFDT 10103 (S)
; $$NOW^XLFDT 10103 (S)
; $$FMTE^XLFDT 10103 (S)
; $$NEWCP^XPDUTL 10141 (S)
; $$PROD^XUPROD 4440 (S)
; UPDATE^DIE 2053 (S)
; D EN^DIEZ 10002 (S)
; $$ROUSIZE^DILF 2649 (S)
; OPTSTAT^XUTMOPT() 1472 (S)
; ^DIE("AF", 2022 (C)
; ^DIC(19.2, schedule 6826 (P)
; option
; OPTSTAT^XUTMOPT 1472 (S)
;
N RACHX1,RACHX2
S RACHX1=$$NEWCP^XPDUTL("POST1","EN1^RAIPS135")
S RACHX2=$$NEWCP^XPDUTL("POST2","EN2^RAIPS135")
S RACHX3=$$NEWCP^XPDUTL("POST3","EN3^RAIPS135")
Q
;
EN1 ;part 1: recompile 75.1 input templates
;
ENDIEZ ;run in the foreground as part of the post-install
; ^DD(75.1,21,0)="DATE DESIRED (Not guaranteed)
; ^DIE("AF",file,field,template_IEN)=""
N DMAX,RADMAX,RAY,X,Y S RAY=0,RADMAX=$$ROUSIZE^DILF()
F S RAY=$O(^DIE("AF",75.1,21,RAY)) Q:RAY="" D ;Y = IEN of compiled template
.S DMAX=RADMAX
.S X=$P(^DIE(RAY,"ROU"),U,2) ;X = compiled template routine name
.S Y=RAY D:X'="" EN^DIEZ
.Q
;
; part 2: re-index of the "BDD" 'DATE DESIRED (not guaranteed)' (tasked)
;
N RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN S ZTIO=""
S ZTRTN="EN2^RAUTODC",(ZTDESC,RATXT(1))="RA135: re-index of the 'DATE DESIRED (Not guaranteed)' ""BDD"" xref"
;
S ZTDTH=$H D ^%ZTLOAD S RATXT(2)="Task: "_$S($G(ZTSK)>0:ZTSK,1:"in error")
D BMES^XPDUTL(.RATXT)
Q
;
EN2 ;Schedule option RA AUTO DISCONTINUE PROCESS to discontinue pending, hold & scheduled
; (check Scheduled D/T) from the beginning of time through May 31st 2015@2359.
; This option will be run once and be deleted from the OPTION SCHEDULING file.
; A future RIS patch will delete the RA AUTO DISCONTINUE PROCESS option.
;
; Note: do not fire bulletins, do not fire notifications (toggle on/off)
;
; if "OBSOLETE ORDER-P135 (automated)" has not been added quit...
N RATXT I $$FIND1^DIC(75.2,"","X","OBSOLETE ORDER-P135 (automated)","B")=0 D QUIT
.S RATXT(1)="Error: 'OBSOLETE ORDER-P135 (automated)' could not be found."
.S RATXT(2)="Contact the developers of RA*5.0*135 to address this issue."
.D BMES^XPDUTL(.RATXT)
.Q
;
N DIFROM,RADEV,RAERR,RAFDA,RAFREQ,RAIEN,RAOPT,RAR,RAUSER,RAWHEN,X,Y
S RAOPT="RA AUTO DISCONTINUE PROCESS" ;xported w/135
;jobs in production are tasked off for tomorrow @21:00; jobs in mirror run today in an hour
S RAWHEN=$S($$PROD^XUPROD()=1:$$FMADD^XLFDT(DT,1)_".21",1:$$FMADD^XLFDT($E($$NOW^XLFDT(),1,12),0,1,0,0))
S RAUSER="POSTMASTER"
S RAWHEN=$$FMTE^XLFDT(RAWHEN) ;use external
S RAR=$NA(RAFDA(19.2,"?+1,")) ;RAFDA root
;.01 - option to be scheduled
S @RAR@(.01)=RAOPT
;field #: 2 - QUEUED TO RUN AT WHAT TIME
S:$D(RAWHEN) @RAR@(2)=RAWHEN
;field #: 3 - DEVICE FOR QUEUED JOB OUTPUT
S:$D(RADEV) @RAR@(3)=RADEV
;field #: 6 - RESCHEDULING FREQUENCY
S:$D(RAFREQ) @RAR@(6)=RAFREQ
;field #: 11 - USER TO RUN TASK
S:$D(RAUSER) @RAR@(11)=RAUSER
D UPDATE^DIE("E","RAFDA","RAIEN","RAERR")
I $D(RAERR) D
.S RATXT(1)="Error: """_RAOPT_""" could not be scheduled."
.S RATXT(2)="Contact the developers of RA*5.0*135 to address this issue."
.D BMES^XPDUTL(.RATXT)
.Q
I $G(RAIEN(1))>0 D
.K RA192,RATXT S RATXT(1)=""
.D OPTSTAT^XUTMOPT(RAOPT,.RA192)
.S RATXT(2)=RAOPT_" Task: "_$P($G(RA192(1)),U) ;task # ^ D/T scheduled
.D BMES^XPDUTL(.RATXT) K RA192,RATXT
.Q
Q
;
EN3 ;re-index the "AS" cross reference missed in RA*5.0*130
;
N RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN S ZTIO="",RATXT(1)=""
S ZTRTN="EN3^RAUTODC",(ZTDESC,RATXT(2))="RA135: re-index of the 'REQUEST STATUS' ""AS"" xref."
;
S ZTDTH=$H D ^%ZTLOAD S RATXT(3)="Task: "_$S($G(ZTSK)>0:ZTSK,1:"in error")
D BMES^XPDUTL(.RATXT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS135 4104 printed Apr 09, 2024@21:39:53 Page 2
RAIPS135 ;HISC/GJC post-install routine ;28 Mar 2018 1:59 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**135**;Mar 16, 1998;Build 7
+2 ;
+3 ;Routine IA Type
+4 ;-------------------------------------
+5 ; ^%ZTLOAD 10063 (S)
+6 ; $$FIND1^DIC 2051 (S)
+7 ; $$FMADD^XLFDT 10103 (S)
+8 ; $$NOW^XLFDT 10103 (S)
+9 ; $$FMTE^XLFDT 10103 (S)
+10 ; $$NEWCP^XPDUTL 10141 (S)
+11 ; $$PROD^XUPROD 4440 (S)
+12 ; UPDATE^DIE 2053 (S)
+13 ; D EN^DIEZ 10002 (S)
+14 ; $$ROUSIZE^DILF 2649 (S)
+15 ; OPTSTAT^XUTMOPT() 1472 (S)
+16 ; ^DIE("AF", 2022 (C)
+17 ; ^DIC(19.2, schedule 6826 (P)
+18 ; option
+19 ; OPTSTAT^XUTMOPT 1472 (S)
+20 ;
+21 NEW RACHX1,RACHX2
+22 SET RACHX1=$$NEWCP^XPDUTL("POST1","EN1^RAIPS135")
+23 SET RACHX2=$$NEWCP^XPDUTL("POST2","EN2^RAIPS135")
+24 SET RACHX3=$$NEWCP^XPDUTL("POST3","EN3^RAIPS135")
+25 QUIT
+26 ;
EN1 ;part 1: recompile 75.1 input templates
+1 ;
ENDIEZ ;run in the foreground as part of the post-install
+1 ; ^DD(75.1,21,0)="DATE DESIRED (Not guaranteed)
+2 ; ^DIE("AF",file,field,template_IEN)=""
+3 NEW DMAX,RADMAX,RAY,X,Y
SET RAY=0
SET RADMAX=$$ROUSIZE^DILF()
+4 ;Y = IEN of compiled template
FOR
SET RAY=$ORDER(^DIE("AF",75.1,21,RAY))
if RAY=""
QUIT
Begin DoDot:1
+5 SET DMAX=RADMAX
+6 ;X = compiled template routine name
SET X=$PIECE(^DIE(RAY,"ROU"),U,2)
+7 SET Y=RAY
if X'=""
DO EN^DIEZ
+8 QUIT
End DoDot:1
+9 ;
+10 ; part 2: re-index of the "BDD" 'DATE DESIRED (not guaranteed)' (tasked)
+11 ;
+12 NEW RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN
SET ZTIO=""
+13 SET ZTRTN="EN2^RAUTODC"
SET (ZTDESC,RATXT(1))="RA135: re-index of the 'DATE DESIRED (Not guaranteed)' ""BDD"" xref"
+14 ;
+15 SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
SET RATXT(2)="Task: "_$SELECT($GET(ZTSK)>0:ZTSK,1:"in error")
+16 DO BMES^XPDUTL(.RATXT)
+17 QUIT
+18 ;
EN2 ;Schedule option RA AUTO DISCONTINUE PROCESS to discontinue pending, hold & scheduled
+1 ; (check Scheduled D/T) from the beginning of time through May 31st 2015@2359.
+2 ; This option will be run once and be deleted from the OPTION SCHEDULING file.
+3 ; A future RIS patch will delete the RA AUTO DISCONTINUE PROCESS option.
+4 ;
+5 ; Note: do not fire bulletins, do not fire notifications (toggle on/off)
+6 ;
+7 ; if "OBSOLETE ORDER-P135 (automated)" has not been added quit...
+8 NEW RATXT
IF $$FIND1^DIC(75.2,"","X","OBSOLETE ORDER-P135 (automated)","B")=0
Begin DoDot:1
+9 SET RATXT(1)="Error: 'OBSOLETE ORDER-P135 (automated)' could not be found."
+10 SET RATXT(2)="Contact the developers of RA*5.0*135 to address this issue."
+11 DO BMES^XPDUTL(.RATXT)
+12 QUIT
End DoDot:1
QUIT
+13 ;
+14 NEW DIFROM,RADEV,RAERR,RAFDA,RAFREQ,RAIEN,RAOPT,RAR,RAUSER,RAWHEN,X,Y
+15 ;xported w/135
SET RAOPT="RA AUTO DISCONTINUE PROCESS"
+16 ;jobs in production are tasked off for tomorrow @21:00; jobs in mirror run today in an hour
+17 SET RAWHEN=$SELECT($$PROD^XUPROD()=1:$$FMADD^XLFDT(DT,1)_".21",1:$$FMADD^XLFDT($EXTRACT($$NOW^XLFDT(),1,12),0,1,0,0))
+18 SET RAUSER="POSTMASTER"
+19 ;use external
SET RAWHEN=$$FMTE^XLFDT(RAWHEN)
+20 ;RAFDA root
SET RAR=$NAME(RAFDA(19.2,"?+1,"))
+21 ;.01 - option to be scheduled
+22 SET @RAR@(.01)=RAOPT
+23 ;field #: 2 - QUEUED TO RUN AT WHAT TIME
+24 if $DATA(RAWHEN)
SET @RAR@(2)=RAWHEN
+25 ;field #: 3 - DEVICE FOR QUEUED JOB OUTPUT
+26 if $DATA(RADEV)
SET @RAR@(3)=RADEV
+27 ;field #: 6 - RESCHEDULING FREQUENCY
+28 if $DATA(RAFREQ)
SET @RAR@(6)=RAFREQ
+29 ;field #: 11 - USER TO RUN TASK
+30 if $DATA(RAUSER)
SET @RAR@(11)=RAUSER
+31 DO UPDATE^DIE("E","RAFDA","RAIEN","RAERR")
+32 IF $DATA(RAERR)
Begin DoDot:1
+33 SET RATXT(1)="Error: """_RAOPT_""" could not be scheduled."
+34 SET RATXT(2)="Contact the developers of RA*5.0*135 to address this issue."
+35 DO BMES^XPDUTL(.RATXT)
+36 QUIT
End DoDot:1
+37 IF $GET(RAIEN(1))>0
Begin DoDot:1
+38 KILL RA192,RATXT
SET RATXT(1)=""
+39 DO OPTSTAT^XUTMOPT(RAOPT,.RA192)
+40 ;task # ^ D/T scheduled
SET RATXT(2)=RAOPT_" Task: "_$PIECE($GET(RA192(1)),U)
+41 DO BMES^XPDUTL(.RATXT)
KILL RA192,RATXT
+42 QUIT
End DoDot:1
+43 QUIT
+44 ;
EN3 ;re-index the "AS" cross reference missed in RA*5.0*130
+1 ;
+2 NEW RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN
SET ZTIO=""
SET RATXT(1)=""
+3 SET ZTRTN="EN3^RAUTODC"
SET (ZTDESC,RATXT(2))="RA135: re-index of the 'REQUEST STATUS' ""AS"" xref."
+4 ;
+5 SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
SET RATXT(3)="Task: "_$SELECT($GET(ZTSK)>0:ZTSK,1:"in error")
+6 DO BMES^XPDUTL(.RATXT)
+7 QUIT
+8 ;
