PSGPRVR0 ;BIR/CML3-PRINT COST PER PROVIDER REPORT ;31 OCT 95 / 2:04 PM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
START ;
D NOW^%DTC S PSGDT=%,PSGPDT=$$ENDTC^PSGMI(PSGDT),CML=IO'=IO(0)!(IOST'["C-"),(DRG,NP,LN1,LN2,PR)="",$P(LN1,"-",81)="",$P(LN2,"=",81)="",(PG,TCNT,TCST)=0
U IO I '$D(^TMP("PSG",$J)) D HDR W !!?22,"*** NO PROVIDER COST DATA FOUND ***" G DONE
;
RUN ;
I 'PSGPRVRP D HDR
F D:PR]"" PTOT G:NP["^" DONE S PR=$O(^TMP("PSG",$J,PR)) Q:PR="" D:PSGPRVRP NP W !?1,PR S (PCNT,PCST)=0 F Q=0:0 S DRG=$O(^TMP("PSG",$J,PR,DRG)) Q:DRG="" S CST=^(DRG),NF=$P(CST,U,3) D DRGP I NP["^" G DONE
;
TOTLS ;
S PR=$S(PSGPRVRP:1,1:$Y+8>IOSL) D:PR NP I NP'["^" S TCPU=$S(TCNT:TCST/TCNT,1:0) S:TCST<0&(TCPU>0) TCPU=-TCPU W !!,LN2,!!?5,"TOTALS =>",?17,"AVG. COST/UNIT: ",$J(TCPU,0,2),?52,$J(TCNT,9,0),?67,$J(TCST,12,2)
W !!!?34,"*** DONE ***" I 'PR,NP'["^",CML F X=$Y:1:IOSL-4 W !
I W !?54,"(** = NON-FORMULARY ITEM)"
;
DONE ;
W:CML&($Y) @IOF,@IOF K %,CML,CNT,CPU,CST,LN1,LN2,NP,PCNT,PCPU,PCST,PSGID,PSGOD,PSGPDT,SN,TCNT,TCPU,TCST Q
;
PTOT ;
I $Y+5>IOSL D NP Q:NP["^" W !?1,PR," (cont.)"
S TCNT=TCNT+PCNT,TCST=TCST+PCST,PCPU=$S(PCNT:PCST/PCNT,1:0) S:PCST<0&(PCPU>0) PCPU=-PCPU W ?52,"---------",?67,"------------",!?1,"----- AVG. COST/UNIT: ",$J(PCPU,0,2),?52,$J(PCNT,9,0),?67,$J(PCST,12,2) W:'PSGPRVRP !! Q
;
DRGP ;
I $Y+4>IOSL D NP Q:NP["^" W !?1,PR," (cont.)"
S CNT=+CST,CST=$P(CST,"^",2),PCNT=PCNT+CNT,PCST=PCST+CST
W !?4,$S('NF:" ",1:"**")," ",$S(DRG'="zz":$P(DRG,"^"),1:"*** DRUG NOT FOUND ***"),?52,$J(CNT,9,0),?67,$J(CST,12,2),!
Q
;
NP ;
I PG,PR]"",'CML W $C(7) R !,"'^' TO STOP ",NP:DTIME W:'$T $C(7) S:'$T NP="^" Q:NP["^"
I PG,PR]"",CML F X=$Y:1:IOSL-4 W !
I W !?54,"(** = NON-FORMULARY ITEM)"
;
HDR ;
S PG=PG+1 W:$Y @IOF W !!?1,PSGPDT,?24,"UNIT DOSE COST PER PROVIDER REPORT",?73-$L(PG),"Page: ",PG,!?28,"FROM ",STRT," TO ",STOP,!!?1,"PROVIDER",?52,"TOTAL UNITS",?72,"TOTAL",!?10,"DRUG",?53,"DISPENSED",?72,"COST",!,LN1,! Q
PSGPRVR0 ;BIR/CML3-PRINT COST PER PROVIDER REPORT ;31 OCT 95 / 2:04 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
START ;
+1 DO NOW^%DTC
SET PSGDT=%
SET PSGPDT=$$ENDTC^PSGMI(PSGDT)
SET CML=IO'=IO(0)!(IOST'["C-")
SET (DRG,NP,LN1,LN2,PR)=""
SET $PIECE(LN1,"-",81)=""
SET $PIECE(LN2,"=",81)=""
SET (PG,TCNT,TCST)=0
+2 USE IO
IF '$DATA(^TMP("PSG",$JOB))
DO HDR
WRITE !!?22,"*** NO PROVIDER COST DATA FOUND ***"
GOTO DONE
+3 ;
RUN ;
+1 IF 'PSGPRVRP
DO HDR
+2 FOR
IF PR]""
DO PTOT
IF NP["^"
GOTO DONE
SET PR=$ORDER(^TMP("PSG",$JOB,PR))
IF PR=""
QUIT
IF PSGPRVRP
DO NP
WRITE !?1,PR
SET (PCNT,PCST)=0
FOR Q=0:0
SET DRG=$ORDER(^TMP("PSG",$JOB,PR,DRG))
IF DRG=""
QUIT
SET CST=^(DRG)
SET NF=$PIECE(CST,U,3)
DO DRGP
IF NP["^"
GOTO DONE
+3 ;
TOTLS ;
+1 SET PR=$SELECT(PSGPRVRP:1,1:$Y+8>IOSL)
IF PR
DO NP
IF NP'["^"
SET TCPU=$SELECT(TCNT:TCST/TCNT,1:0)
IF TCST<0&(TCPU>0)
SET TCPU=-TCPU
WRITE !!,LN2,!!?5,"TOTALS =>",?17,"AVG. COST/UNIT: ",$JUSTIFY(TCPU,0,2),?52,$JUSTIFY(TCNT,9,0),?67,$JUSTIFY(TCST,12,2)
+2 WRITE !!!?34,"*** DONE ***"
IF 'PR
IF NP'["^"
IF CML
FOR X=$Y:1:IOSL-4
WRITE !
+3 IF $TEST
WRITE !?54,"(** = NON-FORMULARY ITEM)"
+4 ;
DONE ;
+1 IF CML&($Y)
WRITE @IOF,@IOF
KILL %,CML,CNT,CPU,CST,LN1,LN2,NP,PCNT,PCPU,PCST,PSGID,PSGOD,PSGPDT,SN,TCNT,TCPU,TCST
QUIT
+2 ;
PTOT ;
+1 IF $Y+5>IOSL
DO NP
IF NP["^"
QUIT
WRITE !?1,PR," (cont.)"
+2 SET TCNT=TCNT+PCNT
SET TCST=TCST+PCST
SET PCPU=$SELECT(PCNT:PCST/PCNT,1:0)
IF PCST<0&(PCPU>0)
SET PCPU=-PCPU
WRITE ?52,"---------",?67,"------------",!?1,"----- AVG. COST/UNIT: ",$JUSTIFY(PCPU,0,2),?52,$JUSTIFY(PCNT,9,0),?67,$JUSTIFY(PCST,12,2)
IF 'PSGPRVRP
WRITE !!
QUIT
+3 ;
DRGP ;
+1 IF $Y+4>IOSL
DO NP
IF NP["^"
QUIT
WRITE !?1,PR," (cont.)"
+2 SET CNT=+CST
SET CST=$PIECE(CST,"^",2)
SET PCNT=PCNT+CNT
SET PCST=PCST+CST
+3 WRITE !?4,$SELECT('NF:" ",1:"**")," ",$SELECT(DRG'="zz":$PIECE(DRG,"^"),1:"*** DRUG NOT FOUND ***"),?52,$JUSTIFY(CNT,9,0),?67,$JUSTIFY(CST,12,2),!
+4 QUIT
+5 ;
NP ;
+1 IF PG
IF PR]""
IF 'CML
WRITE $CHAR(7)
READ !,"'^' TO STOP ",NP:DTIME
IF '$TEST
WRITE $CHAR(7)
IF '$TEST
SET NP="^"
IF NP["^"
QUIT
+2 IF PG
IF PR]""
IF CML
FOR X=$Y:1:IOSL-4
WRITE !
+3 IF $TEST
WRITE !?54,"(** = NON-FORMULARY ITEM)"
+4 ;
HDR ;
+1 SET PG=PG+1
IF $Y
WRITE @IOF
WRITE !!?1,PSGPDT,?24,"UNIT DOSE COST PER PROVIDER REPORT",?73-$LENGTH(PG),"Page: ",PG,!?28,"FROM ",STRT," TO ",STOP,!!?1,"PROVIDER",?52,"TOTAL UNITS",?72,"TOTAL",!?10,"DRUG",?53,"DISPENSED",?72,"COST",!,LN1,!
QUIT
