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

RAMAINP.m

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