source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRRADL1.m@ 1211

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1IMRRADL1 ;HCIOFO/NCA/FAI - Print Radiology Utility Report (Cont.) ;09/27/00 22:34
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**11**;Feb 09, 1998
3PRNT ; Print Radiology Data
4 S IMRD="FOR THE PERIOD "_$E(IMRSD,4,5)_"/"_$E(IMRSD,6,7)_"/"_$E(IMRSD,2,3)_" TO "_$E(IMRED,4,5)_"/"_$E(IMRED,6,7)_"/"_$E(IMRED,2,3)
5 S (IMRTOT,IMRUT)=0
6 I IMR2C F IMR0C=0:1:4 S IMR1C="C"_IMR0C,IMRLBL=$S(IMR0C=0:"NO CATEGORY DEFINED",IMR0C=1:"HIV+",IMR0C=2:"HIV+ (CD4<500)",IMR0C=3:"AIDS-3",1:"AIDS") D PRN1
7 Q:IMRUT
8 I IMR2C Q:'$D(^TMP($J,"IMRPR","CT")) S IMR1C="CT" D C3^IMRRADL K ^TMP($J,"IMRPR","CT")
9 S IMRTOT=1,IMR0C=5,IMR1C="CT",IMRLBL="TOTAL HIV+ (ALL CATEGORIES) POPULATION" D PRN1
10 K IMRLBL
11 Q
12PRN1 Q:'$D(^TMP($J,"IMRPRN",IMR1C))
13 Q:IMRUT
14 S IMRTIT="RADIOLOGY UTILIZATION REPORT" D HDR Q:IMRUT
15 W !,"Totals: " W +$P(IMRCPR,"^",IMR0C+1)," procedures reported for ",+$P(IMRTTP,"^",IMR0C+1)," patients ( ",+$P(IMRPAT,"^",IMR0C+1)," individual patients )"
16 W !?20,"There were ",+$P(IMRDPR,"^",IMR0C+1)," different procedures performed",!
17 I IMR2C D
18 .S $P(IMRCPR,"^",6)=$P(IMRCPR,"^",6)+$P(IMRCPR,"^",IMR0C+1)
19 .S $P(IMRPAT,"^",6)=$P(IMRPAT,"^",6)+$P(IMRPAT,"^",IMR0C+1)
20 .S $P(IMRTTP,"^",6)=$P(IMRTTP,"^",6)+$P(IMRTTP,"^",IMR0C+1)
21 .Q
22 D HDR1 S (IMRI,IMRTP)="",IMRCP=0,IMRX="A"
23 F S IMRX=$O(^TMP($J,"IMRPRN",IMR1C,IMRX),-1) Q:IMRX<1!(IMRUT) S IMRPN="" F S IMRPN=$O(^TMP($J,"IMRPRN",IMR1C,IMRX,IMRPN)) Q:IMRPN=""!(IMRUT) S IMRY=$G(^(IMRPN)) D
24 .I ($Y>(IOSL-4)) D HDR Q:IMRUT D HDR1
25 .I +IMRY<IMRCP D TOT
26 .W !?8,$J(+IMRY,7)," ",$P(IMRPN,"~",1),?48,$J($P(IMRY,"^",2),8)
27 .S $P(IMRTP,"^",1)=$P(IMRTP,"^",1)+$P(IMRY,"^",1),$P(IMRTP,"^",2)=$P(IMRTP,"^",2)+$P(IMRY,"^",2),IMRCP=+IMRY
28 .I 'IMRTOT D
29 ..I '$D(^TMP($J,"IMRPR","CT",IMRPN)) S ^(IMRPN)="" S $P(IMRDPR,"^",6)=$P(IMRDPR,"^",6)+1
30 ..S IMRI=$G(^TMP($J,"IMRPR","CT",IMRPN)),$P(IMRI,"^",1)=$P(IMRI,"^",1)+$P(IMRY,"^",1),$P(IMRI,"^",2)=$P(IMRI,"^",2)+$P(IMRY,"^",2)
31 ..S ^TMP($J,"IMRPR","CT",IMRPN)=IMRI
32 ..Q
33 .Q
34 Q:IMRUT I IMRTP'="" D TOT
35 D HDR Q:IMRUT
36 D HDR2
37 S IMRX="A" F S IMRX=$O(^TMP($J,"IMRPRN",IMR1C,IMRX),-1) Q:IMRX<1!(IMRUT)!(IMRX<IMRN1) S IMRPN="" F S IMRPN=$O(^TMP($J,"IMRPRN",IMR1C,IMRX,IMRPN)) Q:IMRPN=""!(IMRUT) S IMRY=$G(^(IMRPN)) D
38 .I ($Y>(IOSL-4)) D HDR Q:IMRUT D HDR2
39 .W !,$P(IMRPN,"~",1),?33,$P(IMRPN,"~",2),?48,$J($P(IMRY,"^",1),10),$J($P(IMRY,"^",2),14)
40 .Q
41 K ^TMP($J,"IMRPRN",IMR1C) Q:IMRUT
42 Q:'IMRRMAX D HDR Q:IMRUT
43 S IMRN=0 S X1="HIGHEST UTILIZATION PATIENTS BASED ON NUMBER OF PROCEDURES" D HDR3
44 S IMRX="A" F S IMRX=$O(^TMP($J,"IMRPAT",IMR1C,IMRX),-1) Q:IMRX<1!(IMRN'<IMRRMAX) Q:IMRUT F IMRDFN=0:0 S IMRDFN=$O(^TMP($J,"IMRPAT",IMR1C,IMRX,IMRDFN)) Q:IMRDFN<1 Q:IMRUT S IMRX1=^(IMRDFN) D PAT D:'IMRUT ALLPAT
45 K ^TMP($J,"IMRPAT",IMR1C)
46 Q
47PAT ; Identify Patients
48 I ($Y>(IOSL-4)) D HDR Q:IMRUT
49 S DFN=IMRDFN,IMRN=IMRN+1 D NS^IMRCALL W !,IMRNAM,?32,IMRSSN,?45,$J($P(IMRX1,U),6),$J($P(IMRX1,U,2),10)
50 Q
51TOT ; Tabulate a total procedure and patients
52 W !!?8,$J(+$P(IMRTP,"^",1),7)," ","procedure",$S($P(IMRTP,"^",1)>1:"s",1:"")," reported for",?48,$J(+$P(IMRTP,"^",2),8)," patient",$S($P(IMRTP,"^",2)>1:"s",1:""),!
53 S IMRTP=""
54 Q
55ALLPAT ; Set ^TMP for all Patients
56 Q:IMRTOT
57 I '$D(^TMP($J,"IMRPAT","CT",IMRX,IMRDFN)) S ^(IMRDFN)=IMRX1
58 Q
59EOP ; Check End of Page
60 S IMRUT=0 I $E(IOST,1,2)="C-",IMRPG'<1 W ! S DIR(0)="E" D ^DIR K DIR I 'Y S IMRUT=1 Q
61 Q
62HDR ; Print Header of the Report
63 Q:IMRUT D EOP Q:IMRUT
64 W:'($E(IOST,1,2)'="C-"&'IMRPG) @IOF S IMRPG=IMRPG+1
65 W:IOST'["C-" !!! W !,IMRDTE,?(IOM-$L(IMRTIT)\2),IMRTIT,?(IOM-8),"Page ",IMRPG,!?(IOM-$L(IMRD)\2),IMRD,!?(IOM-$L(IMRLBL)\2),IMRLBL,!
66 Q
67HDR1 ; Heading For Radiology Procedures Reported
68 Q:IMRUT W !?8," Total ","Procedure Reported",?48,"Patients",!
69 Q
70HDR2 ; Heading For Listing the Minimum # of Highest Procedures
71 Q:IMRUT W !,"For ",IMRN1," or more procedures",!
72 W !?30,"CPT code-Modifier ",?54,"Procs",?67,"Patients",!
73 Q
74HDR3 ; Heading For Highest Utility Patients
75 W !,X1,!!,?47,"TOTAL",?55,"DIFFERENT",!,"PATIENT NAME",?35,"SSN",?47,"PROCS",?55,"PROCEDURES",!
76 Q
Note: See TracBrowser for help on using the repository browser.