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

RASYS.m

Go to the documentation of this file. 
  1. RASYS ;HISC/CAH AISC/TMP-System Definition Menu ;11/13/96  14:17
  1.  ;;5.0;Radiology/Nuclear Medicine;**42,47**;Mar 16, 1998;Build 21
  1. 1 ;;Division Parameter Set-up
  1.  S DIC="^RA(79,",DIC(0)="AELMQ",DIC("A")="Select Division: ",DLAYGO=79
  1.  D ^DIC K DIC,DLAYGO I Y<0 K X,Y G Q1
  1.  S DA=+Y,DIE="^RA(79,",DR="[RA DIVISION PARAMETERS]",RAXIT=0 D ^DIE
  1.  I $O(^RA(79,DA,"L",0)) D
  1.  . D:'$D(IOF) HOME^%ZIS W @IOF S RAINC=0
  1.  . F  S RAINC=$O(^RA(79,DA,"L",RAINC)) Q:RAINC'>0  D  Q:RAXIT
  1.  .. D EN1^RASYS1($P($G(^RA(79,DA,"L",RAINC,0)),"^"))
  1.  .. Q
  1.  . Q
  1.  K %,%X,%Y,C,D0,DA,DE,DQ,DIE,DR,RAINC,RAXIT D Q1 W ! G 1
  1. Q1 K D,DDC,DG,DI,DIG,DIH,DIU,DIV,DIW,DISYS,DST,DUOUT,I,J,POP
  1.  Q
  1.  ;
  1. 2 ;;Print Division Parameter List
  1.  S DIC="^RA(79,",L=0,FLDS="[RA IMAGE DIV LIST]",BY="#DIVISION",FR="",TO="" D EN1^DIP K FR,TO,FLDS,BY,DHD Q
  1.  ;
  1. 3 ;;Location Parameter Set-up
  1.  S DIC="^RA(79.1,",DIC(0)="AELMQZ",DIC("A")="Select Location: ",DLAYGO=79.1
  1.  D ^DIC K DIC,DLAYGO I Y<0 D KILL3 Q  ; DIC(0)="AELMQZ" patch 42 'Z' added
  1.  I $P(Y,U,3)=1 W !!," *   Since you have added a new Imaging Location, remember to assign     * ",!," *   it to a Rad/Nuc Med division through Division Parameter Set-up.     * ",!
  1.  W:$P(Y,U,3)'=1 ! W !,"Imaging Location: ",Y(0,0) ; patch 42
  1.  S DA=+Y,DIE="^RA(79.1,",DR="[RA LOCATION PARAMETERS]",RAXIT=0 D ^DIE
  1.  D:'$D(IOF) HOME^%ZIS W @IOF D EN1^RASYS1(DA) D KILL3 W ! G 3
  1. KILL3 K %,%X,%W,%Y,D,E,DE,DA,D0,RAREQPRT,DIE,DIV,DQ,DR,RAFLH,RAJAC,RARPT,RAXIT,X,Y
  1.  K C,DDH,DI,DIG,DIH,DISYS,DIU,DIW,DIWI,I,POP,RALERT,RALINE
  1.  Q
  1.  ;
  1. 4 ;;Imaging Location Parameter List
  1.  N RAINA S RAINA=0 K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="Y",DIR("B")="No"
  1.  S DIR("A")="Do you wish to include inactive Imaging Locations"
  1.  S DIR("?",1)="Enter 'Yes' if inactive Imaging Locations are to be"
  1.  S DIR("?")="included, 'No' if only active locations are desired."
  1.  D ^DIR S:$D(DIRUT) RAINA=-1
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT G:RAINA<0 KILL
  1.  S RAINA=Y ; 1 if inactives are included, 0 if only actives included
  1.  N RAX,RAY S RAX=$$LOC^RAUTL12(RAINA) G:'RAX KILL
  1.  S RAY="Rad/Nuc Med Imaging Location Parameter List"
  1.  S DIC="^RA(79.1,",BY="[RA IMAGE LOC LIST]",L=0
  1.  S DIS(0)="I $$INA^RASYS(D0)"
  1.  S RAPOP=$$ZIS(RAY)
  1.  I +RAPOP D HOME^%ZIS,KILL Q
  1.  I +$P(RAPOP,"^",2) D KILL Q  ; Q'ed off in ZIS subroutine
  1.  E  D ENTASK ; not queued, to run now
  1.  Q
  1.  ;
  1. 5 ;;Camera/Equip/Room Entry/Edit
  1.  S DIC="^RA(78.6,",DIC(0)="AELMQ",DIC("A")="Select Camera/Equip/Room: ",DLAYGO=78.6 D ^DIC K DIC,DLAYGO I Y<0 K X,Y D KILL5 Q
  1.  S DA=+Y,DIE="^RA(78.6,",DR=".01:99" D ^DIE K %,D0,DA,DE,DQ,DIE,DR,X,Y D KILL5 W ! G 5
  1. KILL5 K D,DG,DI,DISYS,I,POP Q
  1.  ;
  1. 6 ;;List of Camera/Equip/Rooms
  1.  S DIC="^RA(79.1,",L=0,BY="[RA EXAM ROOM LIST]"
  1.  S DIOEND="D NOLOC^RASYS" D EN1^DIP
  1.  K DIOEND,FLDS,BY,DHD,TO,FR,RANOLOC,POP
  1.  Q
  1. ENTASK ; Entry point for the tasked job.
  1.  S RAIOP=ION_";"_IOST_";"_IOM_";"_IOSL,IOP=RAIOP
  1.  S:$E(IOP,1,3)="HFS" %ZIS("HFSNAME")=IO,%ZIS("HFSMODE")="W"
  1.  D EN1^DIP
  1.  D KILL^RASYS
  1.  Q
  1. INA(RAD0) ; Determine if an Imaging Location is inactive.
  1.  ; Input : 'RAD0'  ien of file 79.1
  1.  ; Output: '1' if the location is valid, '0' if invalid
  1.  N RA791 S RA791=$G(^RA(79.1,D0,0))
  1.  S RA791(1)=$$XTERNAL^RAUTL5($P(RA791,"^"),$P($G(^DD(79.1,.01,0)),"^",2))
  1.  Q:'($D(^TMP($J,"RA L-TYPE",RA791(1),D0))#2) 0 ; not user selected
  1.  Q 1
  1. KILL ; Kill and quit
  1.  K ^TMP($J,"RA L-TYPE"),%X,%XX,%Y,%YY
  1.  K %ZIS,BY,DHD,DIC,DIS,DTOUT,DUOUT,FLDS,FR,L,POP,RAIOP,RAINA,RAPOP,TO
  1.  K X,Y,ZTDESC,ZTRTN,ZTSAVE,POP,I
  1.  Q
  1. NOLOC ;print camera/equip/rm's not assigned to any imaging loc
  1.  I $D(RANOLOC) Q
  1.  N R1,R2,R3,RACAM,R4 S R4=0
  1.  S R1=0 F  S R1=$O(^RA(78.6,R1)) Q:'R1  S RACAM(R1)=""
  1.  S R2=0 F  S R2=$O(^RA(79.1,R2)) Q:'R2  S R3=0 F  S R3=$O(^RA(79.1,R2,"R",R3)) Q:'R3  D
  1.  . S R1=$G(^RA(79.1,R2,"R",R3,0))
  1.  . K RACAM(R1)
  1.  S R1=0 F  S R1=$O(RACAM(R1)) W:'R1 # Q:'R1  D
  1.  . W:R4 ! S R4=1 W ?3,$E($P(^RA(78.6,R1,0),U),1,15),?20,"**UNASSIGNED**",?45,"**UNASSIGNED**"
  1.  S RANOLOC=1 Q
  1. INACT ; write inactive flag, called by 'List of Camera/Equip/Rms' option
  1.  Q:$G(DDDD0)=""
  1.  N RA1,RA2 S RA1=$O(^RA(78.6,"B",DDDD0,0)),RA2=0
  1.  I RA1 I $G(^RA(78.6,RA1,0))]"",$P(^(0),U,3)]"" S RA2=1
  1.  W ?0,$S(RA2:"(*)",1:"   "),$E(DDDD0,1,15)
  1.  Q
  1. ZIS(RA) ; Select a device.
  1.  ; 'RAPOP'=device selection successful (1:no) ^ '^%ZTLOAD' called (1:yes)
  1.  K %ZIS,IOP S %ZIS="NMQ"
  1.  W ! S %ZIS("A")="DEVICE: " D ^%ZIS
  1.  S RAPOP=POP_"^"
  1.  I '+RAPOP,($D(IO("Q"))) D
  1.  . K IO("Q") S ZTDESC=RA,ZTRTN="ENTASK^RASYS"
  1.  . D ZTSAVE,^%ZTLOAD S $P(RAPOP,"^",2)=1
  1.  . I +$G(ZTSK) W !?3,"Request Queued, Task #: ",$G(ZTSK)
  1.  . D HOME^%ZIS
  1.  . Q
  1.  Q RAPOP
  1. ZTSAVE ; Save off variables for the tasked job.
  1.  N I F I="BY","DIC","FLDS","FR","L","RAINA","TO" S ZTSAVE(I)=""
  1.  S:($D(DIS)\10) ZTSAVE("DIS(")=""
  1.  S:($D(DHD)#2) ZTSAVE("DHD")=""
  1.  S:($D(^TMP($J,"RA L-TYPE"))\10) ZTSAVE("^TMP($J,""RA L-TYPE"",")=""
  1.  Q
  1. RDEV ; Select a Resource Device for a division.  This subroutine is linked
  1.  ; directly to the option: RA RESOURCE DEVICE.  This option is a menu
  1.  ; item under the RA SITEMANAGER menu option.
  1.  N %,%X,%Y,C,D,D0,DA,DDER,DDH,DI,DIC,DIE,DQ,DR,X,Y S (DIC,DIE)="^RA(79,"
  1.  S DIC(0)="QEAMZ",DIC("A")="Select a Rad/Nuc Med Division: " D ^DIC
  1.  G:Y'>0 QRDEV S DA=+Y,DR="D RDEVHLP^RASYS;100" D ^DIE
  1. QRDEV K DISYS,DST,I,POP
  1.  Q
  1. RDEVHLP ; Display the Description Text for the Resource Device (#100) field
  1.  ; on the Rad/Nuc Med Division file.
  1.  N RA100DES,Z S Z=0 D FIELD^DID(79,100,"","DESCRIPTION","RA100DES")
  1.  Q:'$D(RA100DES("DESCRIPTION"))  W !
  1.  F  S Z=$O(RA100DES("DESCRIPTION",Z)) Q:Z'>0  D
  1.  . W !,$G(RA100DES("DESCRIPTION",Z))
  1.  . Q
  1.  W !
  1.  Q
  1.  ;
  1. SACNPAR ; Site (long) Accession Number Parameter Entry/Edit
  1.  ;W !!?3,"Warning: Editing the 'USE SITE ACCESSION NUMBER?' field on a record"
  1.  ;W !?3,"in the RAD/NUC MED DIVISION file may lead to the instability of the"
  1.  ;W !?3,"VistA RADIOLOGY/NUCLEAR MEDICINE application.",!
  1.  W !!?3,"Warning: Turning on the Site Specific Accession Number should only"
  1.  W !?3,"be done in conjunction with using the RA v2.4 messaging protocols."
  1.  W !!?3,"NOTE: Changing the Site Specific Accession Number parameter at a"
  1.  W !?3,"multidivisional site will change the parameter for ALL divisions."
  1.  ;K DIC S DIC(0)="AEMQZ",DIC("A")="Select Facility to Edit: "
  1.  ;S DIC="^RA(79," D ^DIC
  1.  ;I $D(DTOUT)!($D(DUOUT))!(Y=-1) D END Q
  1.  N RAVAL S RAVAL=$O(^RA(79,0)),RAVAL=$P($G(^RA(79,RAVAL,.1)),"^",31)
  1.  W !!,"Current value of Site Specific Accession Number parameter: ",$S(RAVAL="Y":"YES",1:"NO")
  1.  S DIR(0)="YA",DIR("A")="Use Site Specific Accession Number? " D ^DIR
  1.  S DIR("?")="Answer 'YES' to turn on use of the Site Specific Accession Number or 'NO' to turn it off."
  1.  Q:$D(DIRUT)
  1.  N RAZVAL S RAZVAL="N" I Y=1 S RAZVAL="Y"
  1.  F RAZZDIV=0:0 S RAZZDIV=$O(^RA(79,RAZZDIV)) Q:RAZZDIV'>0  D
  1.  .S (DA,RADA)=+RAZZDIV,DR=".131////^S X=RAZVAL",DIE="^RA(79,"
  1.  .D ^DIE
  1.  Q
  1. END ;
  1.  K DA,DIC,DIE,DR,DTOUT,DUOUT,RADA,X,Y
  1.  Q
  1.  ;