RACTCERN ;WOIFO/KLM - Standard Procedures Activation ; Jun 25, 2025@13:39
;;5.0;Radiology/Nuclear Medicine;**226**;Mar 16, 1998;Build 2
;
; Activate Cerner/Oracle standard procedures
;
EN1 ;Entry
N RASEL,RAY,RACT
;Activate or Inactivate?
N DIR,Y S DIR(0)="SO^1:Activate;2:Inactivate"
S DIR("A")="Activate or Inactivate the new standard procedures?"
D ^DIR Q:$D(DIRUT) S RACT=+Y_U_$G(Y(0)) K DIRUT
; Next ask how they want to activate (one-at-a-time or what?)
N DIR,Y S DIR(0)="SO^1:Choose Individual Procedures;2:By Modality;3:All"
S DIR("A")="How do you want to "_$S(+RACT=1:"activate",1:"inactivate")_" the new Oracle/Cerner standard procedures?"
D ^DIR Q:$D(DIRUT) S RASEL=+Y_U_$G(Y(0)) K DIRUT
D:+RASEL=1 1 D:+RASEL=2 2 D:+RASEL=3 3
;
;
Q
1 ;Select individual procedures to activate
K ^TMP($J,"RAPROCS")
N RADATA S RADATA="RAPROCS"
S RADIC="^RAMIS(71,",RADIC(0)="QEAMZ",RADIC("A")="Select Procedures(s): "
S:+RACT=1 RADIC("S")="I $P($G(^RAMIS(71,+Y,0)),U,8)=""Y"",($P($G(^RAMIS(71,+Y,""I"")),U))]"""""
S:+RACT=2 RADIC("S")="I $P($G(^RAMIS(71,+Y,0)),U,8)=""Y"",($P($G(^RAMIS(71,+Y,""I"")),U))="""""
W ! D EN1^RASELCT(.RADIC,RADATA)
K DIC,RADIC,RADATA
N RAPR,RAIEN,RAERR,RAIENS,RAFDA
W !!
S RAPR="" F S RAPR=$O(^TMP($J,"RAPROCS",RAPR)) Q:RAPR="" D
.S RAIEN=0 F S RAIEN=$O(^TMP($J,"RAPROCS",RAPR,RAIEN)) Q:RAIEN="" D
..I +RACT=1,(($G(^RAMIS(71,RAIEN,"I"))="")!($G(^RAMIS(71,RAIEN,"I"))>DT)) Q ;already active
..I +RACT=2,($G(^RAMIS(71,RAIEN,"I"))]"")&($G(^RAMIS(71,RAIEN,"I"))<$$FMADD^XLFDT(DT,+1)) Q ;already inactive
..S RAIENS=RAIEN_",",RAY=RAIEN
..K RAERR
..S:+RACT=1 RAFDA(71,RAIENS,100)="@" ;Remove inactive date
..S:+RACT=2 RAFDA(71,RAIENS,100)=$$FMADD^XLFDT(DT,-1) ;Set inactive date (T-1)
..D UPDATE^DIE("","RAFDA","RAIEN","RAERR")
..W:$D(RAERR(1,"DIERR"))#2 "There was an issue "_$S(+RACT=1:"activating",1:"inactivating")_" the procedure "_RAPR
..W:'$D(RAERR(1,"DIERR"))#2 RAPR_$S(+RACT=1:" Activated!",1:" Inactivated!"),!
..D OI
..Q
.Q
K ^TMP($J,"RAPROCS")
Q
;
2 ;Select all procedures for modality to activate
N RARY,RAPR,RAIEN,RAMOD,RAERR,RAIENS,RAFDA
N DIR,Y S DIR(0)="PO^79.2:EMZ",DIR("A")="Select an Imaging Type to "_$S(+RACT=1:"activate",1:"inactivate")
D ^DIR Q:$D(DIRUT) S RAMOD=$G(Y) K DIRUT
W !!
S RAIEN=0 F S RAIEN=$O(^RAMIS(71,"AIMG",+RAMOD,RAIEN)) Q:RAIEN="" D
.S RA71=$G(^RAMIS(71,RAIEN,0)) Q:$P(RA71,U,8)'="Y"
.I +RACT=1,(($G(^RAMIS(71,RAIEN,"I"))="")!($G(^RAMIS(71,RAIEN,"I"))>DT)) Q ;already active
.I +RACT=2,($G(^RAMIS(71,RAIEN,"I"))]"")&($G(^RAMIS(71,RAIEN,"I"))<$$FMADD^XLFDT(DT,+1)) Q ;already inactive
.S RAIENS=RAIEN_",",RAY=RAIEN,RAPR=$P(RA71,U)
.K RAERR
.S:+RACT=1 RAFDA(71,RAIENS,100)="@" ;remove inactive date
.S:+RACT=2 RAFDA(71,RAIENS,100)=$$FMADD^XLFDT(DT,-1) ;Set inactive date (T-1)
.D UPDATE^DIE("","RAFDA","RAIEN","RAERR")
.W:$D(RAERR(1,"DIERR"))#2 "There was an issue "_$S(+RACT=1:"activating",1:"inactivating")_" the procedure "_$G(RAPR)
.W:'$D(RAERR(1,"DIERR"))#2 RAPR_$S(+RACT=1:" Activated!",1:" Inactivated!"),!
.D OI
.Q
Q
3 ;Select All procedures (let er rip) - need to fix
N RAIEN,RAPR,RAERR,RA71,RAIENS,RAFDA,DIRUT
W !!
N DIR,Y S DIR(0)="YO",DIR("A")="Are you sure you want to "_$S(+RACT=1:"activate",1:"inactivate")_" ALL of the Oracle/Cerner procedures"
D ^DIR Q:$D(DIRUT) I Y'=1 W !!,"OK, see you later..." Q
K DIRUT,Y
; Get all new standard procedures to activate
W !!
;
S RAIEN=0 F S RAIEN=$O(^RAMIS(71,RAIEN)) Q:RAIEN="" D
.S RA71=$G(^RAMIS(71,RAIEN,0)) Q:$P(RA71,U,8)'="Y" ;Standard procedures only
.S RAPR=$P(RA71,U) Q:$G(RAPR)=""
.I +RACT=1,(($G(^RAMIS(71,RAIEN,"I"))="")!($G(^RAMIS(71,RAIEN,"I"))>DT)) Q ;already active
.I +RACT=2,($G(^RAMIS(71,RAIEN,"I"))]"")&($G(^RAMIS(71,RAIEN,"I"))<$$FMADD^XLFDT(DT,+1)) Q ;already inactive
.S RAIENS=RAIEN_",",RAY=RAIEN
.K RAERR
.S:+RACT=1 RAFDA(71,RAIENS,100)="@" ;remove inactive date
.S:+RACT=2 RAFDA(71,RAIENS,100)=$$FMADD^XLFDT(DT,-1) ;Set inactive date (T-1)
.D UPDATE^DIE("","RAFDA","RAIEN","RAERR")
.W:$D(RAERR(1,"DIERR"))#2 "There was an issue "_$S(+RACT=1:"activating",1:"inactivating")_" the procedure "_$G(RAPR)
.W:'$D(RAERR(1,"DIERR"))#2 RAPR_$S(+RACT=1:" Activated!",1:" Inactivated!"),!
.D OI
.Q
Q
OI ;Update Orderable Item
N RAENALL,RAFILE,RASTAT
S RAENALL=0,RAFILE=71,RASTAT=1,RAY=RAY_"^"_RAPR_"^"_1
D PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRACTCERN 4469 printed Mar 25, 2026@15:58:44 Page 2
RACTCERN ;WOIFO/KLM - Standard Procedures Activation ; Jun 25, 2025@13:39
+1 ;;5.0;Radiology/Nuclear Medicine;**226**;Mar 16, 1998;Build 2
+2 ;
+3 ; Activate Cerner/Oracle standard procedures
+4 ;
EN1 ;Entry
+1 NEW RASEL,RAY,RACT
+2 ;Activate or Inactivate?
+3 NEW DIR,Y
SET DIR(0)="SO^1:Activate;2:Inactivate"
+4 SET DIR("A")="Activate or Inactivate the new standard procedures?"
+5 DO ^DIR
if $DATA(DIRUT)
QUIT
SET RACT=+Y_U_$GET(Y(0))
KILL DIRUT
+6 ; Next ask how they want to activate (one-at-a-time or what?)
+7 NEW DIR,Y
SET DIR(0)="SO^1:Choose Individual Procedures;2:By Modality;3:All"
+8 SET DIR("A")="How do you want to "_$SELECT(+RACT=1:"activate",1:"inactivate")_" the new Oracle/Cerner standard procedures?"
+9 DO ^DIR
if $DATA(DIRUT)
QUIT
SET RASEL=+Y_U_$GET(Y(0))
KILL DIRUT
+10 if +RASEL=1
DO 1
if +RASEL=2
DO 2
if +RASEL=3
DO 3
+11 ;
+12 ;
+13 QUIT
1 ;Select individual procedures to activate
+1 KILL ^TMP($JOB,"RAPROCS")
+2 NEW RADATA
SET RADATA="RAPROCS"
+3 SET RADIC="^RAMIS(71,"
SET RADIC(0)="QEAMZ"
SET RADIC("A")="Select Procedures(s): "
+4 if +RACT=1
SET RADIC("S")="I $P($G(^RAMIS(71,+Y,0)),U,8)=""Y"",($P($G(^RAMIS(71,+Y,""I"")),U))]"""""
+5 if +RACT=2
SET RADIC("S")="I $P($G(^RAMIS(71,+Y,0)),U,8)=""Y"",($P($G(^RAMIS(71,+Y,""I"")),U))="""""
+6 WRITE !
DO EN1^RASELCT(.RADIC,RADATA)
+7 KILL DIC,RADIC,RADATA
+8 NEW RAPR,RAIEN,RAERR,RAIENS,RAFDA
+9 WRITE !!
+10 SET RAPR=""
FOR
SET RAPR=$ORDER(^TMP($JOB,"RAPROCS",RAPR))
if RAPR=""
QUIT
Begin DoDot:1
+11 SET RAIEN=0
FOR
SET RAIEN=$ORDER(^TMP($JOB,"RAPROCS",RAPR,RAIEN))
if RAIEN=""
QUIT
Begin DoDot:2
+12 ;already active
IF +RACT=1
IF (($GET(^RAMIS(71,RAIEN,"I"))="")!($GET(^RAMIS(71,RAIEN,"I"))>DT))
QUIT
+13 ;already inactive
IF +RACT=2
IF ($GET(^RAMIS(71,RAIEN,"I"))]"")&($GET(^RAMIS(71,RAIEN,"I"))<$$FMADD^XLFDT(DT,+1))
QUIT
+14 SET RAIENS=RAIEN_","
SET RAY=RAIEN
+15 KILL RAERR
+16 ;Remove inactive date
if +RACT=1
SET RAFDA(71,RAIENS,100)="@"
+17 ;Set inactive date (T-1)
if +RACT=2
SET RAFDA(71,RAIENS,100)=$$FMADD^XLFDT(DT,-1)
+18 DO UPDATE^DIE("","RAFDA","RAIEN","RAERR")
+19 if $DATA(RAERR(1,"DIERR"))#2
WRITE "There was an issue "_$SELECT(+RACT=1:"activating",1:"inactivating")_" the procedure "_RAPR
+20 if '$DATA(RAERR(1,"DIERR"))#2
WRITE RAPR_$SELECT(+RACT=1:" Activated!",1:" Inactivated!"),!
+21 DO OI
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 KILL ^TMP($JOB,"RAPROCS")
+25 QUIT
+26 ;
2 ;Select all procedures for modality to activate
+1 NEW RARY,RAPR,RAIEN,RAMOD,RAERR,RAIENS,RAFDA
+2 NEW DIR,Y
SET DIR(0)="PO^79.2:EMZ"
SET DIR("A")="Select an Imaging Type to "_$SELECT(+RACT=1:"activate",1:"inactivate")
+3 DO ^DIR
if $DATA(DIRUT)
QUIT
SET RAMOD=$GET(Y)
KILL DIRUT
+4 WRITE !!
+5 SET RAIEN=0
FOR
SET RAIEN=$ORDER(^RAMIS(71,"AIMG",+RAMOD,RAIEN))
if RAIEN=""
QUIT
Begin DoDot:1
+6 SET RA71=$GET(^RAMIS(71,RAIEN,0))
if $PIECE(RA71,U,8)'="Y"
QUIT
+7 ;already active
IF +RACT=1
IF (($GET(^RAMIS(71,RAIEN,"I"))="")!($GET(^RAMIS(71,RAIEN,"I"))>DT))
QUIT
+8 ;already inactive
IF +RACT=2
IF ($GET(^RAMIS(71,RAIEN,"I"))]"")&($GET(^RAMIS(71,RAIEN,"I"))<$$FMADD^XLFDT(DT,+1))
QUIT
+9 SET RAIENS=RAIEN_","
SET RAY=RAIEN
SET RAPR=$PIECE(RA71,U)
+10 KILL RAERR
+11 ;remove inactive date
if +RACT=1
SET RAFDA(71,RAIENS,100)="@"
+12 ;Set inactive date (T-1)
if +RACT=2
SET RAFDA(71,RAIENS,100)=$$FMADD^XLFDT(DT,-1)
+13 DO UPDATE^DIE("","RAFDA","RAIEN","RAERR")
+14 if $DATA(RAERR(1,"DIERR"))#2
WRITE "There was an issue "_$SELECT(+RACT=1:"activating",1:"inactivating")_" the procedure "_$GET(RAPR)
+15 if '$DATA(RAERR(1,"DIERR"))#2
WRITE RAPR_$SELECT(+RACT=1:" Activated!",1:" Inactivated!"),!
+16 DO OI
+17 QUIT
End DoDot:1
+18 QUIT
3 ;Select All procedures (let er rip) - need to fix
+1 NEW RAIEN,RAPR,RAERR,RA71,RAIENS,RAFDA,DIRUT
+2 WRITE !!
+3 NEW DIR,Y
SET DIR(0)="YO"
SET DIR("A")="Are you sure you want to "_$SELECT(+RACT=1:"activate",1:"inactivate")_" ALL of the Oracle/Cerner procedures"
+4 DO ^DIR
if $DATA(DIRUT)
QUIT
IF Y'=1
WRITE !!,"OK, see you later..."
QUIT
+5 KILL DIRUT,Y
+6 ; Get all new standard procedures to activate
+7 WRITE !!
+8 ;
+9 SET RAIEN=0
FOR
SET RAIEN=$ORDER(^RAMIS(71,RAIEN))
if RAIEN=""
QUIT
Begin DoDot:1
+10 ;Standard procedures only
SET RA71=$GET(^RAMIS(71,RAIEN,0))
if $PIECE(RA71,U,8)'="Y"
QUIT
+11 SET RAPR=$PIECE(RA71,U)
if $GET(RAPR)=""
QUIT
+12 ;already active
IF +RACT=1
IF (($GET(^RAMIS(71,RAIEN,"I"))="")!($GET(^RAMIS(71,RAIEN,"I"))>DT))
QUIT
+13 ;already inactive
IF +RACT=2
IF ($GET(^RAMIS(71,RAIEN,"I"))]"")&($GET(^RAMIS(71,RAIEN,"I"))<$$FMADD^XLFDT(DT,+1))
QUIT
+14 SET RAIENS=RAIEN_","
SET RAY=RAIEN
+15 KILL RAERR
+16 ;remove inactive date
if +RACT=1
SET RAFDA(71,RAIENS,100)="@"
+17 ;Set inactive date (T-1)
if +RACT=2
SET RAFDA(71,RAIENS,100)=$$FMADD^XLFDT(DT,-1)
+18 DO UPDATE^DIE("","RAFDA","RAIEN","RAERR")
+19 if $DATA(RAERR(1,"DIERR"))#2
WRITE "There was an issue "_$SELECT(+RACT=1:"activating",1:"inactivating")_" the procedure "_$GET(RAPR)
+20 if '$DATA(RAERR(1,"DIERR"))#2
WRITE RAPR_$SELECT(+RACT=1:" Activated!",1:" Inactivated!"),!
+21 DO OI
+22 QUIT
End DoDot:1
+23 QUIT
OI ;Update Orderable Item
+1 NEW RAENALL,RAFILE,RASTAT
+2 SET RAENALL=0
SET RAFILE=71
SET RASTAT=1
SET RAY=RAY_"^"_RAPR_"^"_1
+3 DO PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY)
+4 QUIT
