RAIPR175 ;HISC/GJC-preinit 175 ; Jan 19, 2021@15:45:32
;;5.0;Radiology/Nuclear Medicine;**175**;Mar 16, 1998;Build 2
;
;Routine File IA Type
;----------------------------------------------
;$$FIND1^DIC() 2051 (S)
;BMES^XPDUTL 10141 (S)
;$$DELETE^XPDMENU() 1157 (S)
;DELIX^DDMOD() 2916 (S)
;
EN ;entry point to remove ITEMS from the RA ORDER menu
; first, get the IEN for the RA ORDER menu
N RAERR,RAITEM,RAMENU,RAX S RAX="RA ORDER"
S RAMENU=$$FIND1(RAX)
; not found, record incident and exit
I RAMENU=-1 D Q
.D BMES^XPDUTL("Exiting: the 'RA ORDER' menu was not found!")
.Q
;save off name
S RAMENU=RAX
;
;Find the specific options listed in the FOR loop.
;If success, save the IEN of those option names as
;a subscript in the RAITEM() array.
;
F RAX="RA ORDERLOG","RA ORDERPENDING","RA ORDERLOGLOC" D
.N Y S Y=$$FIND1(RAX)
.I Y=-1 D BMES^XPDUTL("Option: "_RAX_" was not found!") Q
.S RAITEM(RAX)=Y
.Q
;
I ($D(RAITEM)\10)=0 D Q
.D BMES^XPDUTL("Exiting: There are no '"_RAMENU_"' menu ITEMS to be removed.")
.Q
;
; Remove the options, save as subscripts from the menu identifed
; by RAORDER.
;
S (RAX,Y)=""
F S RAX=$O(RAITEM(RAX)) Q:RAX="" D
.S Y=$$DELETE^XPDMENU(RAMENU,RAX)
.;Y = 1 success; else 0
.S RATXT(1)="'"_RAX_"' was "_$S(Y=0:"not ",1:"")_"removed as an ITEM"
.S RATXT(2)="under the '"_RAMENU_"' menu."
.D BMES^XPDUTL(.RATXT)
.Q
K RATXT
; call ACHN (see comments below)
D ACHN
Q
;
;// subroutines //
FIND1(RAX) ;find the option IEN based on the option name
;Input: RAX = option name
;Return: IEN option name; else -1
N RAERR,Y
S Y=$$FIND1^DIC(19,,"X",RAX,"","","RAERR")
Q $S(Y=0!($D(RAERR)):-1,1:Y)
;
ACHN ;remove the "ACHN" xref file: 75.1, fld: 5
; Pre-"ACHN" deletion defn
;^DD(75.1,5,1,0)="^.1^^-1" ^DD(75.1,5,1,2,0)="75.1^ACHN^MUMPS"
;^DD(75.1,5,1,2,1)="D:$$ORVR^RAORDU()=2.5&((X=1)!(X=3)) CH^RADD2(DA,X)"
;^DD(75.1,5,1,2,2)="Q" ^DD(75.1,5,1,2,3)="Do not delete."
;
; delete the REQUEST STATUS "ACHN" xref (xref #: 2)
; results are recorded in RARSLT
; errors, if any, are recorded in RAERR.
; - RADD2 has no IAs
; - there are no external calls to CH^RADD2
; (vivian dot worldvista dot org)
; The CH tag is to be removed from RADD2.
;
K RARSLT,RAERR D DELIX^DDMOD(75.1,5,2,"","RARSLT","RAERR")
I $D(RAERR) D
.D BMES^XPDUTL("Error when trying to delete the ""ACHN"" xref (75.1; 5).")
.Q
E D
.D BMES^XPDUTL("The ""ACHN"" xref (75.1; 5) was successfully deleted.")
.D:$G(RARSLT("DDAUD"))=1 BMES^XPDUTL("""ACHN"" deletion was recorded in the DD AUDIT (#.6) file.")
.;national no longer compiles input tempates or cross-references on this file.
.Q
EXIT ;clean up
K RARSLT,RAERR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPR175 2899 printed Apr 09, 2024@21:36:21 Page 2
RAIPR175 ;HISC/GJC-preinit 175 ; Jan 19, 2021@15:45:32
+1 ;;5.0;Radiology/Nuclear Medicine;**175**;Mar 16, 1998;Build 2
+2 ;
+3 ;Routine File IA Type
+4 ;----------------------------------------------
+5 ;$$FIND1^DIC() 2051 (S)
+6 ;BMES^XPDUTL 10141 (S)
+7 ;$$DELETE^XPDMENU() 1157 (S)
+8 ;DELIX^DDMOD() 2916 (S)
+9 ;
EN ;entry point to remove ITEMS from the RA ORDER menu
+1 ; first, get the IEN for the RA ORDER menu
+2 NEW RAERR,RAITEM,RAMENU,RAX
SET RAX="RA ORDER"
+3 SET RAMENU=$$FIND1(RAX)
+4 ; not found, record incident and exit
+5 IF RAMENU=-1
Begin DoDot:1
+6 DO BMES^XPDUTL("Exiting: the 'RA ORDER' menu was not found!")
+7 QUIT
End DoDot:1
QUIT
+8 ;save off name
+9 SET RAMENU=RAX
+10 ;
+11 ;Find the specific options listed in the FOR loop.
+12 ;If success, save the IEN of those option names as
+13 ;a subscript in the RAITEM() array.
+14 ;
+15 FOR RAX="RA ORDERLOG","RA ORDERPENDING","RA ORDERLOGLOC"
Begin DoDot:1
+16 NEW Y
SET Y=$$FIND1(RAX)
+17 IF Y=-1
DO BMES^XPDUTL("Option: "_RAX_" was not found!")
QUIT
+18 SET RAITEM(RAX)=Y
+19 QUIT
End DoDot:1
+20 ;
+21 IF ($DATA(RAITEM)\10)=0
Begin DoDot:1
+22 DO BMES^XPDUTL("Exiting: There are no '"_RAMENU_"' menu ITEMS to be removed.")
+23 QUIT
End DoDot:1
QUIT
+24 ;
+25 ; Remove the options, save as subscripts from the menu identifed
+26 ; by RAORDER.
+27 ;
+28 SET (RAX,Y)=""
+29 FOR
SET RAX=$ORDER(RAITEM(RAX))
if RAX=""
QUIT
Begin DoDot:1
+30 SET Y=$$DELETE^XPDMENU(RAMENU,RAX)
+31 ;Y = 1 success; else 0
+32 SET RATXT(1)="'"_RAX_"' was "_$SELECT(Y=0:"not ",1:"")_"removed as an ITEM"
+33 SET RATXT(2)="under the '"_RAMENU_"' menu."
+34 DO BMES^XPDUTL(.RATXT)
+35 QUIT
End DoDot:1
+36 KILL RATXT
+37 ; call ACHN (see comments below)
+38 DO ACHN
+39 QUIT
+40 ;
+41 ;// subroutines //
FIND1(RAX) ;find the option IEN based on the option name
+1 ;Input: RAX = option name
+2 ;Return: IEN option name; else -1
+3 NEW RAERR,Y
+4 SET Y=$$FIND1^DIC(19,,"X",RAX,"","","RAERR")
+5 QUIT $SELECT(Y=0!($DATA(RAERR)):-1,1:Y)
+6 ;
ACHN ;remove the "ACHN" xref file: 75.1, fld: 5
+1 ; Pre-"ACHN" deletion defn
+2 ;^DD(75.1,5,1,0)="^.1^^-1" ^DD(75.1,5,1,2,0)="75.1^ACHN^MUMPS"
+3 ;^DD(75.1,5,1,2,1)="D:$$ORVR^RAORDU()=2.5&((X=1)!(X=3)) CH^RADD2(DA,X)"
+4 ;^DD(75.1,5,1,2,2)="Q" ^DD(75.1,5,1,2,3)="Do not delete."
+5 ;
+6 ; delete the REQUEST STATUS "ACHN" xref (xref #: 2)
+7 ; results are recorded in RARSLT
+8 ; errors, if any, are recorded in RAERR.
+9 ; - RADD2 has no IAs
+10 ; - there are no external calls to CH^RADD2
+11 ; (vivian dot worldvista dot org)
+12 ; The CH tag is to be removed from RADD2.
+13 ;
+14 KILL RARSLT,RAERR
DO DELIX^DDMOD(75.1,5,2,"","RARSLT","RAERR")
+15 IF $DATA(RAERR)
Begin DoDot:1
+16 DO BMES^XPDUTL("Error when trying to delete the ""ACHN"" xref (75.1; 5).")
+17 QUIT
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 DO BMES^XPDUTL("The ""ACHN"" xref (75.1; 5) was successfully deleted.")
+20 if $GET(RARSLT("DDAUD"))=1
DO BMES^XPDUTL("""ACHN"" deletion was recorded in the DD AUDIT (#.6) file.")
+21 ;national no longer compiles input tempates or cross-references on this file.
+22 QUIT
End DoDot:1
EXIT ;clean up
+1 KILL RARSLT,RAERR
+2 QUIT
+3 ;
