| [613] | 1 | PSGSCT ;BIR/CML3-SERVICE COST TOTALS ; 22 Jun 98 / 1:50 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**3,12**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | D ENCV^PSGSETU I '$D(XQUIT) S HLP="SERVICE" D ENDTS^PSGAMS I SD,FD S ZTDESC="COST PER SERVICE REPORT",RTN="SCT" D EN3^PSGTI I 'POP,'$D(IO("Q")) D ENQ D:IO'=IO(0)!($E(IOST)'="C") ^%ZISC
|
|---|
| 5 | ;
|
|---|
| 6 | DONE ;
|
|---|
| 7 | D ENKV^PSGSETU K COST,DRG,FD,HLP,RTN,ND,NU,P,PR,SD,ST,STOP,STRT,W,WN,WD Q
|
|---|
| 8 | ;
|
|---|
| 9 | ENQ ;
|
|---|
| 10 | K ^UTILITY("PSG",$J) F ST=SD:0 S ST=$O(^PS(57.6,ST)) Q:'ST!(ST>FD) S W=0 F S W=$O(^PS(57.6,ST,1,W)) Q:'W S (CNT,COST)=0,(SN,WD)="" D ADD
|
|---|
| 11 | D ^PSGSCT0 K ^UTILITY("PSG",$J) Q
|
|---|
| 12 | ;
|
|---|
| 13 | ADD ; find service, if possible, or ward name
|
|---|
| 14 | S SN=$P($G(^DIC(42,W,0)),"^",3) I SN]"",$$VFIELD^DILFD(42,.03) S SN=$$EXTERNAL^DILFD(42,.03,"",SN) G:SN]"" DRG
|
|---|
| 15 | S WD=$S('$D(^DIC(42,W,0)):W,$P(^(0),"^")]"":$P(^(0),"^"),1:W)
|
|---|
| 16 | DRG ;
|
|---|
| 17 | S PR=0 F S PR=$O(^PS(57.6,ST,1,W,1,PR)) Q:'PR S DRG=0 F S DRG=$O(^PS(57.6,ST,1,W,1,PR,1,DRG)) Q:'DRG I $D(^(DRG,0)) S ND=^(0),CNT=CNT+$P(ND,"^",2)-$P(ND,"^",4),COST=COST+$P(ND,"^",3)-$P(ND,"^",5)
|
|---|
| 18 | Q:'CNT&'COST
|
|---|
| 19 | ;
|
|---|
| 20 | TOT ; set global of service, if service found, or ward if service not found
|
|---|
| 21 | I SN]"" S ND=$G(^UTILITY("PSG",$J,"S",SN)),^(SN)=+ND+CNT_"^"_($P(ND,"^",2)+COST) Q
|
|---|
| 22 | S ND=$G(^UTILITY("PSG",$J,"W",WD)),^(WD)=+ND+CNT_"^"_($P(ND,"^",2)+COST) Q
|
|---|
