source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAMAINP.m@ 940

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1RAMAINP ;HISC/GJC AISC/TMP,RMO-Utility Files Print ;9/22/98 15:26
2 ;;5.0;Radiology/Nuclear Medicine;**3,19,34**;Mar 16, 1998
32 ;;Long Active Procedure List
4 D KILL N RAX,RAY,RA1,RA2,RA3 S RAX=$$IMG^RAUTL12() Q:'RAX
5 S RAY="Rad/Nuc Med Active Procedures (Long)"
6 S DIC="^RAMIS(71,",L=0,FLDS="[RA PROCEDURE LIST]"
7 S BY=.01,(FR,TO)=""
8 S DHD="Active Radiology/Nuclear Medicine Procedures (Long)"
9 S DHIT="S $P(RALINE,""-"",(IOM+1))="""" W !,RALINE"
10 S DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),($$IMG^RAMAINP(D0))"
11 W ! D 132 S RAPOP=$$ZIS(RAY)
12 I +RAPOP D HOME^%ZIS,KILL Q ; device selection failed
13 I +$P(RAPOP,"^",2) D KILL Q
14 E D ENTASK
15 Q
16 ;
173 ;;Major AMIS Code Print
18 S DIC="^RAMIS(71.1,",L=0,FLDS=".001,.01,2",FR="",TO="",BY=".001",DHD="Major AMIS Codes" D EN1^DIP K FLDS,BY,FR,TO,DHD,POP Q
19 ;
204 ;;Film Sizes Print
21 S DIC="^RA(78.4,",L=0,FLDS="[RA FILM SIZE]",BY="",TO="",FR=""
22 D EN1^DIP K BY,DIJ,DP,FLDS,FR,P,TO,X,POP Q
23 ;
245 ;;Diagnostic Code Print
25 S DIC="^RA(78.3,",L=0,FLDS="[RA DIAGNOSTIC CODE PRINT]",BY=".001",FR="",TO="",DHD="Diagnostic Codes" D EN1^DIP K FLDS,BY,FR,TO,DHD,POP Q
26 ;
276 ;;Flash Card/Label Formatter Print
28 S L=0,DIC="^RA(78.2,",FLDS="[RA FLASH PRINT]",BY="[RA FLASH PRINT]",FR="",TO="",DHD="Exam Label/Report Header/Report Footer/Flash Card Formats" D EN1^DIP K L,FLDS,BY,FR,TO,DHD,POP Q
29 ;
307 ;;Complication Type Print
31 S L=0,DIC="^RA(78.1,",FLDS=".01,2",BY="",FR="",TO="",DHD="Complication Types" D EN1^DIP K %DT,%X,%Y,FLDS,BY,FR,TO,DHD,POP,ZTSK Q
32 ;
338 ;;Contract/Sharing Agreements Print
34 S DIC="^DIC(34,",L=0,FLDS=".01,2,3",BY="",TO="",FR="",DHD="Contract/Sharing Agreements" D EN1^DIP K BY,DHD,FLDS,FR,POP,TO,X Q
35 ;
369 ;;Short Active Procedure List
37 D KILL N RAX,RAY,RA1,RA2 S RAX=$$IMG^RAUTL12() Q:'RAX
38 S RAY="Rad/Nuc Med Active Procedures (Short)"
39 S DIC="^RAMIS(71,",L=0,FLDS="[RA PROCEDURE SHORT LIST]"
40 S BY=.01,(FR,TO)=""
41 S DHD="Active Radiology/Nuclear Medicine Procedures (Short)"
42 S DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),($$IMG^RAMAINP(D0))"
43 W ! D 132 S RAPOP=$$ZIS(RAY)
44 I +RAPOP D HOME^%ZIS,KILL Q ; device selection failed
45 I +$P(RAPOP,"^",2) D KILL Q
46 E D ENTASK
47 Q
48 ;
4910 ;;Long Inactive Procedure List
50 D KILL N RAX,RAY,RA1,RA2,RA3 S RAX=$$IMG^RAUTL12() Q:'RAX
51 S RAY="Rad/Nuc Med Inactive Procedures (Long)"
52 S DIC="^RAMIS(71,",L=0,FLDS="[RA PROCEDURE LIST]"
53 S BY=.01,(FR,TO)=""
54 S DHD="Inactive Radiology/Nuclear Medicine Procedures (Long)"
55 S DHIT="S $P(RALINE,""-"",(IOM+1))="""" W !,RALINE"
56 S DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):0,'^(""I""):0,DT'>^(""I""):0,1:1),($$IMG^RAMAINP(D0))"
57 W ! D 132 S RAPOP=$$ZIS(RAY)
58 I +RAPOP D HOME^%ZIS,KILL Q ; device selection failed
59 I +$P(RAPOP,"^",2) D KILL Q
60 E D ENTASK
61 Q
62 ;
6311 ;;Short Inactive Procedure List
64 D KILL N RAX,RAY
65 S RAX=$$IMG^RAUTL12() I 'RAX D KILL Q
66 S RAY="Rad/Nuc Med Inactive Procedures (Short)"
67 S DIC="^RAMIS(71,",L=0,FLDS="[RA PROCEDURE SHORT LIST]"
68 S BY=.01,(FR,TO)=""
69 S DHD="Inactive Radiology/Nuclear Medicine Procedures (Short)"
70 S DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):0,'^(""I""):0,DT'>^(""I""):0,1:1),($$IMG^RAMAINP(D0))"
71 W ! D 132 S RAPOP=$$ZIS(RAY)
72 I +RAPOP D HOME^%ZIS,KILL Q ; device selection failed
73 I +$P(RAPOP,"^",2) D KILL Q
74 E D ENTASK
75 Q
76 ;
7712 ;;Series Procedures Only
78 D KILL N RAX,RAY,RA1,RA2,RA3
79 S RAX=$$IMG^RAUTL12() Q:'RAX
80 S RAY="Rad/Nuc Med Series Procedures Only"
81 S DIC="^RAMIS(71,",L=0,FLDS="[RA PROCEDURE LIST]",BY="[RA SERIES ONLY]"
82 S DHD="Radiology/Nuclear Medicine Procedures (Series Only)"
83 S DHIT="S $P(RALINE,""-"",(IOM+1))="""" W !,RALINE"
84 S DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):1,'^(""I""):1,DT'>^(""I""):0,1:0),($$IMG^RAMAINP(D0))"
85 W ! D 132 S RAPOP=$$ZIS(RAY)
86 I +RAPOP D HOME^%ZIS,KILL Q ; device selection failed
87 I +$P(RAPOP,"^",2) D KILL Q
88 E D ENTASK
89 Q
90 ;
9113 ;;Standard Reports List
92 S DIC="^RA(74.1,",L=0,FLDS="[RA STANDARD REPORTS LIST]",BY="#.001",FR="",TO="" D EN1^DIP
93 K BY,DHD,FLDS,FR,POP,TO,X Q
94 ;
9514 ;;Procedure Modifiers Print
96 S DIC="^RAMIS(71.2,",L=0,FLDS=".01,4",FR="",TO="",BY="3;S1,.01"
97 S DHD="Procedure Modifiers" D EN1^DIP
98 K FLDS,BY,FR,TO,DHD,POP,DD00 Q
99 ;
10015 ;;Alpha List of Active Procedures
101 D KILL N RAX,RAY,RA1,RA2 S RAX=$$IMG^RAUTL12() Q:'RAX
102 S RAY="Rad/Nuc Med Alpha List of Active Procedures"
103 S DIC="^RAMIS(71,",L=0,FLDS="[RA ALPHA LIST OF ACTIVES]"
104 S BY="[RA ALPHA LIST OF ACTIVES]",(FR,TO)=""
105 S DIS(0)="I $$IMG^RAMAINP(D0)"
106 W ! D 132 S RAPOP=$$ZIS(RAY)
107 I +RAPOP D HOME^%ZIS,KILL Q ; device selection failed
108 I +$P(RAPOP,"^",2) D KILL Q
109 E D ENTASK
110 Q
111 ;
11216 ;;Reports Distribution List
113 S DIC="^RABTCH(74.3,",L=0,FLDS="[RA DISTRIBUTION]",BY=".01",(TO,FR)="" D EN1^DIP K BY,DHD,FLDS,FR,POP,TO,X,X1 Q
11417 ;;Rad/Nuc Med Procedure Message List
115 S DIC="^RAMIS(71.4,",L=0,FLDS=".01;S;W70",BY=.01,(FR,TO)="" D EN1^DIP K D0,FLDS,BY,FR,TO,DHD Q
116132 W !,"This report requires a 132 column output device."
117 Q
118KILL ; Kill locals, and set ZTREQ if applicable.
119 K ^TMP($J,"RA I-TYPE"),%X,%XX,%Y,%YY
120 K %ZIS,BY,DHD,DHIT,DIC,DIS,DTOUT,DUOUT,FLDS,FR,L,POP,RAIOP,RALINE,RAPOP
121 K TO,X,Y,ZTDESC,ZTRTN,ZTSAVE
122 K RADIO,RAPHARM,I,POP
123 S:$D(ZTQUEUED) ZTREQ="@"
124 Q
125IMG(RA) ; Screens procedures by I-Type. Called from the following
126 ; subroutines: 2,9,10,11,12 & 15. Contained in variable DIS(0)!
127 ; 'RA' is the ien of file 71.
128 ; return '1' if procedure is correct I-Type, else '0'!
129 N RAI,RAII S RAI=+$P($G(^RAMIS(71,RA,0)),"^",12)
130 Q:'RAI 0
131 S RAII=$P($G(^RA(79.2,RAI,0)),"^")
132 Q $S($D(^TMP($J,"RA I-TYPE",RAII,RAI))#2:1,1:0)
133ENTASK ; Entry point for tasked job.
134 ; All necessary variables are defined by the code calling ENTASK.
135 S RAIOP=ION_";"_IOST_";"_IOM_";"_IOSL,IOP=RAIOP
136 D EN1^DIP
137 D KILL^RAMAINP
138 Q
139ZIS(RA) ; Select a device
140 ; RAPOP=device selection successful ^ '^%ZTLOAD' called 1-yes
141 N RAPOP
142 K %ZIS,IOP S %ZIS="NMQ" W ! S %ZIS("A")="DEVICE: " D ^%ZIS
143 S RAPOP=POP_"^"
144 I '+RAPOP,($D(IO("Q"))) D
145 . K IO("Q") S ZTDESC=RA,ZTRTN="ENTASK^RAMAINP"
146 . D ZTSAVE,^%ZTLOAD S $P(RAPOP,"^",2)=1
147 . I +$G(ZTSK) W !?3,"Request Queued, Task #: ",$G(ZTSK)
148 . D HOME^%ZIS
149 . Q
150 Q RAPOP
151ZTSAVE ; Save variables for tasked job
152 N I F I="BY","DIC","FLDS","FR","L","TO" S ZTSAVE(I)=""
153 S:($D(DIS)\10) ZTSAVE("DIS(")=""
154 S:($D(DHD)#2) ZTSAVE("DHD")=""
155 S:($D(DHIT)#2) ZTSAVE("DHIT")=""
156 S:($D(^TMP($J,"RA I-TYPE"))\10) ZTSAVE("^TMP($J,""RA I-TYPE"",")=""
157 Q
Note: See TracBrowser for help on using the repository browser.