source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW27.m@ 1742

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

initial load of FOIAVistA 6/30/08 version
File size: 7.4 KB
Line 
1SCRPW27 ;RENO/KEITH - ACRP Ad Hoc Report (cont.) ; 03 Aug 98 9:06 PM
2 ;;5.3;Scheduling;**144**;AUG 13, 1993
3PRT ;Print ACRP Ad Hoc Report
4 D:$E(IOST)="C" DISP0^SCRPW23 S SDOUT=0 G:$P(SDPAR("F",6),U)="F" PFT G PDF^SCRPW28
5 ;
6HIN ;Header initialization
7 D NOW^%DTC S SDHIN=1,Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDPAGE=1,SDLINE="",$P(SDLINE,"-",(IOM+1))="",SDPBDT=$P($G(SDPAR("L",1)),U,2),SDPEDT=$P($G(SDPAR("L",2)),U,2),SDTITLX=$P($G(SDPAR("O",2)),U)
8 Q
9 ;
10PFT ;Print as formatted text
11 S SDCOL=$S(SDF(2):0,IOM=80:3,1:29) F SDR="RPAR","RPRT","RDET" D @SDR Q:SDOUT
12 I $E(IOST)="C",'SDOUT D N DIR S DIR(0)="E" D ^DIR
13 .F Q:$Y>(IOSL-2) W !
14 .Q
15 G EXIT
16 ;
17PPAR ;Print parameters only
18 D RPAR K:$D(ZTQUEUED) SDPNOW,SDPAGE,SDLINE,SDPBDT,SDPEDT,SDTITLX Q
19 ;
20RPAR ;Print report parameters
21 D:$E(IOST)'="C" HDR^SCRPW29("Report Parameters Selected") Q:SDOUT D PLIST^SCRPW22((IOM-80\2),$S($E(IOST)="C":15,1:(IOSL-10))) Q
22 ;
23RPRT ;Print formatted report
24 W @IOF N DX,DY S (DX,DY)=0 X SDXY
25 S SDPAGE=1,SDS1="" D HDR^SCRPW29("Report Summary") Q:SDOUT I '$D(^TMP("SCRPW",$J,"RPT",1)) S SDX="No data found within selected parameters." W !!?(IOM-$L(SDX)\2),SDX S SDOUT=1 Q
26 D HD1^SCRPW29 S SDORDV=""
27 F S SDORDV=$O(^TMP("SCRPW",$J,"MASTER",SDORDV),$S(SDORD="ALP":1,1:-1)) Q:SDORDV=""!SDOUT D RPRT0
28 Q:SDOUT D RPRT1("TOT",1,1) Q
29 ;
30RPRT0 S SDS1="" F S SDS1=$O(^TMP("SCRPW",$J,"MASTER",SDORDV,SDS1)) Q:SDS1=""!SDOUT S SDS2="" F S SDS2=$O(^TMP("SCRPW",$J,"MASTER",SDORDV,SDS1,SDS2)) Q:SDS2=""!SDOUT D RPRT1("RPT",SDS1,SDS2)
31 Q
32 ;
33RPRT1(SDRPT,SDS1,SDS2) K SDX S SDX=$S(SDRPT="TOT":"REPORT TOTAL:",$G(SDPAR("P",1,6))="D":SDS2,1:SDS1)
34 S SDX(0)=+$G(^TMP("SCRPW",$J,SDRPT,1,SDS1,SDS2,"ENC")),SDX(1)=+$G(^TMP("SCRPW",$J,SDRPT,1,SDS1,SDS2,"VIS")),SDX(2)=+$G(^TMP("SCRPW",$J,SDRPT,1,SDS1,SDS2,"UNI"))
35 I SDCOL=0 S SDX(3)=+$G(^TMP("SCRPW",$J,SDRPT,2,SDS1,SDS2,"ENC")),SDX(4)=+$G(^TMP("SCRPW",$J,SDRPT,2,SDS1,SDS2,"VIS")),SDX(5)=+$G(^TMP("SCRPW",$J,SDRPT,2,SDS1,SDS2,"UNI"))
36 I SDCOL=0 F SDI=6,7,8 D CALC(SDI)
37 D:$Y>(IOSL-6) HDR^SCRPW29("Report Summary"),HD1^SCRPW29 Q:SDOUT
38 I SDRPT="TOT" W !?(SDCOL),"========================================== ======== ======== ======== " W:SDCOL=0 "======== ======== ======== ======== ======== ========"
39 W !?(SDCOL),$E(SDX,1,42) S SDI="" F S SDI=$O(SDX(SDI)) Q:SDI=""!SDOUT W ?(SDCOL+44+(10*SDI)),$S(SDX(SDI)="N/A":$J(SDX(SDI),8),1:$J(SDX(SDI),8,$S(SDI<6:0,SDX(SDI)'<100000:0,SDX(SDI)'<10000:1,1:2)))
40 Q
41 ;
42CALC(SDI) ;Calculate % change
43 S SDX(SDI)=$S(SDX(SDI-3)<1:"N/A",1:SDX(SDI-6)-SDX(SDI-3)*100/SDX(SDI-3))
44 ;
45RDET Q:SDOUT!(SDF(1)="S") S SDS1="" F S SDS1=$O(^TMP("SCRPW",$J,"RPT",1,SDS1)) Q:SDOUT!(SDS1="") S SDS2="" F S SDS2=$O(^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2)) Q:SDOUT!(SDS2="") D RDET1
46 Q
47 ;
48RDET1 S SDENC=^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2,"ENC"),SDVIS=^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2,"VIS"),SDUNI=^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2,"UNI")
49 S SDPTX(1)="Detail of "_$P(SDPAR("P",1,1),U,2)_": "_$S($G(SDPAR("P",1,6))="D":SDS2,1:SDS1),SDPTX(2)="Encounters: "_SDENC_" Visits: "_SDVIS_" Uniques: "_SDUNI D HDR^SCRPW29("Report Detail"),HD2^SCRPW29 Q:SDOUT
50 D:"EB"[SDF(3) DPTL Q:SDOUT D:"DB"[SDF(3) DDXP Q
51 ;
52DSV(SDPER) ;Encrypt detail sort values
53 N SDX S SDX=$G(^TMP("SCRPW",$J,"DSV",$P(SDPER,U,2),$P(SDPER,U))) Q:SDX SDX
54 S (SDX,^TMP("SCRPW",$J,"DSV",0))=$G(^TMP("SCRPW",$J,"DSV",0))+1
55 S ^TMP("SCRPW",$J,"DSV",$P(SDPER,U,2),$P(SDPER,U))=SDX Q SDX
56 ;
57DPTL ;Detail patient list
58 N SDDSV S SDDSV=$$DSV(SDS2_"^"_SDS1)
59 S SDCOL=$S($D(SDPAR("PF")):0,IOM=80:0,1:26) D DPHD^SCRPW29
60 S SDPNAM="" F S SDPNAM=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM)) Q:SDOUT!(SDPNAM="") S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN)) Q:SDOUT!'DFN D DPTL1
61 Q
62 ;
63DPTL1 S SDI=0 I SDF(4)="U" D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DPHD^SCRPW29 Q:SDOUT W !?(SDCOL+19),SDPNAM,?(SDCOL+51),$P($G(^DPT(DFN,0)),U,9) D APFP^SCRPW29 S SDI=SDI+1 Q
64 S SDT=0 F S SDT=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT)) Q:SDOUT!'SDT D DPTL2
65 Q
66 ;
67DPTL2 I SDF(4)="V" D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DPHD^SCRPW29 Q:SDOUT W !?(SDCOL+13),SDPNAM,?(SDCOL+45),$P($G(^DPT(DFN,0)),U,9) S Y=SDT X ^DD("DD") W ?(SDCOL+57),Y D APFP^SCRPW29 S SDI=SDI+1 Q
68 S SDDT=0 F S SDDT=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT)) Q:SDOUT!'SDDT S SDOE=0 F S SDOE=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT,SDOE)) Q:SDOUT!'SDOE D DPTL3
69 Q
70 ;
71DPTL3 D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DPHD^SCRPW29 Q:SDOUT
72 S SDCL=^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT,SDOE),SDCL=$P($G(^SC(SDCL,0)),U),Y=SDDT X ^DD("DD")
73 W !?(SDCOL),$E(SDPNAM,1,18),?(SDCOL+20),$P($G(^DPT(DFN,0)),U,9) W ?(SDCOL+32),$P(Y,":",1,2),?(SDCOL+52),$E(SDCL,1,28) D APFP^SCRPW29 S SDI=SDI+1 Q
74 ;
75DDXP ;Detail dx/procedure lists
76 I $Y>(IOSL-10) D HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("D") Q:SDOUT G DDXP0
77 W:SDF(3)="B" !! D DDPH^SCRPW29("D")
78DDXP0 I '$D(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2)) W !!,"No diagnoses found for this detail item." G DAPP
79 K SDTCT S SDQT="",SDCT=0
80 F S SDQT=$O(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2,SDQT),-1) Q:SDOUT!(SDQT="")!(SDCT>(SDF(5)-1)) S SDS3="" F S SDS3=$O(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2,SDQT,SDS3)) Q:SDOUT!(SDS3="")!(SDCT>(SDF(5)-1)) D DDXP1
81 Q:SDOUT D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("D") Q:SDOUT
82 W !?(SDCOL),"====================================",?(SDCOL+40),"==========",?(SDCOL+55),"==========",?(SDCOL+70),"==========",!?(SDCOL),"TOTAL:",?(SDCOL+40),$J(SDTCT(1),10),?(SDCOL+55),$J(SDTCT(2),10),?(SDCOL+70),$J(SDTCT(3),10)
83 ;
84DAPP I $Y>(IOSL-10) D HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("P") Q:SDOUT G DAPP0
85 W !! D DDPH^SCRPW29("P")
86DAPP0 I '$D(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2)) W !!,"No procedures found for this detail item." Q
87 K SDTCT S SDQT="",SDCT=0
88 F S SDQT=$O(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2,SDQT),-1) Q:SDOUT!(SDQT="")!(SDCT>(SDF(5)-1)) S SDS3="" F S SDS3=$O(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2,SDQT,SDS3)) Q:SDOUT!(SDS3="")!(SDCT>(SDF(5)-1)) D DAPP1
89 Q:SDOUT D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("A") Q:SDOUT W !?(SDCOL+13),"======================================",?(SDCOL+56),"==========",!?(SDCOL+13),"TOTAL:",?(SDCOL+56),$J(SDTCT(1),10)
90 Q
91 ;
92DDXP1 D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("D") Q:SDOUT F SDI=1,2,3 S SDICT(SDI)=+$P(^TMP("SCRPW",$J,"RPTDX",1,SDS1,SDS2,SDS3),U,SDI),SDTCT(SDI)=$G(SDTCT(SDI))+SDICT(SDI)
93 W !?(SDCOL),SDS3,?(SDCOL+40),$J(SDICT(1),10),?(SDCOL+55),$J(SDICT(2),10),?(SDCOL+70),$J(SDICT(3),10) S SDCT=SDCT+1 Q
94 ;
95DAPP1 D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("A") Q:SDOUT S SDICT(1)=^TMP("SCRPW",$J,"RPTAP",1,SDS1,SDS2,SDS3),SDTCT(1)=$G(SDTCT(1))+SDICT(1)
96 W !?(SDCOL+13),SDS3,?(SDCOL+56),$J(SDICT(1),10) S SDCT=SDCT+1 Q
97 ;
98EXIT D DISP0^SCRPW23,KVA^VADPT,KILL^%ZISS S X=IOM X ^%ZOSF("RM")
99 K %,%DT,%Y,C,DFN,DIC,DIR,DTOUT,DUOUT,I,II,S1,S2,SD,SDA,SDACT,SDATE,SDBOT,SDCL,SDCOL,SDCT,SDDT,SDDV,SDE,SDEDT,SDEF,SDENC,SDEXE,SDF,SDFE,SDFI,SDFL
100 K SDFOUND,SDH,SDI,SDICT,SDII,SDIRB,SDIRQ,SDISP,SDL,SDLEV,SDLINE,SDLP,SDLR,SDNUL,SDO,SDOE,SDOE0,SDOCH,SDOUT,SDP,SDPAGE,SDPAR,SDPBDT,SDPER,SDPNAM
101 K SDPNOW,SDPTX,SDQT,SDR,SDR1,SDR2,SDREV,SDRPT,SDS,SDS1,SDS2,SDS3,SDDSC1,SDSC2,SDSEL,SDT,SDTAG,SDTCT,SDTITL,SDTITLX,SDTOP,SDTX,SDTYP,SDU,SDUNI
102 K SDAPFM,SDD,SDPFL,SDIII,S0,SDLPX,SDHIN,SDV,SDVIS,SDX,SDX1,SDX2,SDY,SDYR,SDZ,T,X,X1,X2,Y,ZTSAVE,SDSTOP,SDXY,SDTEMP,SDRM,D0,DINUM,SDNEW,SDOECH
103 K SDOECH,SDORD,SDORDV,SDS4,SDTOT,^TMP("SCRPW",$J)
104 Q
Note: See TracBrowser for help on using the repository browser.