source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAMAINP1.m@ 1714

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1RAMAINP1 ;HISC/GJC AISC/TMP,RMO-Utility Files Print ;9/22/98 15:26
2 ;;5.0;Radiology/Nuclear Medicine;**3,45**;Mar 16, 1998
318 ;;Parent Procedure List
4 N RA1,RA2,RA3
5 D KILL^RAMAINP N RAX,RAY S RAX=$$IMG^RAUTL12() Q:'RAX
6 S RASTAT=$$ACTIVE()
7 I RASTAT="^" K RASTAT Q
8 S DIC="^RAMIS(71,",L=0,FLDS="[RA PARENT PROCEDURE LIST]"
9 S BY="12,.01",DHD=$S(RASTAT="B":"Active/Inactive",RASTAT="A":"Active",1:"Inactive")_" Parent Procedure List"
10 S:RASTAT="B" DIS(0)="I $P($G(^RAMIS(71,D0,0)),U,6)=""P"",$$IMG^RAMAINP(D0)"
11 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))"
12 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"
13 S (FR,TO)="" K RASTAT S DHIT="S $P(RALINE,""-"",(IOM+1))="""" W !,RALINE"
14 W ! D 132^RAMAINP S RAPOP=$$ZIS^RAMAINP("Rad/Nuc Med Parent Procedure Listing")
15 I +RAPOP D HOME^%ZIS,KILL^RAMAINP Q ; device selection failed
16 I +$P(RAPOP,"^",2) D KILL^RAMAINP Q
17 E D ENTASK^RAMAINP
18 Q
19 ;
20CMPRT ; Entry Point: print procedures that are associated with contrast
21 ; media/medium.
22 ; kill ^TMP($J) and select procedure i-types
23 K ^TMP($J,"RA I-TYPE") S RAX=$$IMG^RAUTL12() I 'RAX K RAX Q
24 S RAITYP="^",RAX=""
25 F S RAX=$O(^TMP($J,"RA I-TYPE",RAX)) Q:RAX="" D
26 .S RAY=$O(^TMP($J,"RA I-TYPE",RAX,0)),RAITYP=RAITYP_RAY_"^"
27 .K ^TMP($J,"RA I-TYPE",RAX)
28 .Q
29 ; ask if active, inactive, or both active & inactive procedures are
30 ; to be included.
31 S RASTAT=$$ACTIVE()
32 I RASTAT="^" K RAITYP,RASTAT,RAX,RAY Q
33 ; save off user input parameters
34 F I="RAITYP","RASTAT" S ZTSAVE(I)=""
35 K I D EN^XUTMDEVQ("PRTCM^RAMAINP1","Rad/Nuc Med: print procedure contrast media association",.ZTSAVE,,1)
36 I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
37 K %L,%X,%Y,DDH,POP,RAITYP,RASTAT,RAX,RAY,X,Y,ZTSAVE,ZTSK
38 Q
39 ;
40PRTCM ; Print procedures that are associated with contrast media/medium.
41 S:$D(ZTQUEUED) ZTREQ="@"
42 S RAHD="Rad/Nuc Med Procedures with Contrast Media/Medium"
43 S RAHD=$S(RASTAT="A":"Active ",RASTAT="I":"Inactive ",1:"")_RAHD
44 S $P(RALINE,"-",(IOM+1))=""
45 S RAPG=0,RADT=$$FMTE^XLFDT(DT,"1P")
46 W:$E(IOST,1,2)="C-" @IOF ;clear screen
47 D HDR S (RAY,RAXIT)=0
48 ;only want procedure with contrast media/medium associations
49 F S RAY=$O(^RAMIS(71,"CM","Y",RAY)) Q:'RAY D Q:RAXIT
50 .S RAXIT=$$S^%ZTLOAD() S:RAXIT ZTSTOP=1 Q:RAXIT
51 .S RAY(0)=$G(^RAMIS(71,RAY,0))
52 .;does the procedure have an i-type specified by the user?
53 .Q:RAITYP'[("^"_$P(RAY(0),U,12)_"^")
54 .S RAY("I")=+$G(^RAMIS(71,RAY,"I"))
55 .;if inactive proc are desired, and the inact. date is in the future
56 .;(the field will accept future dates), quit
57 .I RASTAT="I",RAY("I"),RAY("I")>DT Q
58 .;if inactive proc are desired, and no inact. date, quit
59 .I RASTAT="I",'RAY("I") Q
60 .;if active proc are desired, and the inact. date is today or in the
61 .;past, quit
62 .I RASTAT="A",RAY("I"),RAY("I")'>DT Q
63 .;if both inactive & active procedures are desired all records qualify
64 .W !!,$P($$NAMCODE^RACPTMSC($P(RAY(0),U,9),DT),U),?19,$P(RAY(0),U)
65 .I $Y>(IOSL-4) D EOS Q:RAXIT
66 .W ! S (RACM,RADCM)=.001
67 .F D Q:('RACM&'RADCM)!RAXIT W !
68 ..S:RADCM RADCM=$O(^RAMIS(71,RAY,"DCM",RADCM)) W:RADCM ?2,$E($P($$BASICMOD^RACPTMSC(+$G(^(RADCM,0)),DT),U,3),1,47)
69 ..S:RACM RACM=$O(^RAMIS(71,RAY,"CM",RACM)) W:RACM ?50,$$EXTERNAL^DILFD(71.0125,.01,"",$P($G(^(RACM,0)),U))
70 ..I $Y>(IOSL-4) D EOS Q:RAXIT
71 ..Q
72 .Q:RAXIT I $Y>(IOSL-4) D EOS
73 .W $$EXTERNAL^DILFD(71,6,"",$P(RAY(0),U,6)),?24,$$EXTERNAL^DILFD(71,12,"",$P(RAY(0),U,12))
74 .I RASTAT'="A",(RAY("I")>0) W ?52,$$EXTERNAL^DILFD(71,100,"",RAY("I"))
75 .Q
76 ;
77KILL ; kill and quit
78 ;if there are no records to print, alert user
79 W:'$D(RAY(0))#2 !,$$CJ^XLFSTR("*** No Records To Print ***",IOM)
80 ;
81 K RACM,RADCM,RADT,RAHD,RAITYP,RALINE,RAPG,RAXIT,RAY
82 Q
83 ;
84ACTIVE() ; Use the ^DIR call to ask the user if active, inactive, or
85 ; both inactive & active procedures are to be included.
86 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X N Y
87 S DIR(0)="S^A:Active;I:Inactive;B:Both",DIR("A")="Select Procedure Status",DIR("B")="A"
88 S DIR("?",1)="Enter 'A' for active procedures, 'I' for inactive proceduRes,"
89 S DIR("?")="or 'B' for both active and inactive procedures."
90 W ! D ^DIR S:$D(DIRUT) Y="^"
91 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X
92 Q Y
93 ;
94EOS ; end of screen dialog
95 I $E(IOST,1,2)="C-" D Q:RAXIT
96 .K DIR,DIRUT,DTOUT,DUOUT
97 .S DIR(0)="E" D ^DIR S:$D(DIRUT) RAXIT=1
98 .K DIR,DIRUT,DTOUT,DUOUT
99 .Q
100 ;
101HDR ; print header
102 W:RAPG @IOF S RAPG=RAPG+1
103 W !,$$CJ^XLFSTR(RAHD,IOM),!,"Date: ",RADT,?69,"Page ",RAPG
104 W !,"CPT",?19,"Procedure",!?2,"CPT Modifiers",?50,"Contrast Media",!,"Procedure Type",?24,"Imaging Type"
105 W:RASTAT'="A" ?52,"Inactivation Date"
106 W !,$$CJ^XLFSTR(RALINE,IOM)
107 Q
108 ;
109CMDISP(RAZ71) ;Display contrast media data for descendents when the 'Parent
110 ;Procedure List' [RA PROCPARENT] option is exercised
111 ;function called from print template: [RA PARENT PROCEDURE LIST]
112 ;input-RAZ71 internal entry number of the descendent
113 ;formatting issues; differ for print options
114 W !?7,"Contrast Medium"
115 N RALBL,RAX,RAY S (RALBL,RAY)=0
116 F S RAY=$O(^RAMIS(71,RAZ71,"CM",RAY)) Q:'RAY D
117 .S RAX=$P($G(^RAMIS(71,RAZ71,"CM",RAY,0)),U) ;RAX=CM value (internal)
118 .W:RALBL ! W ?40,$$EXTERNAL^DILFD(71.0125,.01,"",RAX) S RALBL=RAY
119 .Q
120 Q
121 ;
Note: See TracBrowser for help on using the repository browser.