source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RASYS.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.3 KB
RevLine 
[613]1RASYS ;HISC/CAH AISC/TMP-System Definition Menu ;11/13/96 14:17
2 ;;5.0;Radiology/Nuclear Medicine;**42**;Mar 16, 1998
31 ;;Division Parameter Set-up
4 S DIC="^RA(79,",DIC(0)="AELMQ",DIC("A")="Select Division: ",DLAYGO=79
5 D ^DIC K DIC,DLAYGO I Y<0 K X,Y G Q1
6 S DA=+Y,DIE="^RA(79,",DR="[RA DIVISION PARAMETERS]",RAXIT=0 D ^DIE
7 I $O(^RA(79,DA,"L",0)) D
8 . D:'$D(IOF) HOME^%ZIS W @IOF S RAINC=0
9 . F S RAINC=$O(^RA(79,DA,"L",RAINC)) Q:RAINC'>0 D Q:RAXIT
10 .. D EN1^RASYS1($P($G(^RA(79,DA,"L",RAINC,0)),"^"))
11 .. Q
12 . Q
13 K %,%X,%Y,C,D0,DA,DE,DQ,DIE,DR,RAINC,RAXIT D Q1 W ! G 1
14Q1 K D,DDC,DG,DI,DIG,DIH,DIU,DIV,DIW,DISYS,DST,DUOUT,I,J,POP
15 Q
16 ;
172 ;;Print Division Parameter List
18 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
19 ;
203 ;;Location Parameter Set-up
21 S DIC="^RA(79.1,",DIC(0)="AELMQZ",DIC("A")="Select Location: ",DLAYGO=79.1
22 D ^DIC K DIC,DLAYGO I Y<0 D KILL3 Q ; DIC(0)="AELMQZ" patch 42 'Z' added
23 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. * ",!
24 W:$P(Y,U,3)'=1 ! W !,"Imaging Location: ",Y(0,0) ; patch 42
25 S DA=+Y,DIE="^RA(79.1,",DR="[RA LOCATION PARAMETERS]",RAXIT=0 D ^DIE
26 D:'$D(IOF) HOME^%ZIS W @IOF D EN1^RASYS1(DA) D KILL3 W ! G 3
27KILL3 K %,%X,%W,%Y,D,E,DE,DA,D0,RAREQPRT,DIE,DIV,DQ,DR,RAFLH,RAJAC,RARPT,RAXIT,X,Y
28 K C,DDH,DI,DIG,DIH,DISYS,DIU,DIW,DIWI,I,POP,RALERT,RALINE
29 Q
30 ;
314 ;;Imaging Location Parameter List
32 N RAINA S RAINA=0 K DIR,DIROUT,DIRUT,DTOUT,DUOUT
33 S DIR(0)="Y",DIR("B")="No"
34 S DIR("A")="Do you wish to include inactive Imaging Locations"
35 S DIR("?",1)="Enter 'Yes' if inactive Imaging Locations are to be"
36 S DIR("?")="included, 'No' if only active locations are desired."
37 D ^DIR S:$D(DIRUT) RAINA=-1
38 K DIR,DIROUT,DIRUT,DTOUT,DUOUT G:RAINA<0 KILL
39 S RAINA=Y ; 1 if inactives are included, 0 if only actives included
40 N RAX,RAY S RAX=$$LOC^RAUTL12(RAINA) G:'RAX KILL
41 S RAY="Rad/Nuc Med Imaging Location Parameter List"
42 S DIC="^RA(79.1,",BY="[RA IMAGE LOC LIST]",L=0
43 S DIS(0)="I $$INA^RASYS(D0)"
44 S RAPOP=$$ZIS(RAY)
45 I +RAPOP D HOME^%ZIS,KILL Q
46 I +$P(RAPOP,"^",2) D KILL Q ; Q'ed off in ZIS subroutine
47 E D ENTASK ; not queued, to run now
48 Q
49 ;
505 ;;Camera/Equip/Room Entry/Edit
51 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
52 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
53KILL5 K D,DG,DI,DISYS,I,POP Q
54 ;
556 ;;List of Camera/Equip/Rooms
56 S DIC="^RA(79.1,",L=0,BY="[RA EXAM ROOM LIST]"
57 S DIOEND="D NOLOC^RASYS" D EN1^DIP
58 K DIOEND,FLDS,BY,DHD,TO,FR,RANOLOC,POP
59 Q
60ENTASK ; Entry point for the tasked job.
61 S RAIOP=ION_";"_IOST_";"_IOM_";"_IOSL,IOP=RAIOP
62 S:$E(IOP,1,3)="HFS" %ZIS("HFSNAME")=IO,%ZIS("HFSMODE")="W"
63 D EN1^DIP
64 D KILL^RASYS
65 Q
66INA(RAD0) ; Determine if an Imaging Location is inactive.
67 ; Input : 'RAD0' ien of file 79.1
68 ; Output: '1' if the location is valid, '0' if invalid
69 N RA791 S RA791=$G(^RA(79.1,D0,0))
70 S RA791(1)=$$XTERNAL^RAUTL5($P(RA791,"^"),$P($G(^DD(79.1,.01,0)),"^",2))
71 Q:'($D(^TMP($J,"RA L-TYPE",RA791(1),D0))#2) 0 ; not user selected
72 Q 1
73KILL ; Kill and quit
74 K ^TMP($J,"RA L-TYPE"),%X,%XX,%Y,%YY
75 K %ZIS,BY,DHD,DIC,DIS,DTOUT,DUOUT,FLDS,FR,L,POP,RAIOP,RAINA,RAPOP,TO
76 K X,Y,ZTDESC,ZTRTN,ZTSAVE,POP,I
77 Q
78NOLOC ;print camera/equip/rm's not assigned to any imaging loc
79 I $D(RANOLOC) Q
80 N R1,R2,R3,RACAM,R4 S R4=0
81 S R1=0 F S R1=$O(^RA(78.6,R1)) Q:'R1 S RACAM(R1)=""
82 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
83 . S R1=$G(^RA(79.1,R2,"R",R3,0))
84 . K RACAM(R1)
85 S R1=0 F S R1=$O(RACAM(R1)) W:'R1 # Q:'R1 D
86 . W:R4 ! S R4=1 W ?3,$E($P(^RA(78.6,R1,0),U),1,15),?20,"**UNASSIGNED**",?45,"**UNASSIGNED**"
87 S RANOLOC=1 Q
88INACT ; write inactive flag, called by 'List of Camera/Equip/Rms' option
89 Q:$G(DDDD0)=""
90 N RA1,RA2 S RA1=$O(^RA(78.6,"B",DDDD0,0)),RA2=0
91 I RA1 I $G(^RA(78.6,RA1,0))]"",$P(^(0),U,3)]"" S RA2=1
92 W ?0,$S(RA2:"(*)",1:" "),$E(DDDD0,1,15)
93 Q
94ZIS(RA) ; Select a device.
95 ; 'RAPOP'=device selection successful (1:no) ^ '^%ZTLOAD' called (1:yes)
96 K %ZIS,IOP S %ZIS="NMQ"
97 W ! S %ZIS("A")="DEVICE: " D ^%ZIS
98 S RAPOP=POP_"^"
99 I '+RAPOP,($D(IO("Q"))) D
100 . K IO("Q") S ZTDESC=RA,ZTRTN="ENTASK^RASYS"
101 . D ZTSAVE,^%ZTLOAD S $P(RAPOP,"^",2)=1
102 . I +$G(ZTSK) W !?3,"Request Queued, Task #: ",$G(ZTSK)
103 . D HOME^%ZIS
104 . Q
105 Q RAPOP
106ZTSAVE ; Save off variables for the tasked job.
107 N I F I="BY","DIC","FLDS","FR","L","RAINA","TO" S ZTSAVE(I)=""
108 S:($D(DIS)\10) ZTSAVE("DIS(")=""
109 S:($D(DHD)#2) ZTSAVE("DHD")=""
110 S:($D(^TMP($J,"RA L-TYPE"))\10) ZTSAVE("^TMP($J,""RA L-TYPE"",")=""
111 Q
112RDEV ; Select a Resource Device for a division. This subroutine is linked
113 ; directly to the option: RA RESOURCE DEVICE. This option is a menu
114 ; item under the RA SITEMANAGER menu option.
115 N %,%X,%Y,C,D,D0,DA,DDER,DDH,DI,DIC,DIE,DQ,DR,X,Y S (DIC,DIE)="^RA(79,"
116 S DIC(0)="QEAMZ",DIC("A")="Select a Rad/Nuc Med Division: " D ^DIC
117 G:Y'>0 QRDEV S DA=+Y,DR="D RDEVHLP^RASYS;100" D ^DIE
118QRDEV K DISYS,DST,I,POP
119 Q
120RDEVHLP ; Display the Description Text for the Resource Device (#100) field
121 ; on the Rad/Nuc Med Division file.
122 N RA100DES,Z S Z=0 D FIELD^DID(79,100,"","DESCRIPTION","RA100DES")
123 Q:'$D(RA100DES("DESCRIPTION")) W !
124 F S Z=$O(RA100DES("DESCRIPTION",Z)) Q:Z'>0 D
125 . W !,$G(RA100DES("DESCRIPTION",Z))
126 . Q
127 W !
128 Q
Note: See TracBrowser for help on using the repository browser.