source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGSCT.m@ 1147

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1PSGSCT ;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 ;
6DONE ;
7 D ENKV^PSGSETU K COST,DRG,FD,HLP,RTN,ND,NU,P,PR,SD,ST,STOP,STRT,W,WN,WD Q
8 ;
9ENQ ;
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 ;
13ADD ; 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)
16DRG ;
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 ;
20TOT ; 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
Note: See TracBrowser for help on using the repository browser.