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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAINP 6474 printed Apr 09, 2024@21:41:36 Page 2
RAMAINP ;HISC/GJC AISC/TMP,RMO-Utility Files Print ;9/22/98 15:26
+1 ;;5.0;Radiology/Nuclear Medicine;**3,19,34**;Mar 16, 1998
2 ;;Long Active Procedure List
+1 DO KILL
NEW RAX,RAY,RA1,RA2,RA3
SET RAX=$$IMG^RAUTL12()
if 'RAX
QUIT
+2 SET RAY="Rad/Nuc Med Active Procedures (Long)"
+3 SET DIC="^RAMIS(71,"
SET L=0
SET FLDS="[RA PROCEDURE LIST]"
+4 SET BY=.01
SET (FR,TO)=""
+5 SET DHD="Active Radiology/Nuclear Medicine Procedures (Long)"
+6 SET DHIT="S $P(RALINE,""-"",(IOM+1))="""" W !,RALINE"
+7 SET DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),($$IMG^RAMAINP(D0))"
+8 WRITE !
DO 132
SET RAPOP=$$ZIS(RAY)
+9 ; device selection failed
IF +RAPOP
DO HOME^%ZIS
DO KILL
QUIT
+10 IF +$PIECE(RAPOP,"^",2)
DO KILL
QUIT
+11 IF '$TEST
DO ENTASK
+12 QUIT
+13 ;
3 ;;Major AMIS Code Print
+1 SET DIC="^RAMIS(71.1,"
SET L=0
SET FLDS=".001,.01,2"
SET FR=""
SET TO=""
SET BY=".001"
SET DHD="Major AMIS Codes"
DO EN1^DIP
KILL FLDS,BY,FR,TO,DHD,POP
QUIT
+2 ;
4 ;;Film Sizes Print
+1 SET DIC="^RA(78.4,"
SET L=0
SET FLDS="[RA FILM SIZE]"
SET BY=""
SET TO=""
SET FR=""
+2 DO EN1^DIP
KILL BY,DIJ,DP,FLDS,FR,P,TO,X,POP
QUIT
+3 ;
5 ;;Diagnostic Code Print
+1 SET DIC="^RA(78.3,"
SET L=0
SET FLDS="[RA DIAGNOSTIC CODE PRINT]"
SET BY=".001"
SET FR=""
SET TO=""
SET DHD="Diagnostic Codes"
DO EN1^DIP
KILL FLDS,BY,FR,TO,DHD,POP
QUIT
+2 ;
6 ;;Flash Card/Label Formatter Print
+1 SET L=0
SET DIC="^RA(78.2,"
SET FLDS="[RA FLASH PRINT]"
SET BY="[RA FLASH PRINT]"
SET FR=""
SET TO=""
SET DHD="Exam Label/Report Header/Report Footer/Flash Card Formats"
DO EN1^DIP
KILL L,FLDS,BY,FR,TO,DHD,POP
QUIT
+2 ;
7 ;;Complication Type Print
+1 SET L=0
SET DIC="^RA(78.1,"
SET FLDS=".01,2"
SET BY=""
SET FR=""
SET TO=""
SET DHD="Complication Types"
DO EN1^DIP
KILL %DT,%X,%Y,FLDS,BY,FR,TO,DHD,POP,ZTSK
QUIT
+2 ;
8 ;;Contract/Sharing Agreements Print
+1 SET DIC="^DIC(34,"
SET L=0
SET FLDS=".01,2,3"
SET BY=""
SET TO=""
SET FR=""
SET DHD="Contract/Sharing Agreements"
DO EN1^DIP
KILL BY,DHD,FLDS,FR,POP,TO,X
QUIT
+2 ;
9 ;;Short Active Procedure List
+1 DO KILL
NEW RAX,RAY,RA1,RA2
SET RAX=$$IMG^RAUTL12()
if 'RAX
QUIT
+2 SET RAY="Rad/Nuc Med Active Procedures (Short)"
+3 SET DIC="^RAMIS(71,"
SET L=0
SET FLDS="[RA PROCEDURE SHORT LIST]"
+4 SET BY=.01
SET (FR,TO)=""
+5 SET DHD="Active Radiology/Nuclear Medicine Procedures (Short)"
+6 SET DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),($$IMG^RAMAINP(D0))"
+7 WRITE !
DO 132
SET RAPOP=$$ZIS(RAY)
+8 ; device selection failed
IF +RAPOP
DO HOME^%ZIS
DO KILL
QUIT
+9 IF +$PIECE(RAPOP,"^",2)
DO KILL
QUIT
+10 IF '$TEST
DO ENTASK
+11 QUIT
+12 ;
10 ;;Long Inactive Procedure List
+1 DO KILL
NEW RAX,RAY,RA1,RA2,RA3
SET RAX=$$IMG^RAUTL12()
if 'RAX
QUIT
+2 SET RAY="Rad/Nuc Med Inactive Procedures (Long)"
+3 SET DIC="^RAMIS(71,"
SET L=0
SET FLDS="[RA PROCEDURE LIST]"
+4 SET BY=.01
SET (FR,TO)=""
+5 SET DHD="Inactive Radiology/Nuclear Medicine Procedures (Long)"
+6 SET DHIT="S $P(RALINE,""-"",(IOM+1))="""" W !,RALINE"
+7 SET DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):0,'^(""I""):0,DT'>^(""I""):0,1:1),($$IMG^RAMAINP(D0))"
+8 WRITE !
DO 132
SET RAPOP=$$ZIS(RAY)
+9 ; device selection failed
IF +RAPOP
DO HOME^%ZIS
DO KILL
QUIT
+10 IF +$PIECE(RAPOP,"^",2)
DO KILL
QUIT
+11 IF '$TEST
DO ENTASK
+12 QUIT
+13 ;
11 ;;Short Inactive Procedure List
+1 DO KILL
NEW RAX,RAY
+2 SET RAX=$$IMG^RAUTL12()
IF 'RAX
DO KILL
QUIT
+3 SET RAY="Rad/Nuc Med Inactive Procedures (Short)"
+4 SET DIC="^RAMIS(71,"
SET L=0
SET FLDS="[RA PROCEDURE SHORT LIST]"
+5 SET BY=.01
SET (FR,TO)=""
+6 SET DHD="Inactive Radiology/Nuclear Medicine Procedures (Short)"
+7 SET DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):0,'^(""I""):0,DT'>^(""I""):0,1:1),($$IMG^RAMAINP(D0))"
+8 WRITE !
DO 132
SET RAPOP=$$ZIS(RAY)
+9 ; device selection failed
IF +RAPOP
DO HOME^%ZIS
DO KILL
QUIT
+10 IF +$PIECE(RAPOP,"^",2)
DO KILL
QUIT
+11 IF '$TEST
DO ENTASK
+12 QUIT
+13 ;
12 ;;Series Procedures Only
+1 DO KILL
NEW RAX,RAY,RA1,RA2,RA3
+2 SET RAX=$$IMG^RAUTL12()
if 'RAX
QUIT
+3 SET RAY="Rad/Nuc Med Series Procedures Only"
+4 SET DIC="^RAMIS(71,"
SET L=0
SET FLDS="[RA PROCEDURE LIST]"
SET BY="[RA SERIES ONLY]"
+5 SET DHD="Radiology/Nuclear Medicine Procedures (Series Only)"
+6 SET DHIT="S $P(RALINE,""-"",(IOM+1))="""" W !,RALINE"
+7 SET DIS(0)="I $S('$D(^RAMIS(71,D0,""I"")):1,'^(""I""):1,DT'>^(""I""):0,1:0),($$IMG^RAMAINP(D0))"
+8 WRITE !
DO 132
SET RAPOP=$$ZIS(RAY)
+9 ; device selection failed
IF +RAPOP
DO HOME^%ZIS
DO KILL
QUIT
+10 IF +$PIECE(RAPOP,"^",2)
DO KILL
QUIT
+11 IF '$TEST
DO ENTASK
+12 QUIT
+13 ;
13 ;;Standard Reports List
+1 SET DIC="^RA(74.1,"
SET L=0
SET FLDS="[RA STANDARD REPORTS LIST]"
SET BY="#.001"
SET FR=""
SET TO=""
DO EN1^DIP
+2 KILL BY,DHD,FLDS,FR,POP,TO,X
QUIT
+3 ;
14 ;;Procedure Modifiers Print
+1 SET DIC="^RAMIS(71.2,"
SET L=0
SET FLDS=".01,4"
SET FR=""
SET TO=""
SET BY="3;S1,.01"
+2 SET DHD="Procedure Modifiers"
DO EN1^DIP
+3 KILL FLDS,BY,FR,TO,DHD,POP,DD00
QUIT
+4 ;
15 ;;Alpha List of Active Procedures
+1 DO KILL
NEW RAX,RAY,RA1,RA2
SET RAX=$$IMG^RAUTL12()
if 'RAX
QUIT
+2 SET RAY="Rad/Nuc Med Alpha List of Active Procedures"
+3 SET DIC="^RAMIS(71,"
SET L=0
SET FLDS="[RA ALPHA LIST OF ACTIVES]"
+4 SET BY="[RA ALPHA LIST OF ACTIVES]"
SET (FR,TO)=""
+5 SET DIS(0)="I $$IMG^RAMAINP(D0)"
+6 WRITE !
DO 132
SET RAPOP=$$ZIS(RAY)
+7 ; device selection failed
IF +RAPOP
DO HOME^%ZIS
DO KILL
QUIT
+8 IF +$PIECE(RAPOP,"^",2)
DO KILL
QUIT
+9 IF '$TEST
DO ENTASK
+10 QUIT
+11 ;
16 ;;Reports Distribution List
+1 SET DIC="^RABTCH(74.3,"
SET L=0
SET FLDS="[RA DISTRIBUTION]"
SET BY=".01"
SET (TO,FR)=""
DO EN1^DIP
KILL BY,DHD,FLDS,FR,POP,TO,X,X1
QUIT
17 ;;Rad/Nuc Med Procedure Message List
+1 SET DIC="^RAMIS(71.4,"
SET L=0
SET FLDS=".01;S;W70"
SET BY=.01
SET (FR,TO)=""
DO EN1^DIP
KILL D0,FLDS,BY,FR,TO,DHD
QUIT
132 WRITE !,"This report requires a 132 column output device."
+1 QUIT
KILL ; Kill locals, and set ZTREQ if applicable.
+1 KILL ^TMP($JOB,"RA I-TYPE"),%X,%XX,%Y,%YY
+2 KILL %ZIS,BY,DHD,DHIT,DIC,DIS,DTOUT,DUOUT,FLDS,FR,L,POP,RAIOP,RALINE,RAPOP
+3 KILL TO,X,Y,ZTDESC,ZTRTN,ZTSAVE
+4 KILL RADIO,RAPHARM,I,POP
+5 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 QUIT
IMG(RA) ; Screens procedures by I-Type. Called from the following
+1 ; subroutines: 2,9,10,11,12 & 15. Contained in variable DIS(0)!
+2 ; 'RA' is the ien of file 71.
+3 ; return '1' if procedure is correct I-Type, else '0'!
+4 NEW RAI,RAII
SET RAI=+$PIECE($GET(^RAMIS(71,RA,0)),"^",12)
+5 if 'RAI
QUIT 0
+6 SET RAII=$PIECE($GET(^RA(79.2,RAI,0)),"^")
+7 QUIT $SELECT($DATA(^TMP($JOB,"RA I-TYPE",RAII,RAI))#2:1,1:0)
ENTASK ; Entry point for tasked job.
+1 ; All necessary variables are defined by the code calling ENTASK.
+2 SET RAIOP=ION_";"_IOST_";"_IOM_";"_IOSL
SET IOP=RAIOP
+3 DO EN1^DIP
+4 DO KILL^RAMAINP
+5 QUIT
ZIS(RA) ; Select a device
+1 ; RAPOP=device selection successful ^ '^%ZTLOAD' called 1-yes
+2 NEW RAPOP
+3 KILL %ZIS,IOP
SET %ZIS="NMQ"
WRITE !
SET %ZIS("A")="DEVICE: "
DO ^%ZIS
+4 SET RAPOP=POP_"^"
+5 IF '+RAPOP
IF ($DATA(IO("Q")))
Begin DoDot:1
+6 KILL IO("Q")
SET ZTDESC=RA
SET ZTRTN="ENTASK^RAMAINP"
+7 DO ZTSAVE
DO ^%ZTLOAD
SET $PIECE(RAPOP,"^",2)=1
+8 IF +$GET(ZTSK)
WRITE !?3,"Request Queued, Task #: ",$GET(ZTSK)
+9 DO HOME^%ZIS
+10 QUIT
End DoDot:1
+11 QUIT RAPOP
ZTSAVE ; Save variables for tasked job
+1 NEW I
FOR I="BY","DIC","FLDS","FR","L","TO"
SET ZTSAVE(I)=""
+2 if ($DATA(DIS)\10)
SET ZTSAVE("DIS(")=""
+3 if ($DATA(DHD)#2)
SET ZTSAVE("DHD")=""
+4 if ($DATA(DHIT)#2)
SET ZTSAVE("DHIT")=""
+5 if ($DATA(^TMP($JOB,"RA I-TYPE"))\10)
SET ZTSAVE("^TMP($J,""RA I-TYPE"",")=""
+6 QUIT
