PSGSCT ;BIR/CML3-SERVICE COST TOTALS ; 22 Jun 98 / 1:50 PM
;;5.0; INPATIENT MEDICATIONS ;**3,12**;16 DEC 97
;
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
;
DONE ;
D ENKV^PSGSETU K COST,DRG,FD,HLP,RTN,ND,NU,P,PR,SD,ST,STOP,STRT,W,WN,WD Q
;
ENQ ;
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
D ^PSGSCT0 K ^UTILITY("PSG",$J) Q
;
ADD ; find service, if possible, or ward name
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
S WD=$S('$D(^DIC(42,W,0)):W,$P(^(0),"^")]"":$P(^(0),"^"),1:W)
DRG ;
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)
Q:'CNT&'COST
;
TOT ; set global of service, if service found, or ward if service not found
I SN]"" S ND=$G(^UTILITY("PSG",$J,"S",SN)),^(SN)=+ND+CNT_"^"_($P(ND,"^",2)+COST) Q
S ND=$G(^UTILITY("PSG",$J,"W",WD)),^(WD)=+ND+CNT_"^"_($P(ND,"^",2)+COST) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGSCT 1274 printed Dec 13, 2024@02:03:07 Page 2
PSGSCT ;BIR/CML3-SERVICE COST TOTALS ; 22 Jun 98 / 1:50 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**3,12**;16 DEC 97
+2 ;
+3 DO ENCV^PSGSETU
IF '$DATA(XQUIT)
SET HLP="SERVICE"
DO ENDTS^PSGAMS
IF SD
IF FD
SET ZTDESC="COST PER SERVICE REPORT"
SET RTN="SCT"
DO EN3^PSGTI
IF 'POP
IF '$DATA(IO("Q"))
DO ENQ
if IO'=IO(0)!($EXTRACT(IOST)'="C")
DO ^%ZISC
+4 ;
DONE ;
+1 DO ENKV^PSGSETU
KILL COST,DRG,FD,HLP,RTN,ND,NU,P,PR,SD,ST,STOP,STRT,W,WN,WD
QUIT
+2 ;
ENQ ;
+1 KILL ^UTILITY("PSG",$JOB)
FOR ST=SD:0
SET ST=$ORDER(^PS(57.6,ST))
if 'ST!(ST>FD)
QUIT
SET W=0
FOR
SET W=$ORDER(^PS(57.6,ST,1,W))
if 'W
QUIT
SET (CNT,COST)=0
SET (SN,WD)=""
DO ADD
+2 DO ^PSGSCT0
KILL ^UTILITY("PSG",$JOB)
QUIT
+3 ;
ADD ; find service, if possible, or ward name
+1 SET SN=$PIECE($GET(^DIC(42,W,0)),"^",3)
IF SN]""
IF $$VFIELD^DILFD(42,.03)
SET SN=$$EXTERNAL^DILFD(42,.03,"",SN)
if SN]""
GOTO DRG
+2 SET WD=$SELECT('$DATA(^DIC(42,W,0)):W,$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:W)
DRG ;
+1 SET PR=0
FOR
SET PR=$ORDER(^PS(57.6,ST,1,W,1,PR))
if 'PR
QUIT
SET DRG=0
FOR
SET DRG=$ORDER(^PS(57.6,ST,1,W,1,PR,1,DRG))
if 'DRG
QUIT
IF $DATA(^(DRG,0))
SET ND=^(0)
SET CNT=CNT+$PIECE(ND,"^",2)-$PIECE(ND,"^",4)
SET COST=COST+$PIECE(ND,"^",3)-$PIECE(ND,"^",5)
+2 if 'CNT&'COST
QUIT
+3 ;
TOT ; set global of service, if service found, or ward if service not found
+1 IF SN]""
SET ND=$GET(^UTILITY("PSG",$JOB,"S",SN))
SET ^(SN)=+ND+CNT_"^"_($PIECE(ND,"^",2)+COST)
QUIT
+2 SET ND=$GET(^UTILITY("PSG",$JOB,"W",WD))
SET ^(WD)=+ND+CNT_"^"_($PIECE(ND,"^",2)+COST)
QUIT
