RASITE ;HISC/CAH,FPT,GJC AISC/MJK,RMO - IRM Menu ; Jun 29, 2023@13:46:33
;;5.0;Radiology/Nuclear Medicine;**137,185,194,205**;Mar 16, 1998;Build 1
;
; Note: tag DD71 code removed with RA*5.0*194
;
2 ;;Device Specifications
F D Q:%
. W !!,"Do you want to see a 'help' message on printer assignment"
. S %=2 D YN^DICN
. I %=0 W !!?3,"Enter 'Yes' to see the help message, or 'No' not to."
. Q
I %=-1 D Q2 QUIT
I %=1 D DEVHLP
21 ; Select an existing imaging location & answer the default printer prompts.
; *** INC27764882: P205/Ski Removes LAYGO access & references to the variable 'DLAYGO'. ***
W ! S DIC="^RA(79.1,",DIC(0)="AEMQ",DIC("A")="Select Imaging Location: " D ^DIC K DIC G Q2:Y<0
S DA=+Y,DIE="^RA(79.1,",DR="[RA SITE MANAGER]" D ^DIE
D ARP ;After hours printer parameters (set/delete) ;P185/KLM
K DE,DQ,DIE,DR D Q2 G 21
Q2 K %,%W,%X,%Y,C,D,D0,D1,DA,DI,DIWF,DIWL,DIW,DIWR,DIWT,DN,I,POP,RAI,RAJ,X,Y,Z
K DISYS,RA791,RA792
Q
;
3 ;;Failsoft Parameters
S DIC="^RA(79.2,",DIC(0)="AEMQ" D ^DIC K DIC G:Y<0 Q3 S DA=+Y,DIE="^RA(79.2,",DIE("NO^")="",DR="[RA IMAGE PARAMETERS]" D ^DIE K %,%DT,%X,%Y,D,D0,D1,DA,DE,DI,DLAYGO,DQ,DIE,DR,DIC,X
Q3 K I,POP,DDER,DDH,DISYS Q
;
5 ;;Imaging Type Activity Log
S L=0,DIC="^RA(79.2,",FLDS="[RA ACTIVITY LOG]",FR="A",TO="ZZZZ",BY="#.01" D EN1^DIP K FR,TO,FLDS,BY,DHD,POP Q
;
ITYPE(X) ;get image type for procedure in 71
;INPUT = IEN of Rad/Nuc Med Procedure file, in X
;OUTPUT = IEN of imaging type file (79.2)^name (.01)^abbreviation (3)
S RASERIES=$S($P($G(^RAMIS(71,+X,0)),U,6)="S":1,1:0)
S X=+$P($G(^RAMIS(71,X,0)),U,12)
Q $$IMAG(X)
;
IMAG(X) ;set string of passed image type
;INPUT=ien of image type, in x
;OUTPUT=Internal Entry Number of image type^name (.01)^abbreviation (3)
N Y
S Y=$G(^RA(79.2,X,0))
Q +X_U_$P(Y,U)_U_$P(Y,U,3)
;
DEVHLP ; Display printer assignment help text to the user.
;Add registered request printer to help text -P137/KLM
;185 - Add Alternate request printer to help text
D HOME^%ZIS W @IOF
W !,"Default Printer Assignments:",!,"----------------------------"
W !,"There are seven imaging location parameters that the coordinator will"
W !,"not be able to enter. They are the default printers; specifically, the"
W !,"default flash card/exam label, jacket label, request, registered request,"
W !,"alternate request, request cancellation, radiopharmaceutical dosage ticket,"
W !,"and report printers. Once you have assigned these printer names to a location,"
W !,"the module will automatically route output to the appropriate printer"
W !,"without having to ask the user. NOTE: If you have more than one imaging"
W !,"location within an imaging type the Division parameter 'Ask Imaging Location'"
W !,"must be set to 'yes' in order to print cancelled requests on the request"
W !,"cancellation printer."
Q
ARP ;Set After Hours Request Printer parameters.
;Called from option RA DEVICE
;File 79.1 APR node contains the following parameters
;which should be set if an after hours printer (ARP;1) is defined
;ARP;1 81 ALTERNATE REQUEST PRINTER <-Pntr [P3.5']
;ARP;2 82 PRINTER USAGE? [S]
;ARP;3 83 AFTER HOURS BEGIN TIME [Ft13]
;ARP;4 84 AFTER HOURS END TIME [Ft13]
;ARP;5 85 AFTER HOURS WEEKEND? [S]
;ARP;6 86 AFTER HOURS HOLIDAY? [S]
;ARP;7 87 AFTER HOURS CATEGORY OF EXAM [S]
;ARPL;0 88 ALTERNATE PRT REQUESTING LOC <-Mult [79.188PA]
; -0;1 .01 -ALTERNATE PRT REQUESTING LOC <-Pntr [P44']
;
N RARP,RADA,RAPU,RADA1 S RADA1=DA
K DR,DIE S DIE="^RA(79.1,"
S RARP=$G(^RA(79.1,DA,"ARP"))
I +RARP=0 D DEL Q ;no printer defined
S RAPU=$P(RARP,U,2) I $G(RAPU)="" W !,"Usage required - must delete..." D DEL Q ;Usage not defined
I RAPU=1 D Q ;check after hours params
.I ($P($G(^RA(79.1,DA,"ARP")),U,3)="")!($P($G(^RA(79.1,DA,"ARP")),U,4)="") W !,"Time entries required - must delete..." D DEL Q
.I $P(RARP,U,7)="" W !,"Category required - must delete..." D DEL Q ;Category not defined
.Q
I RAPU=2 D Q ;check alt params
.I ($P($G(^RA(79.1,DA,"ARP")),U,7)="")&('$O(^RA(79.1,DA,"ARPL",0))) W !,"Category or location required - must delete..." D DEL Q
Q
SETIME(DA,RAFLD) ;called from [RA SITE MANAGER] input template
;RAFLD is 83 or 84 (begin time/end time)
Q:DA=""!(RAFLD="")
N DIR,Y
S DIR(0)="79.1,"_RAFLD_"^^K:$$SCRX^RASITE(RAFLD,X) X"
D ^DIR
Q Y
SCRX(RAFLD,X) ;input transform (cannot add to DD)
N %DT,Y
S X="T@"_X,%DT="RS"
D ^%DT I Y<0 Q 1
S X=$E(Y_"0000",9,12)
I RAFLD=83,(X<1200) Q 1
I RAFLD=84,(X>1159) Q 1
Q 0
DEL ;Required field missing - delete all
K DR,DIE S DIE="^RA(79.1,"
S DR="81///@;82///@;83///@;84///@;85///@;86///@;87///@" D ^DIE
K DR,DIE
S RADA=0 F S RADA=$O(^RA(79.1,RADA1,"ARPL",RADA)) Q:RADA="" D
.S DA=RADA
.S DA(1)=RADA1,DIE="^RA(79.1,"_DA(1)_",""ARPL"",",DR=".01///@" D ^DIE
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRASITE 5168 printed Jun 11, 2024@22:23:19 Page 2
RASITE ;HISC/CAH,FPT,GJC AISC/MJK,RMO - IRM Menu ; Jun 29, 2023@13:46:33
+1 ;;5.0;Radiology/Nuclear Medicine;**137,185,194,205**;Mar 16, 1998;Build 1
+2 ;
+3 ; Note: tag DD71 code removed with RA*5.0*194
+4 ;
2 ;;Device Specifications
+1 FOR
Begin DoDot:1
+2 WRITE !!,"Do you want to see a 'help' message on printer assignment"
+3 SET %=2
DO YN^DICN
+4 IF %=0
WRITE !!?3,"Enter 'Yes' to see the help message, or 'No' not to."
+5 QUIT
End DoDot:1
if %
QUIT
+6 IF %=-1
DO Q2
QUIT
+7 IF %=1
DO DEVHLP
21 ; Select an existing imaging location & answer the default printer prompts.
+1 ; *** INC27764882: P205/Ski Removes LAYGO access & references to the variable 'DLAYGO'. ***
+2 WRITE !
SET DIC="^RA(79.1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select Imaging Location: "
DO ^DIC
KILL DIC
if Y<0
GOTO Q2
+3 SET DA=+Y
SET DIE="^RA(79.1,"
SET DR="[RA SITE MANAGER]"
DO ^DIE
+4 ;After hours printer parameters (set/delete) ;P185/KLM
DO ARP
+5 KILL DE,DQ,DIE,DR
DO Q2
GOTO 21
Q2 KILL %,%W,%X,%Y,C,D,D0,D1,DA,DI,DIWF,DIWL,DIW,DIWR,DIWT,DN,I,POP,RAI,RAJ,X,Y,Z
+1 KILL DISYS,RA791,RA792
+2 QUIT
+3 ;
3 ;;Failsoft Parameters
+1 SET DIC="^RA(79.2,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
if Y<0
GOTO Q3
SET DA=+Y
SET DIE="^RA(79.2,"
SET DIE("NO^")=""
SET DR="[RA IMAGE PARAMETERS]"
DO ^DIE
KILL %,%DT,%X,%Y,D,D0,D1,DA,DE,DI,DLAYGO,DQ,DIE,DR,DIC,X
Q3 KILL I,POP,DDER,DDH,DISYS
QUIT
+1 ;
5 ;;Imaging Type Activity Log
+1 SET L=0
SET DIC="^RA(79.2,"
SET FLDS="[RA ACTIVITY LOG]"
SET FR="A"
SET TO="ZZZZ"
SET BY="#.01"
DO EN1^DIP
KILL FR,TO,FLDS,BY,DHD,POP
QUIT
+2 ;
ITYPE(X) ;get image type for procedure in 71
+1 ;INPUT = IEN of Rad/Nuc Med Procedure file, in X
+2 ;OUTPUT = IEN of imaging type file (79.2)^name (.01)^abbreviation (3)
+3 SET RASERIES=$SELECT($PIECE($GET(^RAMIS(71,+X,0)),U,6)="S":1,1:0)
+4 SET X=+$PIECE($GET(^RAMIS(71,X,0)),U,12)
+5 QUIT $$IMAG(X)
+6 ;
IMAG(X) ;set string of passed image type
+1 ;INPUT=ien of image type, in x
+2 ;OUTPUT=Internal Entry Number of image type^name (.01)^abbreviation (3)
+3 NEW Y
+4 SET Y=$GET(^RA(79.2,X,0))
+5 QUIT +X_U_$PIECE(Y,U)_U_$PIECE(Y,U,3)
+6 ;
DEVHLP ; Display printer assignment help text to the user.
+1 ;Add registered request printer to help text -P137/KLM
+2 ;185 - Add Alternate request printer to help text
+3 DO HOME^%ZIS
WRITE @IOF
+4 WRITE !,"Default Printer Assignments:",!,"----------------------------"
+5 WRITE !,"There are seven imaging location parameters that the coordinator will"
+6 WRITE !,"not be able to enter. They are the default printers; specifically, the"
+7 WRITE !,"default flash card/exam label, jacket label, request, registered request,"
+8 WRITE !,"alternate request, request cancellation, radiopharmaceutical dosage ticket,"
+9 WRITE !,"and report printers. Once you have assigned these printer names to a location,"
+10 WRITE !,"the module will automatically route output to the appropriate printer"
+11 WRITE !,"without having to ask the user. NOTE: If you have more than one imaging"
+12 WRITE !,"location within an imaging type the Division parameter 'Ask Imaging Location'"
+13 WRITE !,"must be set to 'yes' in order to print cancelled requests on the request"
+14 WRITE !,"cancellation printer."
+15 QUIT
ARP ;Set After Hours Request Printer parameters.
+1 ;Called from option RA DEVICE
+2 ;File 79.1 APR node contains the following parameters
+3 ;which should be set if an after hours printer (ARP;1) is defined
+4 ;ARP;1 81 ALTERNATE REQUEST PRINTER <-Pntr [P3.5']
+5 ;ARP;2 82 PRINTER USAGE? [S]
+6 ;ARP;3 83 AFTER HOURS BEGIN TIME [Ft13]
+7 ;ARP;4 84 AFTER HOURS END TIME [Ft13]
+8 ;ARP;5 85 AFTER HOURS WEEKEND? [S]
+9 ;ARP;6 86 AFTER HOURS HOLIDAY? [S]
+10 ;ARP;7 87 AFTER HOURS CATEGORY OF EXAM [S]
+11 ;ARPL;0 88 ALTERNATE PRT REQUESTING LOC <-Mult [79.188PA]
+12 ; -0;1 .01 -ALTERNATE PRT REQUESTING LOC <-Pntr [P44']
+13 ;
+14 NEW RARP,RADA,RAPU,RADA1
SET RADA1=DA
+15 KILL DR,DIE
SET DIE="^RA(79.1,"
+16 SET RARP=$GET(^RA(79.1,DA,"ARP"))
+17 ;no printer defined
IF +RARP=0
DO DEL
QUIT
+18 ;Usage not defined
SET RAPU=$PIECE(RARP,U,2)
IF $GET(RAPU)=""
WRITE !,"Usage required - must delete..."
DO DEL
QUIT
+19 ;check after hours params
IF RAPU=1
Begin DoDot:1
+20 IF ($PIECE($GET(^RA(79.1,DA,"ARP")),U,3)="")!($PIECE($GET(^RA(79.1,DA,"ARP")),U,4)="")
WRITE !,"Time entries required - must delete..."
DO DEL
QUIT
+21 ;Category not defined
IF $PIECE(RARP,U,7)=""
WRITE !,"Category required - must delete..."
DO DEL
QUIT
+22 QUIT
End DoDot:1
QUIT
+23 ;check alt params
IF RAPU=2
Begin DoDot:1
+24 IF ($PIECE($GET(^RA(79.1,DA,"ARP")),U,7)="")&('$ORDER(^RA(79.1,DA,"ARPL",0)))
WRITE !,"Category or location required - must delete..."
DO DEL
QUIT
End DoDot:1
QUIT
+25 QUIT
SETIME(DA,RAFLD) ;called from [RA SITE MANAGER] input template
+1 ;RAFLD is 83 or 84 (begin time/end time)
+2 if DA=""!(RAFLD="")
QUIT
+3 NEW DIR,Y
+4 SET DIR(0)="79.1,"_RAFLD_"^^K:$$SCRX^RASITE(RAFLD,X) X"
+5 DO ^DIR
+6 QUIT Y
SCRX(RAFLD,X) ;input transform (cannot add to DD)
+1 NEW %DT,Y
+2 SET X="T@"_X
SET %DT="RS"
+3 DO ^%DT
IF Y<0
QUIT 1
+4 SET X=$EXTRACT(Y_"0000",9,12)
+5 IF RAFLD=83
IF (X<1200)
QUIT 1
+6 IF RAFLD=84
IF (X>1159)
QUIT 1
+7 QUIT 0
DEL ;Required field missing - delete all
+1 KILL DR,DIE
SET DIE="^RA(79.1,"
+2 SET DR="81///@;82///@;83///@;84///@;85///@;86///@;87///@"
DO ^DIE
+3 KILL DR,DIE
+4 SET RADA=0
FOR
SET RADA=$ORDER(^RA(79.1,RADA1,"ARPL",RADA))
if RADA=""
QUIT
Begin DoDot:1
+5 SET DA=RADA
+6 SET DA(1)=RADA1
SET DIE="^RA(79.1,"_DA(1)_",""ARPL"","
SET DR=".01///@"
DO ^DIE
+7 QUIT
End DoDot:1
+8 QUIT
