- 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 Feb 19, 2025@00:06:05 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