158 lines
6.2 KiB
Mathematica
158 lines
6.2 KiB
Mathematica
RAMAINP ;HISC/GJC AISC/TMP,RMO-Utility Files Print ;9/22/98 15:26
|
|
;;5.0;Radiology/Nuclear Medicine;**3,19,34**;Mar 16, 1998
|
|
2 ;;Long Active Procedure List
|
|
D KILL N RAX,RAY,RA1,RA2,RA3 S RAX=$$IMG^RAUTL12() Q:'RAX
|
|
S RAY="Rad/Nuc Med Active Procedures (Long)"
|
|
S DIC="^RAMIS(71,",L=0,FLDS="[RA PROCEDURE LIST]"
|
|
S BY=.01,(FR,TO)=""
|
|
S DHD="Active Radiology/Nuclear Medicine Procedures (Long)"
|
|
S DHIT="S $P(RALINE,""-"",(IOM+1))="""" W !,RALINE"
|
|
S DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),($$IMG^RAMAINP(D0))"
|
|
W ! D 132 S RAPOP=$$ZIS(RAY)
|
|
I +RAPOP D HOME^%ZIS,KILL Q ; device selection failed
|
|
I +$P(RAPOP,"^",2) D KILL Q
|
|
E D ENTASK
|
|
Q
|
|
;
|
|
3 ;;Major AMIS Code Print
|
|
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
|
|
;
|
|
4 ;;Film Sizes Print
|
|
S DIC="^RA(78.4,",L=0,FLDS="[RA FILM SIZE]",BY="",TO="",FR=""
|
|
D EN1^DIP K BY,DIJ,DP,FLDS,FR,P,TO,X,POP Q
|
|
;
|
|
5 ;;Diagnostic Code Print
|
|
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
|
|
;
|
|
6 ;;Flash Card/Label Formatter Print
|
|
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
|
|
;
|
|
7 ;;Complication Type Print
|
|
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
|
|
;
|
|
8 ;;Contract/Sharing Agreements Print
|
|
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
|
|
;
|
|
9 ;;Short Active Procedure List
|
|
D KILL N RAX,RAY,RA1,RA2 S RAX=$$IMG^RAUTL12() Q:'RAX
|
|
S RAY="Rad/Nuc Med Active Procedures (Short)"
|
|
S DIC="^RAMIS(71,",L=0,FLDS="[RA PROCEDURE SHORT LIST]"
|
|
S BY=.01,(FR,TO)=""
|
|
S DHD="Active Radiology/Nuclear Medicine Procedures (Short)"
|
|
S DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),($$IMG^RAMAINP(D0))"
|
|
W ! D 132 S RAPOP=$$ZIS(RAY)
|
|
I +RAPOP D HOME^%ZIS,KILL Q ; device selection failed
|
|
I +$P(RAPOP,"^",2) D KILL Q
|
|
E D ENTASK
|
|
Q
|
|
;
|
|
10 ;;Long Inactive Procedure List
|
|
D KILL N RAX,RAY,RA1,RA2,RA3 S RAX=$$IMG^RAUTL12() Q:'RAX
|
|
S RAY="Rad/Nuc Med Inactive Procedures (Long)"
|
|
S DIC="^RAMIS(71,",L=0,FLDS="[RA PROCEDURE LIST]"
|
|
S BY=.01,(FR,TO)=""
|
|
S DHD="Inactive Radiology/Nuclear Medicine Procedures (Long)"
|
|
S DHIT="S $P(RALINE,""-"",(IOM+1))="""" W !,RALINE"
|
|
S DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):0,'^(""I""):0,DT'>^(""I""):0,1:1),($$IMG^RAMAINP(D0))"
|
|
W ! D 132 S RAPOP=$$ZIS(RAY)
|
|
I +RAPOP D HOME^%ZIS,KILL Q ; device selection failed
|
|
I +$P(RAPOP,"^",2) D KILL Q
|
|
E D ENTASK
|
|
Q
|
|
;
|
|
11 ;;Short Inactive Procedure List
|
|
D KILL N RAX,RAY
|
|
S RAX=$$IMG^RAUTL12() I 'RAX D KILL Q
|
|
S RAY="Rad/Nuc Med Inactive Procedures (Short)"
|
|
S DIC="^RAMIS(71,",L=0,FLDS="[RA PROCEDURE SHORT LIST]"
|
|
S BY=.01,(FR,TO)=""
|
|
S DHD="Inactive Radiology/Nuclear Medicine Procedures (Short)"
|
|
S DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):0,'^(""I""):0,DT'>^(""I""):0,1:1),($$IMG^RAMAINP(D0))"
|
|
W ! D 132 S RAPOP=$$ZIS(RAY)
|
|
I +RAPOP D HOME^%ZIS,KILL Q ; device selection failed
|
|
I +$P(RAPOP,"^",2) D KILL Q
|
|
E D ENTASK
|
|
Q
|
|
;
|
|
12 ;;Series Procedures Only
|
|
D KILL N RAX,RAY,RA1,RA2,RA3
|
|
S RAX=$$IMG^RAUTL12() Q:'RAX
|
|
S RAY="Rad/Nuc Med Series Procedures Only"
|
|
S DIC="^RAMIS(71,",L=0,FLDS="[RA PROCEDURE LIST]",BY="[RA SERIES ONLY]"
|
|
S DHD="Radiology/Nuclear Medicine Procedures (Series Only)"
|
|
S DHIT="S $P(RALINE,""-"",(IOM+1))="""" W !,RALINE"
|
|
S DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):1,'^(""I""):1,DT'>^(""I""):0,1:0),($$IMG^RAMAINP(D0))"
|
|
W ! D 132 S RAPOP=$$ZIS(RAY)
|
|
I +RAPOP D HOME^%ZIS,KILL Q ; device selection failed
|
|
I +$P(RAPOP,"^",2) D KILL Q
|
|
E D ENTASK
|
|
Q
|
|
;
|
|
13 ;;Standard Reports List
|
|
S DIC="^RA(74.1,",L=0,FLDS="[RA STANDARD REPORTS LIST]",BY="#.001",FR="",TO="" D EN1^DIP
|
|
K BY,DHD,FLDS,FR,POP,TO,X Q
|
|
;
|
|
14 ;;Procedure Modifiers Print
|
|
S DIC="^RAMIS(71.2,",L=0,FLDS=".01,4",FR="",TO="",BY="3;S1,.01"
|
|
S DHD="Procedure Modifiers" D EN1^DIP
|
|
K FLDS,BY,FR,TO,DHD,POP,DD00 Q
|
|
;
|
|
15 ;;Alpha List of Active Procedures
|
|
D KILL N RAX,RAY,RA1,RA2 S RAX=$$IMG^RAUTL12() Q:'RAX
|
|
S RAY="Rad/Nuc Med Alpha List of Active Procedures"
|
|
S DIC="^RAMIS(71,",L=0,FLDS="[RA ALPHA LIST OF ACTIVES]"
|
|
S BY="[RA ALPHA LIST OF ACTIVES]",(FR,TO)=""
|
|
S DIS(0)="I $$IMG^RAMAINP(D0)"
|
|
W ! D 132 S RAPOP=$$ZIS(RAY)
|
|
I +RAPOP D HOME^%ZIS,KILL Q ; device selection failed
|
|
I +$P(RAPOP,"^",2) D KILL Q
|
|
E D ENTASK
|
|
Q
|
|
;
|
|
16 ;;Reports Distribution List
|
|
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
|
|
17 ;;Rad/Nuc Med Procedure Message List
|
|
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
|
|
132 W !,"This report requires a 132 column output device."
|
|
Q
|
|
KILL ; Kill locals, and set ZTREQ if applicable.
|
|
K ^TMP($J,"RA I-TYPE"),%X,%XX,%Y,%YY
|
|
K %ZIS,BY,DHD,DHIT,DIC,DIS,DTOUT,DUOUT,FLDS,FR,L,POP,RAIOP,RALINE,RAPOP
|
|
K TO,X,Y,ZTDESC,ZTRTN,ZTSAVE
|
|
K RADIO,RAPHARM,I,POP
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
IMG(RA) ; Screens procedures by I-Type. Called from the following
|
|
; subroutines: 2,9,10,11,12 & 15. Contained in variable DIS(0)!
|
|
; 'RA' is the ien of file 71.
|
|
; return '1' if procedure is correct I-Type, else '0'!
|
|
N RAI,RAII S RAI=+$P($G(^RAMIS(71,RA,0)),"^",12)
|
|
Q:'RAI 0
|
|
S RAII=$P($G(^RA(79.2,RAI,0)),"^")
|
|
Q $S($D(^TMP($J,"RA I-TYPE",RAII,RAI))#2:1,1:0)
|
|
ENTASK ; Entry point for tasked job.
|
|
; All necessary variables are defined by the code calling ENTASK.
|
|
S RAIOP=ION_";"_IOST_";"_IOM_";"_IOSL,IOP=RAIOP
|
|
D EN1^DIP
|
|
D KILL^RAMAINP
|
|
Q
|
|
ZIS(RA) ; Select a device
|
|
; RAPOP=device selection successful ^ '^%ZTLOAD' called 1-yes
|
|
N RAPOP
|
|
K %ZIS,IOP S %ZIS="NMQ" W ! S %ZIS("A")="DEVICE: " D ^%ZIS
|
|
S RAPOP=POP_"^"
|
|
I '+RAPOP,($D(IO("Q"))) D
|
|
. K IO("Q") S ZTDESC=RA,ZTRTN="ENTASK^RAMAINP"
|
|
. D ZTSAVE,^%ZTLOAD S $P(RAPOP,"^",2)=1
|
|
. I +$G(ZTSK) W !?3,"Request Queued, Task #: ",$G(ZTSK)
|
|
. D HOME^%ZIS
|
|
. Q
|
|
Q RAPOP
|
|
ZTSAVE ; Save variables for tasked job
|
|
N I F I="BY","DIC","FLDS","FR","L","TO" S ZTSAVE(I)=""
|
|
S:($D(DIS)\10) ZTSAVE("DIS(")=""
|
|
S:($D(DHD)#2) ZTSAVE("DHD")=""
|
|
S:($D(DHIT)#2) ZTSAVE("DHIT")=""
|
|
S:($D(^TMP($J,"RA I-TYPE"))\10) ZTSAVE("^TMP($J,""RA I-TYPE"",")=""
|
|
Q
|