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

RAMAINP1.m

Go to the documentation of this file. 
  1. RAMAINP1 ;HISC/GJC AISC/TMP,RMO-Utility Files Print ;9/22/98  15:26
  1.  ;;5.0;Radiology/Nuclear Medicine;**3,45**;Mar 16, 1998
  1. 18 ;;Parent Procedure List
  1.  N RA1,RA2,RA3
  1.  D KILL^RAMAINP N RAX,RAY S RAX=$$IMG^RAUTL12() Q:'RAX
  1.  S RASTAT=$$ACTIVE()
  1.  I RASTAT="^" K RASTAT Q
  1.  S DIC="^RAMIS(71,",L=0,FLDS="[RA PARENT PROCEDURE LIST]"
  1.  S BY="12,.01",DHD=$S(RASTAT="B":"Active/Inactive",RASTAT="A":"Active",1:"Inactive")_" Parent Procedure List"
  1.  S:RASTAT="B" DIS(0)="I $P($G(^RAMIS(71,D0,0)),U,6)=""P"",$$IMG^RAMAINP(D0)"
  1.  S:RASTAT="A" DIS(0)="I $P($G(^RAMIS(71,D0,0)),U,6)=""P"",$$IMG^RAMAINP(D0),(+$G(^RAMIS(71,D0,""I""))=0!(+$G(^RAMIS(71,D0,""I""))>DT))"
  1.  S:RASTAT="I" DIS(0)="I $P($G(^RAMIS(71,D0,0)),U,6)=""P"",$$IMG^RAMAINP(D0),+$G(^RAMIS(71,D0,""I""))>0,+$G(^RAMIS(71,D0,""I""))'>DT"
  1.  S (FR,TO)="" K RASTAT S DHIT="S $P(RALINE,""-"",(IOM+1))="""" W !,RALINE"
  1.  W ! D 132^RAMAINP S RAPOP=$$ZIS^RAMAINP("Rad/Nuc Med Parent Procedure Listing")
  1.  I +RAPOP D HOME^%ZIS,KILL^RAMAINP Q  ; device selection failed
  1.  I +$P(RAPOP,"^",2) D KILL^RAMAINP Q
  1.  E  D ENTASK^RAMAINP
  1.  Q
  1.  ;
  1. CMPRT ; Entry Point: print procedures that are associated with contrast
  1.  ; media/medium.
  1.  ; kill ^TMP($J) and select procedure i-types
  1.  K ^TMP($J,"RA I-TYPE") S RAX=$$IMG^RAUTL12() I 'RAX K RAX Q
  1.  S RAITYP="^",RAX=""
  1.  F  S RAX=$O(^TMP($J,"RA I-TYPE",RAX)) Q:RAX=""  D
  1.  .S RAY=$O(^TMP($J,"RA I-TYPE",RAX,0)),RAITYP=RAITYP_RAY_"^"
  1.  .K ^TMP($J,"RA I-TYPE",RAX)
  1.  .Q
  1.  ; ask if active, inactive, or both active & inactive procedures are
  1.  ; to be included.
  1.  S RASTAT=$$ACTIVE()
  1.  I RASTAT="^" K RAITYP,RASTAT,RAX,RAY Q
  1.  ; save off user input parameters
  1.  F I="RAITYP","RASTAT" S ZTSAVE(I)=""
  1.  K I D EN^XUTMDEVQ("PRTCM^RAMAINP1","Rad/Nuc Med: print procedure contrast media association",.ZTSAVE,,1)
  1.  I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
  1.  K %L,%X,%Y,DDH,POP,RAITYP,RASTAT,RAX,RAY,X,Y,ZTSAVE,ZTSK
  1.  Q
  1.  ;
  1. PRTCM ; Print procedures that are associated with contrast media/medium.
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  S RAHD="Rad/Nuc Med Procedures with Contrast Media/Medium"
  1.  S RAHD=$S(RASTAT="A":"Active ",RASTAT="I":"Inactive ",1:"")_RAHD
  1.  S $P(RALINE,"-",(IOM+1))=""
  1.  S RAPG=0,RADT=$$FMTE^XLFDT(DT,"1P")
  1.  W:$E(IOST,1,2)="C-" @IOF ;clear screen
  1.  D HDR S (RAY,RAXIT)=0
  1.  ;only want procedure with contrast media/medium associations
  1.  F  S RAY=$O(^RAMIS(71,"CM","Y",RAY)) Q:'RAY  D  Q:RAXIT
  1.  .S RAXIT=$$S^%ZTLOAD() S:RAXIT ZTSTOP=1 Q:RAXIT
  1.  .S RAY(0)=$G(^RAMIS(71,RAY,0))
  1.  .;does the procedure have an i-type specified by the user?
  1.  .Q:RAITYP'[("^"_$P(RAY(0),U,12)_"^")
  1.  .S RAY("I")=+$G(^RAMIS(71,RAY,"I"))
  1.  .;if inactive proc are desired, and the inact. date is in the future
  1.  .;(the field will accept future dates), quit
  1.  .I RASTAT="I",RAY("I"),RAY("I")>DT Q
  1.  .;if inactive proc are desired, and no inact. date, quit
  1.  .I RASTAT="I",'RAY("I") Q
  1.  .;if active proc are desired, and the inact. date is today or in the
  1.  .;past, quit
  1.  .I RASTAT="A",RAY("I"),RAY("I")'>DT Q
  1.  .;if both inactive & active procedures are desired all records qualify 
  1.  .W !!,$P($$NAMCODE^RACPTMSC($P(RAY(0),U,9),DT),U),?19,$P(RAY(0),U)
  1.  .I $Y>(IOSL-4) D EOS Q:RAXIT
  1.  .W ! S (RACM,RADCM)=.001
  1.  .F  D  Q:('RACM&'RADCM)!RAXIT  W !
  1.  ..S:RADCM RADCM=$O(^RAMIS(71,RAY,"DCM",RADCM)) W:RADCM ?2,$E($P($$BASICMOD^RACPTMSC(+$G(^(RADCM,0)),DT),U,3),1,47)
  1.  ..S:RACM RACM=$O(^RAMIS(71,RAY,"CM",RACM)) W:RACM ?50,$$EXTERNAL^DILFD(71.0125,.01,"",$P($G(^(RACM,0)),U))
  1.  ..I $Y>(IOSL-4) D EOS Q:RAXIT
  1.  ..Q
  1.  .Q:RAXIT  I $Y>(IOSL-4) D EOS
  1.  .W $$EXTERNAL^DILFD(71,6,"",$P(RAY(0),U,6)),?24,$$EXTERNAL^DILFD(71,12,"",$P(RAY(0),U,12))
  1.  .I RASTAT'="A",(RAY("I")>0) W ?52,$$EXTERNAL^DILFD(71,100,"",RAY("I"))
  1.  .Q
  1.  ;
  1. KILL ; kill and quit
  1.  ;if there are no records to print, alert user
  1.  W:'$D(RAY(0))#2 !,$$CJ^XLFSTR("*** No Records To Print ***",IOM)
  1.  ;
  1.  K RACM,RADCM,RADT,RAHD,RAITYP,RALINE,RAPG,RAXIT,RAY
  1.  Q
  1.  ;
  1. ACTIVE() ; Use the ^DIR call to ask the user if active, inactive, or
  1.  ; both inactive & active procedures are to be included.
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X N Y
  1.  S DIR(0)="S^A:Active;I:Inactive;B:Both",DIR("A")="Select Procedure Status",DIR("B")="A"
  1.  S DIR("?",1)="Enter 'A' for active procedures, 'I' for inactive proceduRes,"
  1.  S DIR("?")="or 'B' for both active and inactive procedures."
  1.  W ! D ^DIR S:$D(DIRUT) Y="^"
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X
  1.  Q Y
  1.  ;
  1. EOS ; end of screen dialog
  1.  I $E(IOST,1,2)="C-" D  Q:RAXIT
  1.  .K DIR,DIRUT,DTOUT,DUOUT
  1.  .S DIR(0)="E" D ^DIR S:$D(DIRUT) RAXIT=1
  1.  .K DIR,DIRUT,DTOUT,DUOUT
  1.  .Q
  1.  ;
  1. HDR ; print header
  1.  W:RAPG @IOF S RAPG=RAPG+1
  1.  W !,$$CJ^XLFSTR(RAHD,IOM),!,"Date: ",RADT,?69,"Page ",RAPG
  1.  W !,"CPT",?19,"Procedure",!?2,"CPT Modifiers",?50,"Contrast Media",!,"Procedure Type",?24,"Imaging Type"
  1.  W:RASTAT'="A" ?52,"Inactivation Date"
  1.  W !,$$CJ^XLFSTR(RALINE,IOM)
  1.  Q
  1.  ;
  1. CMDISP(RAZ71) ;Display contrast media data for descendents when the 'Parent
  1.  ;Procedure List' [RA PROCPARENT] option is exercised
  1.  ;function called from print template: [RA PARENT PROCEDURE LIST]
  1.  ;input-RAZ71 internal entry number of the descendent
  1.  ;formatting issues; differ for print options
  1.  W !?7,"Contrast Medium"
  1.  N RALBL,RAX,RAY S (RALBL,RAY)=0
  1.  F  S RAY=$O(^RAMIS(71,RAZ71,"CM",RAY)) Q:'RAY  D
  1.  .S RAX=$P($G(^RAMIS(71,RAZ71,"CM",RAY,0)),U) ;RAX=CM value (internal)
  1.  .W:RALBL ! W ?40,$$EXTERNAL^DILFD(71.0125,.01,"",RAX) S RALBL=RAY
  1.  .Q
  1.  Q
  1.  ;