- 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
- 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
