Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RASITE

RASITE.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Note: tag DD71 code removed with RA*5.0*194
  1. ;
  1. 2 ;;Device Specifications
  1. F D Q:%
  1. . W !!,"Do you want to see a 'help' message on printer assignment"
  1. . S %=2 D YN^DICN
  1. . I %=0 W !!?3,"Enter 'Yes' to see the help message, or 'No' not to."
  1. . Q
  1. I %=-1 D Q2 QUIT
  1. I %=1 D DEVHLP
  1. 21 ; Select an existing imaging location & answer the default printer prompts.
  1. ; *** INC27764882: P205/Ski Removes LAYGO access & references to the variable 'DLAYGO'. ***
  1. W ! S DIC="^RA(79.1,",DIC(0)="AEMQ",DIC("A")="Select Imaging Location: " D ^DIC K DIC G Q2:Y<0
  1. S DA=+Y,DIE="^RA(79.1,",DR="[RA SITE MANAGER]" D ^DIE
  1. D ARP ;After hours printer parameters (set/delete) ;P185/KLM
  1. K DE,DQ,DIE,DR D Q2 G 21
  1. Q2 K %,%W,%X,%Y,C,D,D0,D1,DA,DI,DIWF,DIWL,DIW,DIWR,DIWT,DN,I,POP,RAI,RAJ,X,Y,Z
  1. K DISYS,RA791,RA792
  1. Q
  1. ;
  1. 3 ;;Failsoft Parameters
  1. 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
  1. Q3 K I,POP,DDER,DDH,DISYS Q
  1. ;
  1. 5 ;;Imaging Type Activity Log
  1. 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
  1. ;
  1. ITYPE(X) ;get image type for procedure in 71
  1. ;INPUT = IEN of Rad/Nuc Med Procedure file, in X
  1. ;OUTPUT = IEN of imaging type file (79.2)^name (.01)^abbreviation (3)
  1. S RASERIES=$S($P($G(^RAMIS(71,+X,0)),U,6)="S":1,1:0)
  1. S X=+$P($G(^RAMIS(71,X,0)),U,12)
  1. Q $$IMAG(X)
  1. ;
  1. IMAG(X) ;set string of passed image type
  1. ;INPUT=ien of image type, in x
  1. ;OUTPUT=Internal Entry Number of image type^name (.01)^abbreviation (3)
  1. N Y
  1. S Y=$G(^RA(79.2,X,0))
  1. Q +X_U_$P(Y,U)_U_$P(Y,U,3)
  1. ;
  1. DEVHLP ; Display printer assignment help text to the user.
  1. ;Add registered request printer to help text -P137/KLM
  1. ;185 - Add Alternate request printer to help text
  1. D HOME^%ZIS W @IOF
  1. W !,"Default Printer Assignments:",!,"----------------------------"
  1. W !,"There are seven imaging location parameters that the coordinator will"
  1. W !,"not be able to enter. They are the default printers; specifically, the"
  1. W !,"default flash card/exam label, jacket label, request, registered request,"
  1. W !,"alternate request, request cancellation, radiopharmaceutical dosage ticket,"
  1. W !,"and report printers. Once you have assigned these printer names to a location,"
  1. W !,"the module will automatically route output to the appropriate printer"
  1. W !,"without having to ask the user. NOTE: If you have more than one imaging"
  1. W !,"location within an imaging type the Division parameter 'Ask Imaging Location'"
  1. W !,"must be set to 'yes' in order to print cancelled requests on the request"
  1. W !,"cancellation printer."
  1. Q
  1. ARP ;Set After Hours Request Printer parameters.
  1. ;Called from option RA DEVICE
  1. ;File 79.1 APR node contains the following parameters
  1. ;which should be set if an after hours printer (ARP;1) is defined
  1. ;ARP;1 81 ALTERNATE REQUEST PRINTER <-Pntr [P3.5']
  1. ;ARP;2 82 PRINTER USAGE? [S]
  1. ;ARP;3 83 AFTER HOURS BEGIN TIME [Ft13]
  1. ;ARP;4 84 AFTER HOURS END TIME [Ft13]
  1. ;ARP;5 85 AFTER HOURS WEEKEND? [S]
  1. ;ARP;6 86 AFTER HOURS HOLIDAY? [S]
  1. ;ARP;7 87 AFTER HOURS CATEGORY OF EXAM [S]
  1. ;ARPL;0 88 ALTERNATE PRT REQUESTING LOC <-Mult [79.188PA]
  1. ; -0;1 .01 -ALTERNATE PRT REQUESTING LOC <-Pntr [P44']
  1. ;
  1. N RARP,RADA,RAPU,RADA1 S RADA1=DA
  1. K DR,DIE S DIE="^RA(79.1,"
  1. S RARP=$G(^RA(79.1,DA,"ARP"))
  1. I +RARP=0 D DEL Q ;no printer defined
  1. S RAPU=$P(RARP,U,2) I $G(RAPU)="" W !,"Usage required - must delete..." D DEL Q ;Usage not defined
  1. I RAPU=1 D Q ;check after hours params
  1. .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
  1. .I $P(RARP,U,7)="" W !,"Category required - must delete..." D DEL Q ;Category not defined
  1. .Q
  1. I RAPU=2 D Q ;check alt params
  1. .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
  1. Q
  1. SETIME(DA,RAFLD) ;called from [RA SITE MANAGER] input template
  1. ;RAFLD is 83 or 84 (begin time/end time)
  1. Q:DA=""!(RAFLD="")
  1. N DIR,Y
  1. S DIR(0)="79.1,"_RAFLD_"^^K:$$SCRX^RASITE(RAFLD,X) X"
  1. D ^DIR
  1. Q Y
  1. SCRX(RAFLD,X) ;input transform (cannot add to DD)
  1. N %DT,Y
  1. S X="T@"_X,%DT="RS"
  1. D ^%DT I Y<0 Q 1
  1. S X=$E(Y_"0000",9,12)
  1. I RAFLD=83,(X<1200) Q 1
  1. I RAFLD=84,(X>1159) Q 1
  1. Q 0
  1. DEL ;Required field missing - delete all
  1. K DR,DIE S DIE="^RA(79.1,"
  1. S DR="81///@;82///@;83///@;84///@;85///@;86///@;87///@" D ^DIE
  1. K DR,DIE
  1. S RADA=0 F S RADA=$O(^RA(79.1,RADA1,"ARPL",RADA)) Q:RADA="" D
  1. .S DA=RADA
  1. .S DA(1)=RADA1,DIE="^RA(79.1,"_DA(1)_",""ARPL"",",DR=".01///@" D ^DIE
  1. .Q
  1. Q