source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW57.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1SCRPW57 ;RENO/KEITH - Most Frequent 50 ICD-9-CM Codes (OP7) or (IP7) ; 5/6/03 1:18pm
2 ;;5.3;Scheduling;**144,295,466**;AUG 13, 1993;Build 2
3 S SDSTA=$G(SDSTA,2)
4 D RQUE^SCRPW50("START^SCRPW57","Most Frequent 50 ICD-9-CM Codes "_$S(SDSTA=2:"(OP7)",1:"(IP7)"),1) Q
5 ;
6START ;Print report
7 K ^TMP("SCRPW",$J) S (SDSTOP,SDOUT)=0,SDT=SD("FYD")
8 F S SDT=$O(^SCE("B",SDT)) Q:'SDT!SDOUT!(SDT>SD("EDT")) S SDOE=0 F S SDOE=$O(^SCE("B",SDT,SDOE)) Q:'SDOE!SDOUT S SDOE0=$$GETOE^SDOE(SDOE),SDIV=$P(SDOE0,U,11) I $$VALID() D SET(SDIV) D:SDMD SET(0)
9 G:SDOUT EXIT S (SDVCT,SDIV)=""
10 F S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV="" D STOP,DLIST Q:SDOUT D
11 .S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,0,"LIST",DFN)) Q:'DFN D
12 ..S SDDX=0 F S SDDX=$O(^TMP("SCRPW",$J,SDIV,0,"LIST",DFN,SDDX)) Q:'SDDX S SDPT="" F S SDPT=$O(^TMP("SCRPW",$J,SDIV,0,"LIST",DFN,SDDX,SDPT)) Q:SDPT="" D
13 ...S $P(^TMP("SCRPW",$J,SDIV,0,SDDX,SDPT),U,2)=$P($G(^TMP("SCRPW",$J,SDIV,0,SDDX,SDPT)),U,2)+1
14 ...S:$D(^TMP("SCRPW",$J,SDIV,0,"LIST",DFN,SDDX,SDPT,"P")) $P(^TMP("SCRPW",$J,SDIV,0,SDDX,SDPT),U)=$P($G(^TMP("SCRPW",$J,SDIV,0,SDDX,SDPT)),U)+1
15 ...Q
16 ..Q
17 .S SDDX=0 F S SDDX=$O(^TMP("SCRPW",$J,SDIV,0,SDDX)) Q:'SDDX S SDI=^TMP("SCRPW",$J,SDIV,0,SDDX),^TMP("SCRPW",$J,SDIV,1,SDI,SDDX)=""
18 .Q
19 G:SDOUT EXIT S SDLINE="",$P(SDLINE,"-",(IOM+1))="" D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDTIT(1)="<*> MOST FREQUENT 50 ICD-9-CM CODES "_$S(SDSTA=2:"(OP7)",1:"(IP7)")_" <*>",SDPG=0 D:$E(IOST)="C" DISP0^SCRPW23
20 I '$D(^TMP("SCRPW",$J)) S SDPAGE=1,SDX="No activity found within report parameters." D HDR G:SDOUT EXIT W !!?(IOM-$L(SDX)\2),SDX G EXIT
21 G:SDOUT EXIT S SDIVN="" F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT D DPRT(SDIV(SDIVN))
22 G:SDOUT EXIT D:SDVCT>1 DPRT(0)
23EXIT I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
24 K ^TMP("SCRPW",$J),%,%H,%I,DIR,DFN,SD,SDDX,SDDXP,SDDIV,SDFL,SDI,SDII,SDIII,SDIV,SDIVN,SDLINE,SDMD,SDOE,SDOE0,SDOUT,SDPAGE,SDPG,SDPNOW,SDDIAG,SDPRTY,SDPT,SDPTN,SDPTV,SDSTOP,SDT,SDTIT,SDV,SDVCT,SDX,X,Y,SDSTA Q
25 ;
26DPRT(SDV) ;Print division
27 ;Required input: SDV=division ifn or '0' for combined divisions
28 I SDV S SDTIT(2)="For "_$S(SDDIV["DIVISIONS":"division",1:"facility")_": "_SDIVN
29 I 'SDV S SDTIT(2)="Report for: "_$P(SDDIV,U,2) D
30 .S SDI=2,SDIVN="" F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN="" S SDI=SDI+1,SDTIT(SDI)=$J("Division: ",$L(SDIVN))_SDIVN
31 .Q
32 S SDPAGE=1 D HDR Q:SDOUT S (SDI,SDII)="" F S SDI=$O(^TMP("SCRPW",$J,SDV,1,SDI),-1) Q:SDI=""!SDOUT!(SDII>49) S SDDX="" F S SDDX=$O(^TMP("SCRPW",$J,SDV,1,SDI,SDDX)) Q:SDDX=""!SDOUT!(SDII>49) D PLINE
33 Q
34 ;
35PLINE ;Print output line
36 D:$Y>(IOSL-8) HDR Q:SDOUT D HD1
37 ;S SDDIAG=$G(^ICD9(SDDX,0)),SDDIAG=$P(SDDIAG,U)_" "_$P(SDDIAG,U,3),SDII=SDII+1
38 S SDDIAG=$$ICDDX^ICDCODE(SDDX,,,1),SDDIAG=$P(SDDIAG,U,2)_" "_$P(SDDIAG,U,4),SDII=SDII+1
39 W !,$J(SDII,3),?6,$E(SDDIAG,1,38) D W !
40 .S (SDFL,SDPT)="" F S SDPT=$O(^TMP("SCRPW",$J,SDV,0,SDDX,SDPT)) Q:SDPT=""!SDOUT D
41 ..I $Y>(IOSL-3) D HDR,HD1 Q:SDOUT S SDFL=1
42 ..S SDPTV=^TMP("SCRPW",$J,SDV,0,SDDX,SDPT)
43 ..S SDPTN=$$CODE2TXT^XUA4A72(SDPT),SDPTN=$P(SDPT,"V",2)_" "_$P(SDPTN,U,2)
44 ..W:SDFL ! W ?46,$E(SDPTN,1,38) D S SDFL=SDFL+1
45 ...F SDIII=1:1:4 W ?(86+(12*(SDIII-1))),$J($P(SDPTV,U,SDIII),10,0)
46 ..Q
47 .Q
48 Q
49 ;
50HDR ;Print header
51 I $E(IOST)="C",SDPG N DIR S DIR(0)="E" W ! D ^DIR S SDOUT=Y'=1 Q:SDOUT
52 D STOP Q:SDOUT W:SDPG!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
53 N SDI S SDI=0 W SDLINE F S SDI=$O(SDTIT(SDI)) Q:'SDI W !?(IOM-$L(SDTIT(SDI))\2),SDTIT(SDI)
54 W !,SDLINE,!,"For Fiscal Year activity through ",SD("PEDT"),!,"Date printed: ",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1,SDPG=1 Q
55 ;
56HD1 ;Print subheader
57 Q:SDOUT W !?87,"Prim. Dx.",?103,"Total",?111,"Prim. Dx.",?127,"Total",!,"Rank IDC-9-DM Diagnosis code",?48,"Provider Type",?89,"Uniques",?101,"Uniques",?110,"Encounters",?122,"Encounters"
58 N SDI W !,"----",?6,$E(SDLINE,1,38),?46,$E(SDLINE,1,38) F SDI=0:1:3 W ?(86+(12*SDI)),$E(SDLINE,1,10)
59 Q
60 ;
61DLIST ;Create alphabetic list of divisions found
62 Q:'SDIV S SDX=$P($G(^DG(40.8,SDIV,0)),U) S:'$L(SDX) SDX="*** UNKNOWN ***" S SDIV(SDX)=SDIV,SDVCT=SDVCT+1 Q
63 ;
64VALID() ;Check encounter record
65 I $P(SDOE0,U,4),$P($G(^SC($P(SDOE0,U,4),0)),U,17)="Y" Q 0
66 I SDIV,$$DIV(),$P(SDOE0,U,2),'$P(SDOE0,U,6),$P(SDOE0,U,7),$P(SDOE0,U,12)=SDSTA Q 1
67 Q 0
68 ;
69DIV() ;Check division
70 Q:'SDDIV 1 Q $D(SDDIV(SDIV))
71 ;
72STOP ;Check for stop task request
73 S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
74 ;
75SET(SDIV) ;Set division lists
76 ;Required input: SDIV=division ifn or '0' for summary
77 S SDSTOP=SDSTOP+1 I SDSTOP#2000=0 D STOP^SCRPW40 Q:SDOUT
78 N SDDIAG,SDPRTY,SDI,SDII,SDIII,SDX S DFN=$P(SDOE0,U,2)
79 D GETDX^SDOE(SDOE,"SDDIAG"),PROV^SCRPW50(SDOE,.SDPRTY)
80 S SDI=0 F S SDI=$O(SDDIAG(SDI)) Q:'SDI S SDDX=$P(SDDIAG(SDI),U),SDDXP=$S($P(SDDIAG(SDI),U,12)="P":"P",1:"S") I SDDX D
81 .S ^TMP("SCRPW",$J,SDIV,0,SDDX)=$G(^TMP("SCRPW",$J,SDIV,0,SDDX))+1
82 .S SDII=0 F S SDII=$O(SDPRTY(SDII)) Q:'SDII S SDX=SDPRTY(SDII) I $L(SDX) D
83 ..S $P(^TMP("SCRPW",$J,SDIV,0,SDDX,SDX),U,4)=$P($G(^TMP("SCRPW",$J,SDIV,0,SDDX,SDX)),U,4)+1 D
84 ...S:SDDXP="P" $P(^TMP("SCRPW",$J,SDIV,0,SDDX,SDX),U,3)=$P($G(^TMP("SCRPW",$J,SDIV,0,SDDX,SDX)),U,3)+1
85 ...S ^TMP("SCRPW",$J,SDIV,0,"LIST",DFN,SDDX,SDX,SDDXP)=""
86 ...Q
87 ..Q
88 .Q
89 Q
Note: See TracBrowser for help on using the repository browser.