| 1 | LRTOCOST ;KC/RENO/DALISC/FHS ORDERING STATISTICS/COST REPORT ; 12/3/1997
|
---|
| 2 | ;;5.2;LAB SERVICE;**153,201,221**;Sep 27, 1994
|
---|
| 3 | ;Original routine written by Keith Cox - Reno VAMC
|
---|
| 4 | EN S LREND=0 K LRGLB
|
---|
| 5 | W @IOF,!!,$$CJ^XLFSTR("*** DATE RANGE SELECTION ***",80),!
|
---|
| 6 | S LREDT=$$FMTE^XLFDT(DT) D ^LRWU3 G:$G(LREND) EXIT
|
---|
| 7 | S LREDT=$P(LREDT,"."),LRSDT=$P(LRSDT,".")
|
---|
| 8 | S LRPBDAY=$$FMTE^XLFDT(LREDT)
|
---|
| 9 | S LRPEDAY=$$FMTE^XLFDT(LRSDT)
|
---|
| 10 | DIV ;
|
---|
| 11 | K DIR,LRCDIV D G:$G(LREND) EXIT
|
---|
| 12 | . S DIR(0)="PO^DIC(4,:AENM",DIR("A")="Select Accessioning Div "
|
---|
| 13 | . W !!?10,"<Optional Screen> Press return to select all Divisions",!
|
---|
| 14 | . F D READ Q:$G(LREND)!(Y<1) S LRCDIV(+Y)=Y
|
---|
| 15 | REF K DIR,LRLLOC,LRPRAC,LRSITE
|
---|
| 16 | S DIR("A")="Sort Report By ",DIR(0)="S^0:ALL Patients;1:REFFERAL Patients Only" D READ G:$G(LREND)!($D(DIRUT)) EXIT
|
---|
| 17 | S LRREF=Y W ! I LRREF=1 S LRSORT=1 G SORTBY
|
---|
| 18 | SORT K DIR S DIR("A")="Sort Report By ",DIR(0)="S^0:PROVIDER;1:LOCATION" D READ G:$G(LREND)!($D(DIRUT)) EXIT
|
---|
| 19 | S LRSORT=Y
|
---|
| 20 | ;
|
---|
| 21 | SORTBY K DIR S (LRLLOC,LRPRAC)=""
|
---|
| 22 | I LRREF=1,LRSORT=1 D G:$G(LREND) EXIT
|
---|
| 23 | . S DIR(0)="PO^DIC(4,:AENM",DIR("A")="Select Referral Site "
|
---|
| 24 | . W !!?10,"<Optional Screen> Press return to select all Referral Sites",!
|
---|
| 25 | . F D READ Q:$G(LREND)!(Y<1) S LRLLOC($P(Y,U,2))=""
|
---|
| 26 | K DIR
|
---|
| 27 | I LRSORT=0,LRREF=0 D G:$G(LREND) EXIT
|
---|
| 28 | . S DIR(0)="PO^VA(200,:AENM",DIR("A")="Search for What Ordering Provider "
|
---|
| 29 | . W !!?10,"<Optional Screen> Press return to select all Providers",!
|
---|
| 30 | . F D READ Q:$G(LREND)!(Y<1) S LRPRAC(+Y)=""
|
---|
| 31 | K DIR
|
---|
| 32 | I LRREF=0,LRSORT=1 D G:$G(LREND) EXIT
|
---|
| 33 | . S DIR(0)="PO^SC(:AENZM",DIR("A")="Select Ordering Location "
|
---|
| 34 | . W !!?10,"<Optional Screen> Press return to select all Locations ",!
|
---|
| 35 | . F D READ Q:$G(LREND)!(Y<1) S LRLLOC($P(Y(0),U,2))=""
|
---|
| 36 | I LRSORT D
|
---|
| 37 | . W !!?5,"You can search for locations using a Free Text screen"
|
---|
| 38 | . W !?8,"Your entry must match exactly the stored location"
|
---|
| 39 | . S DIR(0)="FO^2:30",DIR("A")="Enter Non-Standard Locations"
|
---|
| 40 | . W !!?10,"<Optional Screen> Press return to select all Locations ",!
|
---|
| 41 | . F D READ Q:$G(LREND)!('$L(Y)) S LRLLOC(Y)=""
|
---|
| 42 | PRICE K DIR S DIR("A")="Print report using ",DIR(0)="S^1:Cost;2:Price" D READ
|
---|
| 43 | G:$G(LREND)!($D(DIRUT)) EXIT
|
---|
| 44 | S LRPRICE=Y
|
---|
| 45 | TEST K DIR,LRT S LRT=""
|
---|
| 46 | D G:$G(LREND) EXIT
|
---|
| 47 | . S DIR(0)="PO^LAB(60,:AENM",DIR("A")="Select Ordered Tests "
|
---|
| 48 | . W !!?10,"<Optional Screen> Press return to select all Tests",!
|
---|
| 49 | . F D READ Q:$G(LREND)!(Y<1) S LRT(+Y)=""
|
---|
| 50 | K DIR
|
---|
| 51 | DET S DIR("A")="Would you like a detailed patient listing? ",DIR(0)="S^0:No;1:Yes" D READ G:$G(LREND)!($D(DIRUT)) EXIT
|
---|
| 52 | S LRDET=Y W !!
|
---|
| 53 | QUE K ZTSAVE,I,DIR
|
---|
| 54 | S ZTSAVE("LR*")=""
|
---|
| 55 | D EN^XUTMDEVQ("START^LRTOCOST","Lab Order Stats",.ZTSAVE) D EXIT
|
---|
| 56 | Q
|
---|
| 57 | START S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 58 | W:$E(IOST,1,2)="C-" @IOF
|
---|
| 59 | K ^TMP("LR",$J) S LRODT=LREDT-.0001
|
---|
| 60 | S ^TMP("LR",$J,0)=DT_U_DT_U_"LEDI COST REPORT"
|
---|
| 61 | F S LRODT=$O(^LRO(69,LRODT)) Q:LRODT<1!(LRODT>LRSDT) D LOOP
|
---|
| 62 | PRT I $D(LRCDIV) S LRDIVP="Division(s) / ",I=0 F S I=$O(LRCDIV(I)) Q:I<1 S LRDIVP=LRDIVP_$P(LRCDIV(I),U,2)_" / "
|
---|
| 63 | S LRPAGE=0,LRLINE="",$P(LRLINE,"-",81)="",LRPNOW=$$FMTE^XLFDT($$NOW^XLFDT) D HDR G:$G(LREND) EXIT
|
---|
| 64 | PPHY S LRPPHY="" F S LRPPHY=$O(^TMP("LR",$J,1,LRPPHY)) Q:LRPPHY=""!($G(LREND)) S LRPHY=0 F S LRPHY=$O(^TMP("LR",$J,1,LRPPHY,LRPHY)) Q:LRPHY=""!($G(LREND)) D PHYS,PTST,PURG
|
---|
| 65 | RTOT S (LRFTOT,LRFCTOT)=0 D HDR G:$G(LREND) EXIT W !,"FACILITY TOTALS by : "_$S($G(LRSORT):"Location ",1:"Provider")
|
---|
| 66 | W !?10,$S($G(LRREF):" Referral Patients ",1:"All Patients "),!
|
---|
| 67 | W !!?28," ***TESTS*** QUANTITY "_$S(LRPRICE=1:" COST",1:"PRICE")_" TOTAL COST "
|
---|
| 68 | S LRPTST="" F S LRPTST=$O(^TMP("LR",$J,3,LRPTST)) Q:LRPTST=""!($G(LREND)) D:($Y>(IOSL-4)) HDR Q:$G(LREND) D RTOT1 D:$Y>(IOSL-4) HDR
|
---|
| 69 | G:$G(LREND) EXIT
|
---|
| 70 | W !?45,"--------",?69,"----------",!?43,$J(LRFTOT,10),?69,$J(LRFCTOT,10,2)
|
---|
| 71 | D:$Y>(IOSL-4) HDR G:$G(LREND) EXIT W !!?28,"***URGENCY***" S LRPURG=""
|
---|
| 72 | F S LRPURG=$O(^TMP("LR",$J,4,LRPURG)) Q:LRPURG=""!($G(LREND)) D:$Y>(IOSL-4) HDR Q:$G(LREND) W !,$J(LRPURG,41),": ",$J(^TMP("LR",$J,4,LRPURG),10)
|
---|
| 73 | DETAIL I $G(LRDET) D
|
---|
| 74 | . S LRLOC=""
|
---|
| 75 | . S I=$O(^TMP("LR",$J,6,0)) I '$L(I) D HDR W !?7,"No Detailed data to report",!! Q
|
---|
| 76 | . S LRGLB="^TMP(""LR"","_$J_",6)",LRPNM=""
|
---|
| 77 | . D HDR Q:$G(LREND)
|
---|
| 78 | . F S LRGLB=$Q(@LRGLB) Q:$QS(LRGLB,2)'=$J!($QS(LRGLB,3)'=6)!($G(LREND)) D
|
---|
| 79 | . . D:$Y>(IOSL-4) HDR Q:$G(LREND)
|
---|
| 80 | . . S LRLOCN=$QS(LRGLB,4) I LRLOCN'=LRLOC W !!?10,"***** "_LRLOCN_" *****" S LRLOC=LRLOCN
|
---|
| 81 | . . S LRNAME=$QS(LRGLB,5)_" "_$QS(LRGLB,6)_" "_$$FMTE^XLFDT($QS(LRGLB,7))
|
---|
| 82 | . . I LRNAME'=LRPNM W !!,LRNAME S LRPNM=LRNAME
|
---|
| 83 | . . W !?10,$QS(LRGLB,8)_" $ "_@LRGLB
|
---|
| 84 | EXIT W ! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC
|
---|
| 85 | K ^TMP("LR",$J)
|
---|
| 86 | K DIR,DIRUT,DTOUT,DUOUT,I,LR0,LRBDAY,LRCDIV,LRCDT,LRCOST,LRDET,LRDIV,LRDFN,LREDAY
|
---|
| 87 | K LRDIVP,LRDPF,LRTST,LRPPHY,LRPNOW,LRFTOT
|
---|
| 88 | K LREDT,LREND,LRFCTOT,LRGLB,LRII,LRLINE,LRLLOC,LRLOC,LRLOCN,LRNAME
|
---|
| 89 | K LRNLT,LRNODE,LRODT,LRPAGE,LRPBDAY,LRPCTOT,LRPEDAY,LRPHY,LRPNM
|
---|
| 90 | K LRPRAC,LRPRICE,LRPTOT,LRPTST,LRPURG,LRREF,LRSDT,LRSITE,LRSN,LRSORT
|
---|
| 91 | K LRSPC,LRT,LRTCT,LRURG,PNM,POP,SSN,X,Y,ZTSAVE
|
---|
| 92 | Q
|
---|
| 93 | LOOP S LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,LRSN)) Q:LRSN<1 I $D(^(LRSN,0))#2 S LRNODE=^(0) D
|
---|
| 94 | . Q:$P($G(^LRO(69,LRODT,1,LRSN,1)),U,4)'="C" S LRCDT=+$G(^(1)),LRDIV=$P($G(^(1)),U,8)
|
---|
| 95 | . Q:'LRCDT I $D(LRCDIV),'$D(LRCDIV(+LRDIV)) Q
|
---|
| 96 | . S LRSPC=+$G(^LRO(69,LRODT,1,LRSN,4,1,0))
|
---|
| 97 | . Q:'$D(^LR(+LRNODE,0))#2 S LRDPF=$P(^(0),U,2),LRDFN=$P(^(0),U,3)
|
---|
| 98 | . Q:$S('$G(LRDPF):1,'$G(LRDFN):1,LRDPF=2:0,LRDPF=67:0,1:1)
|
---|
| 99 | . I $G(LRREF) Q:LRDPF'=67
|
---|
| 100 | . I '$G(LRSORT) S LRPHY=$P(LRNODE,U,6) I $L(LRPHY) D LOOP1
|
---|
| 101 | . I $G(LRSORT) S LRPHY=$P(LRNODE,U,7) I $L(LRPHY) D LOOP1
|
---|
| 102 | Q
|
---|
| 103 | LOOP1 I '$G(LRSORT),$D(LRPRAC)=11,'$D(LRPRAC(LRPHY)) Q
|
---|
| 104 | I $G(LRSORT),$D(LRLLOC)=11,'$D(LRLLOC(LRPHY)) Q
|
---|
| 105 | S LRII=0 F S LRII=$O(^LRO(69,LRODT,1,LRSN,2,LRII)) Q:LRII<1 S LR0=^LRO(69,LRODT,1,LRSN,2,LRII,0),LRTST=+LR0,LRURG=$P(LR0,U,2) I '$P(LR0,U,11),LRTST,LRURG,$P(LR0,U,3) D SET
|
---|
| 106 | Q
|
---|
| 107 | SET I $D(LRT)=11,'$D(LRT(LRTST))#2 Q
|
---|
| 108 | I $G(LRSORT) S LRPPHY=LRPHY
|
---|
| 109 | I '$G(LRSORT) S LRPPHY=$S($D(^VA(200,+LRPHY,0)):$P(^(0),U),1:LRPHY)
|
---|
| 110 | Q:'$D(^LAB(60,+LRTST,0))#2 S LRPTST=$P(^(0),U),LRNLT=+$P($G(^(64)),U)
|
---|
| 111 | S LRCOST=""
|
---|
| 112 | I LRPRICE=1 S LRCOST=$S($P($G(^LAM(LRNLT,5,LRSPC,0)),U,2):$P(^(0),U,2),1:"")
|
---|
| 113 | I LRPRICE=2 S LRCOST=$S($P($G(^LAM(LRNLT,5,LRSPC,0)),U,3):$P(^(0),U,3),1:"")
|
---|
| 114 | I 'LRCOST D
|
---|
| 115 | . I LRPRICE=1 S LRCOST=+$S($P($G(^LAM(LRNLT,0)),U,10):$P(^(0),U,10),1:LRCOST)
|
---|
| 116 | . I LRPRICE=2 S LRCOST=+$S($P($G(^LAM(LRNLT,0)),U,11):$P(^(0),U,11),1:LRCOST)
|
---|
| 117 | I 'LRCOST S LRCOST=+$P(^LAB(60,+LRTST,0),U,11)
|
---|
| 118 | S ^TMP("LR",$J,5,LRPTST)=$S(LRCOST:LRCOST,1:1)
|
---|
| 119 | S ^TMP("LR",$J,1,LRPPHY,LRPHY,LRPTST)=$G(^TMP("LR",$J,1,LRPPHY,LRPHY,LRPTST))+1,^TMP("LR",$J,3,LRPTST)=$G(^TMP("LR",$J,3,LRPTST))+1
|
---|
| 120 | S LRPURG=$P(^LAB(62.05,LRURG,0),U),^TMP("LR",$J,2,LRPPHY,LRPHY,LRPURG)=$G(^TMP("LR",$J,2,LRPPHY,LRPHY,LRPURG))+1,^TMP("LR",$J,4,LRPURG)=$G(^TMP("LR",$J,4,LRPURG))+1
|
---|
| 121 | I $G(LRDET) D
|
---|
| 122 | . ;S LRDPF=$P(^LR(+LRNODE,0),U,2),LRDFN=$P(^(0),U,3)
|
---|
| 123 | . S X=^DIC(LRDPF,0,"GL")_LRDFN_",0)",X=$S($D(@X):@X,1:"")
|
---|
| 124 | . Q:X=""
|
---|
| 125 | . S PNM=$P(X,U),SSN=$P(X,U,9)
|
---|
| 126 | . S ^TMP("LR",$J,6,LRPPHY,PNM,SSN,LRCDT,LRPTST)=$S(LRCOST:LRCOST,1:1)
|
---|
| 127 | Q
|
---|
| 128 | HDR Q:$G(LREND) I $E(IOST)="C",$G(LRPAGE) S DIR(0)="E" D ^DIR S:$D(DUOUT)!($D(DIRUT))!($D(DTOUT)) LREND=1 Q:$G(LREND)
|
---|
| 129 | W:$G(LRPAGE) @IOF
|
---|
| 130 | S LRPAGE=$G(LRPAGE)+1
|
---|
| 131 | I $D(LRGLB) W LRLINE,!,$$CJ^XLFSTR("<*> Detailed Patient Listing <*>",80)
|
---|
| 132 | W:'$D(LRGLB) LRLINE,!?17,"<*> LABORATORY TEST ORDERING STATISTICS <*>"
|
---|
| 133 | I $L($G(LRDIVP)) W !,$$CJ^XLFSTR(LRDIVP,80)
|
---|
| 134 | I $G(LRREF) W !,$$CJ^XLFSTR("Referral Patients Only Report",80)
|
---|
| 135 | W !,$$CJ^XLFSTR("For tests ordered during the date range ",80)
|
---|
| 136 | W !,$$CJ^XLFSTR(LRPBDAY_" to "_LRPEDAY,80)
|
---|
| 137 | W !,$$CJ^XLFSTR("Dollar Amounts computed using "_$S(LRPRICE=1:"COST",1:"PRICE "),80)
|
---|
| 138 | I $D(LRT)=11 D
|
---|
| 139 | . W !,$$CJ^XLFSTR("** SELECTED TESTS ONLY **",80)
|
---|
| 140 | . W ! S I="" F S I=$O(LRT(I)) Q:I<1 W $P($G(^LAB(60,I,0)),U)_" / " W:$X+30>80 !
|
---|
| 141 | W !,"Date printed: ",LRPNOW,?(60-$L(LRPAGE)),"Page: ",LRPAGE,!,LRLINE,!
|
---|
| 142 | Q
|
---|
| 143 | PHYS Q:$G(LREND) S (LRPTOT,LRPCTOT)=0 D:$Y>(IOSL-8) HDR Q:$G(LREND) W !!,$S($G(LRSORT):"Location: ",1:"Provider: "),LRPPHY I '$G(LRSORT) W:LRPHY " (",LRPHY,")"
|
---|
| 144 | Q
|
---|
| 145 | PTST Q:$G(LREND) D:$Y>(IOSL-8) HDR Q:$G(LREND)
|
---|
| 146 | W !?28," ***TESTS*** QUANTITY "_$S(LRPRICE=1:" COST",1:" PRICE")_" TOTAL COST " S LRPTST=""
|
---|
| 147 | F S LRPTST=$O(^TMP("LR",$J,1,LRPPHY,LRPHY,LRPTST)) Q:LRPTST=""!($G(LREND)) D:$Y>(IOSL-4) HDR Q:$G(LREND) D PTST1
|
---|
| 148 | Q:$G(LREND)
|
---|
| 149 | W !?45,"--------",?69,"----------",!?43,$J(LRPTOT,10),?67,"$",$J(LRPCTOT,10,2)
|
---|
| 150 | Q
|
---|
| 151 | PTST1 D:$Y>(IOSL-4) HDR Q:$G(LREND)
|
---|
| 152 | W !,$J(LRPTST,41),": " S LRTCT=^TMP("LR",$J,1,LRPPHY,LRPHY,LRPTST),LRCOST=^TMP("LR",$J,5,LRPTST) W $J(LRTCT,10),?55,$J(LRCOST,10,2),?67,"$",$J(LRTCT*LRCOST,10,2)
|
---|
| 153 | S LRPTOT=LRPTOT+LRTCT,LRPCTOT=LRPCTOT+(LRTCT*LRCOST)
|
---|
| 154 | Q
|
---|
| 155 | PURG Q:$G(LREND) D:($Y>(IOSL-6)) HDR Q:$G(LREND) W !!?28,"***URGENCY***"
|
---|
| 156 | S LRPURG="" F S LRPURG=$O(^TMP("LR",$J,2,LRPPHY,LRPHY,LRPURG)) Q:LRPURG="" D
|
---|
| 157 | . D:$Y>(IOSL-4) HDR Q:$G(LREND) W !,$J(LRPURG,41),": ",$J(^TMP("LR",$J,2,LRPPHY,LRPHY,LRPURG),10)
|
---|
| 158 | Q
|
---|
| 159 | RTOT1 D:$Y>(IOSL-4) HDR Q:$G(LREND)
|
---|
| 160 | W !,$J(LRPTST,41),": " S LRTCT=^TMP("LR",$J,3,LRPTST),LRCOST=^TMP("LR",$J,5,LRPTST) W $J(LRTCT,10),?55,$J(LRCOST,10,2),?67,"$",$J(LRTCT*LRCOST,10,2)
|
---|
| 161 | S LRFTOT=LRFTOT+LRTCT,LRFCTOT=LRFCTOT+(LRTCT*LRCOST)
|
---|
| 162 | Q
|
---|
| 163 | READ ;
|
---|
| 164 | D ^DIR S:$D(DTOUT)!($D(DUOUT)) LREND=1
|
---|
| 165 | Q
|
---|