source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW28.m@ 747

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1SCRPW28 ;RENO/KEITH - ACRP Ad Hoc Report (cont.) ; 12/5/00 4:44pm
2 ;;5.3;Scheduling;**144,232**;AUG 13, 1993
3PDF ;Print delimited format
4 S (SDOUT,SDSTOP)=0 D RPAR,RSUM,RDET G EXIT^SCRPW27
5 ;
6RPAR W !,$$BRK("Report Parameters") Q:SDOUT
7 W !,"TYPE^CATEGORY^SUB-CATEGORY^VALUE^METHOD^INCLUDE/EXCLUDE"
8 S SDI=0 F S SDI=$O(SDPAR("F",SDI)) Q:'SDI W !,"FORMAT^",$P($T(F+SDI^SCRPW22),";;",2),"^(none)^",$P(SDPAR("F",SDI),U,2),"^^"
9 D ITEM("P",1) F SDI=1,2 W !,"LIMITATION^",$P($T(L+SDI^SCRPW22),";;",2),"^(none)^",$P(SDPAR("L",SDI),U,2),"^^"
10 S SDI=2 F S SDI=$O(SDPAR("L",SDI)) Q:'SDI D ITEM("L",SDI)
11 F SDI=1,2 W !,"ORDER^",$P($T(O+SDI^SCRPW22),";;",2),"^(none)^",$P($G(SDPAR("O",SDI)),U,2),"^^"
12 F SDI=2,1 S SDII=0 F S SDII=$O(SDPAR("PF",SDI,SDII)) Q:'SDII S SDX=SDPAR("PF",SDI,SDII) W !,"ADDL. PRINT FIELD^",$P(SDX,U,2),U,$P(SDX,U,3)
13 Q
14 ;
15ITEM(SDS1,SDS2) ;Print parameter item
16 K SD S SD(1)=$S(SDS1="P":"PERSPECTIVE",1:"LIMITATION"),SD(2)=$P(SDPAR(SDS1,SDS2),U,2),SD(3)=$P(SDPAR(SDS1,SDS2,1),U,2) I '$D(SDPAR(SDS1,SDS2,4)) D IPRT Q
17 S SD(5)=$P(SDPAR(SDS1,SDS2,2),U,2),SD(6)=$S($P($G(SDPAR(SDS1,SDS2,3)),U)="E":"EXCLUDE",1:"INCLUDE")
18 I $G(SDPAR(SDS1,SDS2,6))="D" S SDS3=0 D Q
19 .F S SDS3=$O(SDPAR(SDS1,SDS2,5,SDS3)) Q:'SDS3 S SD(4)=SDPAR(SDS1,SDS2,5,SDS3) D IPRT
20 .Q
21 S SDS3="" F S SDS3=$O(SDPAR(SDS1,SDS2,4,SDS3)) Q:SDS3="" S SD(4)=SDS3 D IPRT
22 Q
23 ;
24IPRT N SDI W ! F SDI=1:1:6 W $G(SD(SDI)) W:SDI'=6 U ;SD*5.3*232 TEJ- N SDI
25 Q
26 ;
27BRK(SDX) ;Print table break
28 D STOP^SCRPW26 Q:SDOUT
29 N SDY S SDY="",$P(SDY,"-",(132-$L(SDX)\2))=SDX F S SDY=SDY_"-" Q:$L(SDY)>131
30 Q SDY
31 ;
32EXT() ;Return external value
33 Q $S($G(SDPAR("P",1,6))="D":SDS2,1:SDS1)
34 ;
35RSUM ;Print report summary
36 W !,$$BRK("Report Summary") Q:SDOUT
37 W !,$P(SDPAR("P",1,1),U,2),U,"ENCOUNTERS",U,"VISITS",U,"UNIQUES"
38 I SDF(2) W U,"PRIOR YEAR ENCOUNTERS",U,"PRIOR YEAR VISITS",U,"PRIOR YEAR UNIQUES",U,"% CHANGE UNIQUES",U,"% CHANGE VISITS",U,"% CHANGE UNIQUES"
39 I '$D(^TMP("SCRPW",$J,"RPT",1)) W !,"No data found within selected parameters." Q
40 S SDORDV="" F S SDORDV=$O(^TMP("SCRPW",$J,"MASTER",SDORDV),$S(SDORD="ALP":1,1:-1)) Q:SDORDV=""!SDOUT D RSUM0
41 Q:SDOUT D RSUM1("TOT",1,1) Q
42 ;
43RSUM0 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 RSUM1("RPT",SDS1,SDS2)
44 Q
45 ;
46RSUM1(SDRPT,SDS1,SDS2) D STOP Q:SDOUT
47 K SDX S SDX=$S(SDRPT="TOT":"REPORT TOTAL",$G(SDPAR("P",1,6))="D":SDS2,1:SDS1)
48 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"))
49 I SDF(2) 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"))
50 I SDF(2) F SDI=6,7,8 D CALC(SDI)
51 W !,SDX S SDI="" F S SDI=$O(SDX(SDI)) Q:SDI="" W U,$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)))
52 Q
53 ;
54CALC(SDI) ;Calculate % change
55 S SDX(SDI)=$S(SDX(SDI-3)<1:"N/A",1:SDX(SDI-6)-SDX(SDI-3)*100/SDX(SDI-3))
56 ;
57RDET Q:SDF(1)="S" S SDS1="" F S SDS1=$O(^TMP("SCRPW",$J,"RPT",1,SDS1)) Q:SDS1=""!SDOUT S SDS2="" F S SDS2=$O(^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2)) Q:SDS2=""!SDOUT D RDET1
58 Q
59 ;
60RDET1 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")
61 D:"EB"[SDF(3) DPTL Q:SDOUT D:"DB"[SDF(3) DDXP Q
62 ;
63DSV(SDPER) ;Encrypt detail sort values
64 N SDX S SDX=$G(^TMP("SCRPW",$J,"DSV",$P(SDPER,U,2),$P(SDPER,U))) Q:SDX SDX
65 S (SDX,^TMP("SCRPW",$J,"DSV",0))=$G(^TMP("SCRPW",$J,"DSV",0))+1
66 S ^TMP("SCRPW",$J,"DSV",$P(SDPER,U,2),$P(SDPER,U))=SDX Q SDX
67 ;
68DPTL ;Detail patient list
69 N SDX1,SDDSV S SDDSV=$$DSV(SDS2_"^"_SDS1)
70 S SDX1=$P(SDPAR("P",1,1),U,2)_": "_$$EXT()_" - "_$S(SDF(4)="E":"Encounter",SDF(4)="V":"Visit",1:"Unique patient")_" list" W !,$$BRK(SDX1) Q:SDOUT
71 W !,"PATIENT",U,"SSN" I "VE"[SDF(4) W U,"DATE" I SDF(4)="E" W U,"LOCATION"
72 K ^TMP("SCRPW",$J,"APFM") S SDAPFM=0 D:$D(SDPAR("PF")) APFH
73 S SDPNAM="" F S SDPNAM=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM)) Q:SDPNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN)) Q:'DFN!SDOUT D DPTL1
74 Q:'$D(^TMP("SCRPW",$J,"APFM"))
75 W !,$$BRK(SDX1_" (LINKED SUB-TABLE)") Q:SDOUT W !,"LINK^DATA VALUE"
76 S SDAPFM=0 F S SDAPFM=$O(^TMP("SCRPW",$J,"APFM",SDAPFM)) Q:'SDAPFM!SDOUT S SDX="" F S SDX=$O(^TMP("SCRPW",$J,"APFM",SDAPFM,SDX)) Q:SDX=""!SDOUT W !,SDAPFM,U,^TMP("SCRPW",$J,"APFM",SDAPFM,SDX) D STOP
77 Q
78 ;
79STOP S SDSTOP=SDSTOP+1 D:SDSTOP#100=0 STOP^SCRPW26 Q
80 ;
81DPTL1 I SDF(4)="U" W !,SDPNAM,U,$P($G(^DPT(DFN,0)),U,9) D APFP,STOP Q
82 S SDT=0 F S SDT=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT)) Q:'SDT!SDOUT D DPTL2
83 Q
84 ;
85DPTL2 I SDF(4)="V" W !,SDPNAM,U,$P($G(^DPT(DFN,0)),U,9) S Y=SDT X ^DD("DD") W U,Y D APFP,STOP Q
86 S SDDT=0 F S SDDT=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT)) Q:'SDDT!SDOUT S SDOE=0 F S SDOE=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT,SDOE)) Q:'SDOE!SDOUT D DPTL3
87 Q
88 ;
89DPTL3 D STOP Q:SDOUT S SDCL=^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT,SDOE),SDCL=$P($G(^SC(SDCL,0)),U),Y=SDDT X ^DD("DD")
90 W !,SDPNAM,U,$P($G(^DPT(DFN,0)),U,9),U,Y,U,SDCL D APFP Q
91 ;
92DDXP ;Detail dx/procedure lists
93 W !,$$BRK($P(SDPAR("P",1,1),U,2)_": "_$$EXT()_" - Diagnosis ranking") Q:SDOUT
94 W !,"DIAGNOSIS",U,"PRIMARY",U,"SECONDARY",U,"TOTAL"
95 I '$D(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2)) W !,"No diagnoses found for this detail item." G DAPP
96 K SDTCT S SDQT="",SDCT=0 F S SDQT=$O(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2,SDQT),-1) Q:SDQT=""!(SDCT>SDF(5))!SDOUT S SDS3="" F S SDS3=$O(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2,SDQT,SDS3)) Q:SDS3=""!(SDCT>SDF(5))!SDOUT D DDXP1
97 Q:SDOUT W !,"TOTAL",U,$J(SDTCT(1),10),U,$J(SDTCT(2),10),U,$J(SDTCT(3),10)
98 ;
99DAPP W !,$$BRK($P(SDPAR("P",1,1),U,2)_": "_$$EXT()_" - Ambulatory procedure ranking") Q:SDOUT W !,"PROCEDURES",U,"TOTAL"
100 I '$D(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2)) W !,"No procedures found for this detail item." Q
101 K SDTCT S SDQT="",SDCT=0 F S SDQT=$O(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2,SDQT),-1) Q:SDQT=""!(SDCT>SDF(5))!SDOUT S SDS3="" F S SDS3=$O(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2,SDQT,SDS3)) Q:SDS3=""!(SDCT>SDF(5))!SDOUT D DAPP1
102 Q:SDOUT W !,"TOTAL",U,$J(SDTCT(1),10)
103 Q
104 ;
105DDXP1 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)
106 W !,SDS3,U,$J(SDICT(1),10),U,$J(SDICT(2),10),U,$J(SDICT(3),10) S SDCT=SDCT+1 D STOP Q
107 ;
108DAPP1 S SDICT(1)=^TMP("SCRPW",$J,"RPTAP",1,SDS1,SDS2,SDS3),SDTCT(1)=$G(SDTCT(1))+SDICT(1)
109 W !,SDS3,U,$J(SDICT(1),10) S SDCT=SDCT+1 D STOP Q
110 ;
111APFH ;Addl. print fields header
112 N S1,S2,SDX
113 F S1=2,1 S S2=0 F S S2=$O(SDPAR("PF",S1,S2)) Q:'S2 S SDX=SDPAR("PF",S1,S2) W U,$P(^TMP("SCRPW",$J,"ACT",$P(SDX,U)),T) W:$P(^TMP("SCRPW",$J,"ACT",$P(SDX,U)),T,12) " (LINK)"
114 Q
115 ;
116APFP ;Addl. print fields print
117 N S1,S2,SDX,SDACT,SDY,SDOE0
118 F S1=2,1 S S2=0 F S S2=$O(SDPAR("PF",S1,S2)) Q:'S2 S SDY=SDPAR("PF",S1,S2),SDACT=^TMP("SCRPW",$J,"ACT",$P(SDY,U)),SDOE0=$$OE0() K SDX X $P(SDACT,T,7) W U,$$APF()
119 Q
120 ;
121APF() N SDZ S (SDZ,SDX)="" S SDX=$O(SDX(SDX)) Q:'$P(SDACT,T,12) $P(SDX(SDX),U,2)
122 S SDAPFM=SDAPFM+1,SDX="" F S SDX=$O(SDX(SDX)) Q:SDX="" S ^TMP("SCRPW",$J,"APFM",SDAPFM,SDX)=$P(SDX(SDX),U,2)
123 Q SDAPFM
124 ;
125OE0() ;Get encounter node
126 Q:"UV"[SDF(4) U_DFN_U
127 Q $$GETOE^SDOE(SDOE)
Note: See TracBrowser for help on using the repository browser.