PSIVPCR1 ;BIR/PR,MV-PRINT PROVIDER COST REPORT ;07 OCT 97 / 9:49 AM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
P ;
S:'$D(PT) (PT,GT)=0 S (P,DG)=""
I $D(BRIEF) D BRIEF Q
F V=0:0 D F S V=$O(^UTILITY($J,V)) Q:'V W !,"IV ROOM: "_$P(^PS(59.5,V,0),U),! D P1
D F W !!?17,"GRAND TOTAL:",?116,"================",!?114,"$",$J(GT,17,2) D TM^PSIVDCR1 G K
Q
P1 ;
S P1="" F J=0:0 D F S P1=$O(^UTILITY($J,V,P1)) Q:P1="" W !?1,"PROVIDER: ",P1,! D P2
Q
P2 ;
F J=0:0 S DG=$O(^UTILITY($J,V,P1,DG)) Q:DG="" D P3
D F W !,?116,"----------------"
D F W !?5,"TOTAL FOR PROVIDER: ",P1,?114,"$",$J(PT,17,2),!! S GT=GT+PT,PT=0
Q
P3 ;
S G=^UTILITY($J,V,P1,DG)
S C=$P(G,U,2),X=$P(^DD(52.6,2,0),U,3),X=$P(X,";",C),X=$P(X,":",2),C=X
I $D(BRIEF) S PT=PT+$P(G,U,4) Q
D F W !?2,$E(DG,1,33),?36,$J($P(G,U,3),8,2)_" "_C,?59,$J($P(G,U,6),8,2),?73,$J($P(G,U,5),9,2),?96,$J($P(G,U,7),9,2),?114,"$",$J($P(G,U,4),17,2) S PT=PT+$P(G,U,4)
Q
F ;
I $Y+5>IOSL D H^PSIVPCR
Q
BRIEF ;***Print the condensed Provider cost report.
S (P1,DG)="" F V=0:0 D F S V=$O(^UTILITY($J,V)) Q:'V W !!!?10,"IV ROOM: "_$P(^PS(59.5,V,0),U),! D
. F S P1=$O(^UTILITY($J,V,P1)) Q:P1="" D
.. F S DG=$O(^UTILITY($J,V,P1,DG)) Q:DG="" S PT=PT+$P(^UTILITY($J,V,P1,DG),U,4)
.. W !,P1,?45,"$",$J(PT,17,2),! S GT=GT+PT,PT=0
W !!,?46,"=================",!,?20,"GRAND TOTAL:",?45,"$",$J(GT,17,2)
D TM^PSIVDCR1
D K
Q
K ;
S:$D(ZTQUEUED) ZTREQ="@"
K VA,DA,DAT,DES,P,P1,DG,G,G2,GT,H,I,V,J,JJ,NA,PG,UR,SS,S,PT,CO,UD,UM,Y,I7,I8,I6,I2,C,UC,D,I1,ZTSK,Z,Y,^UTILITY($J),I9,I10,I11,I4,I15,%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVPCR1 1578 printed Sep 23, 2025@19:40:58 Page 2
PSIVPCR1 ;BIR/PR,MV-PRINT PROVIDER COST REPORT ;07 OCT 97 / 9:49 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
P ;
+1 if '$DATA(PT)
SET (PT,GT)=0
SET (P,DG)=""
+2 IF $DATA(BRIEF)
DO BRIEF
QUIT
+3 FOR V=0:0
DO F
SET V=$ORDER(^UTILITY($JOB,V))
if 'V
QUIT
WRITE !,"IV ROOM: "_$PIECE(^PS(59.5,V,0),U),!
DO P1
+4 DO F
WRITE !!?17,"GRAND TOTAL:",?116,"================",!?114,"$",$JUSTIFY(GT,17,2)
DO TM^PSIVDCR1
GOTO K
+5 QUIT
P1 ;
+1 SET P1=""
FOR J=0:0
DO F
SET P1=$ORDER(^UTILITY($JOB,V,P1))
if P1=""
QUIT
WRITE !?1,"PROVIDER: ",P1,!
DO P2
+2 QUIT
P2 ;
+1 FOR J=0:0
SET DG=$ORDER(^UTILITY($JOB,V,P1,DG))
if DG=""
QUIT
DO P3
+2 DO F
WRITE !,?116,"----------------"
+3 DO F
WRITE !?5,"TOTAL FOR PROVIDER: ",P1,?114,"$",$JUSTIFY(PT,17,2),!!
SET GT=GT+PT
SET PT=0
+4 QUIT
P3 ;
+1 SET G=^UTILITY($JOB,V,P1,DG)
+2 SET C=$PIECE(G,U,2)
SET X=$PIECE(^DD(52.6,2,0),U,3)
SET X=$PIECE(X,";",C)
SET X=$PIECE(X,":",2)
SET C=X
+3 IF $DATA(BRIEF)
SET PT=PT+$PIECE(G,U,4)
QUIT
+4 DO F
WRITE !?2,$EXTRACT(DG,1,33),?36,$JUSTIFY($PIECE(G,U,3),8,2)_" "_C,?59,$JUSTIFY($PIECE(G,U,6),8,2),?73,$JUSTIFY($PIECE(G,U,5),9,2),?96,$JUSTIFY($PIECE(G,U,7),9,2),?114,"$",$JUSTIFY($PIECE(G,U,4),17,2)
SET PT=PT+$PIECE(G,U,4)
+5 QUIT
F ;
+1 IF $Y+5>IOSL
DO H^PSIVPCR
+2 QUIT
BRIEF ;***Print the condensed Provider cost report.
+1 SET (P1,DG)=""
FOR V=0:0
DO F
SET V=$ORDER(^UTILITY($JOB,V))
if 'V
QUIT
WRITE !!!?10,"IV ROOM: "_$PIECE(^PS(59.5,V,0),U),!
Begin DoDot:1
+2 FOR
SET P1=$ORDER(^UTILITY($JOB,V,P1))
if P1=""
QUIT
Begin DoDot:2
+3 FOR
SET DG=$ORDER(^UTILITY($JOB,V,P1,DG))
if DG=""
QUIT
SET PT=PT+$PIECE(^UTILITY($JOB,V,P1,DG),U,4)
+4 WRITE !,P1,?45,"$",$JUSTIFY(PT,17,2),!
SET GT=GT+PT
SET PT=0
End DoDot:2
End DoDot:1
+5 WRITE !!,?46,"=================",!,?20,"GRAND TOTAL:",?45,"$",$JUSTIFY(GT,17,2)
+6 DO TM^PSIVDCR1
+7 DO K
+8 QUIT
K ;
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL VA,DA,DAT,DES,P,P1,DG,G,G2,GT,H,I,V,J,JJ,NA,PG,UR,SS,S,PT,CO,UD,UM,Y,I7,I8,I6,I2,C,UC,D,I1,ZTSK,Z,Y,^UTILITY($JOB),I9,I10,I11,I4,I15,%
+3 QUIT
