source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW56.m@ 1267

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1SCRPW56 ;RENO/KEITH - Most Frequent 50 CPT Codes (OP6) or (IP6) ;06/22/99
2 ;;5.3;Scheduling;**144,180,466**;AUG 13, 1993;Build 2
3 ;06/22/99 ACS - Added CPT modifier API calls
4 ;
5 S SDSTA=$G(SDSTA,2)
6 D RQUE^SCRPW50("START^SCRPW56","Most Frequent 50 CPT Codes "_$S(SDSTA=2:"(OP6)",1:"(IP6)"),1) Q
7 ;
8START ;Print report
9 K ^TMP("SCRPW",$J) S (SDSTOP,SDOUT)=0,SDT=SD("FYD")
10 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)
11 G:SDOUT EXIT S (SDVCT,SDIV)=""
12 F S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV=""!SDOUT D STOP,DLIST S SDCPT="" F S SDCPT=$O(^TMP("SCRPW",$J,SDIV,0,SDCPT)) Q:SDCPT=""!SDOUT S SDI=^TMP("SCRPW",$J,SDIV,0,SDCPT),^TMP("SCRPW",$J,SDIV,1,SDI,SDCPT)=""
13 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 CPT CODES "_$S(SDSTA=2:"(OP6)",1:"(IP6)")_" <*>",SDPG=0 D:$E(IOST)="C" DISP0^SCRPW23
14 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
15 G:SDOUT EXIT S SDIVN="" F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT D DPRT(SDIV(SDIVN))
16 G:SDOUT EXIT D:SDVCT>1 DPRT(0)
17EXIT I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
18 K ^TMP("SCRPW",$J),%,%H,%I,DIR,SD,SDCPT,SDDIV,SDFL,SDI,SDII,SDIII,SDIV,SDIVN,SDLINE,SDMD,SDOE,SDOE0,SDOUT,SDPAGE,SDPG,SDPNOW,SDPROC,SDPRTY,SDPT,SDPTN,SDQTY,SDSTOP,SDT,SDTIT,SDV,SDVCT,SDX,X,Y Q
19 ;
20DPRT(SDV) ;Print division
21 ;Required input: SDV=division ifn or '0' for combined divisions
22 I SDV S SDTIT(2)="For "_$S(SDDIV["DIVISIONS":"division",1:"facility")_": "_SDIVN
23 I 'SDV S SDTIT(2)="Report for: "_$P(SDDIV,U,2) D
24 .S SDI=2,SDIVN="" F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN="" S SDI=SDI+1,SDTIT(SDI)=$J("Division: ",$L(SDIVN))_SDIVN
25 .Q
26 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 SDCPT="" F S SDCPT=$O(^TMP("SCRPW",$J,SDV,1,SDI,SDCPT)) Q:SDCPT=""!SDOUT!(SDII>49) D PLINE
27 Q
28 ;
29PLINE ;Print output line
30 D:$Y>(IOSL-8) HDR Q:SDOUT D HD1
31 ;S SDPROC=$G(^ICPT(SDCPT,0)),SDPROC=$P(SDPROC,U)_" "_$P(SDPROC,U,2),SDII=SDII+1
32 N CPTINFO,CPTCODE,CPTTEXT
33 S CPTINFO=$$CPT^ICPTCOD(SDCPT,,1)
34 Q:CPTINFO'>0
35 S CPTCODE=$P(CPTINFO,"^",2)
36 S CPTTEXT=$P(CPTINFO,"^",3)
37 S SDPROC=CPTCODE_" "_CPTTEXT
38 S SDII=SDII+1
39 W !?7,$J(SDII,3),?13,SDPROC,?50,$J(SDI,10,0) D W !
40 .S (SDFL,SDPT)="" F S SDPT=$O(^TMP("SCRPW",$J,SDV,0,SDCPT,SDPT)) Q:SDPT=""!SDOUT D
41 ..I $Y>(IOSL-3) D HDR,HD1 Q:SDOUT S SDFL=1
42 ..S SDPTN=$$CODE2TXT^XUA4A72(SDPT),SDPTN=$P(SDPT,"V",2)_" "_$P(SDPTN,U,2)
43 ..W:SDFL ! W ?62,$E(SDPTN,1,50),?114,$J(^TMP("SCRPW",$J,SDV,0,SDCPT,SDPT),10,0) S SDFL=SDFL+1
44 ..Q
45 .Q
46 Q
47 ;
48HDR ;Print header
49 I $E(IOST)="C",SDPG N DIR S DIR(0)="E" W ! D ^DIR S SDOUT=Y'=1 Q:SDOUT
50 D STOP Q:SDOUT W:SDPG!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
51 N SDI S SDI=0 W SDLINE F S SDI=$O(SDTIT(SDI)) Q:'SDI W !?(IOM-$L(SDTIT(SDI))\2),SDTIT(SDI)
52 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
53 ;
54HD1 ;Print subheader
55 Q:SDOUT W !?52,"CPT Code",?114,"Prov. Type",!?7,"Rank",?13,"CPT Code",?51,"Frequency",?62,"Provider Type",?115,"Frequency"
56 W !?7,"----",?13,$E(SDLINE,1,35),?50,$E(SDLINE,1,10),?62,$E(SDLINE,1,50),?114,$E(SDLINE,1,10) Q
57 ;
58DLIST ;Create alphabetic list of divisions found
59 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
60 ;
61VALID() ;Check encounter record
62 I $P(SDOE0,U,4),$P($G(^SC($P(SDOE0,U,4),0)),U,17)="Y" Q 0
63 I SDIV,$$DIV(),$P(SDOE0,U,2),'$P(SDOE0,U,6),$P(SDOE0,U,7),$P(SDOE0,U,12)=SDSTA Q 1
64 Q 0
65 ;
66DIV() ;Check division
67 Q:'SDDIV 1 Q $D(SDDIV(SDIV))
68 ;
69STOP ;Check for stop task request
70 S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
71 ;
72SET(SDIV) ;Set division lists
73 ;Required input: SDIV=division ifn or '0' for summary
74 S SDSTOP=SDSTOP+1 I SDSTOP#2000=0 D STOP^SCRPW40 Q:SDOUT
75 N SDPROC,SDPRTY,SDI,SDII,SDIII,SDX
76 D GETCPT^SDOE(SDOE,"SDPROC"),PROV^SCRPW50(SDOE,.SDPRTY)
77 S SDI=0 F S SDI=$O(SDPROC(SDI)) Q:'SDI S SDCPT=$P(SDPROC(SDI),U),SDQTY=$P(SDPROC(SDI),U,16) S:'SDQTY SDQTY=1 I SDCPT D
78 .S ^TMP("SCRPW",$J,SDIV,0,SDCPT)=$G(^TMP("SCRPW",$J,SDIV,0,SDCPT))+SDQTY
79 .S SDII=0 F S SDII=$O(SDPRTY(SDII)) Q:'SDII S SDX=SDPRTY(SDII) I $L(SDX) D
80 ..S ^TMP("SCRPW",$J,SDIV,0,SDCPT,SDX)=$G(^TMP("SCRPW",$J,SDIV,0,SDCPT,SDX))+1
81 ..Q
82 .Q
83 Q
Note: See TracBrowser for help on using the repository browser.