PSGSCT0.m

PSGSCT0 ;BIR/CML3-PRINT COST PER SERVICE REPORT ;14 JUL 94 / 9:36 AM

 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

START ;

 D NOW^%DTC S PSGDT=%,PSGPDT=$$ENDTC^PSGMI(PSGDT),CML=IO'=IO(0)!(IOST'["C-"),(NP,LN1,LN2)="",$P(LN1,"-",81)="",$P(LN2,"=",81)="",(TCNT,TCST)=0

 U IO D HDR I '$D(^UTILITY("PSG",$J)) W !!?23,"*** NO SERVICE COST DATA FOUND ***" G DONE

 ;

RUN ;

 S SN="" F  S SN=$O(^UTILITY("PSG",$J,"S",SN)) Q:SN=""  S CST=^(SN) D:$Y+3>IOSL NP G:NP["^" DONE D WRITE

 ;

 G:'$D(^UTILITY("PSG",$J,"W")) TOTLS D:$Y+3>IOSL NP G:NP["^" DONE W !?9,"*** A SERVICE COULD NOT BE FOUND FOR THE FOLLOWING WARD(S) ***",!

 S SN="" F  S SN=$O(^UTILITY("PSG",$J,"W",SN)) Q:SN=""  S CST=^(SN) D:$Y+3>IOSL NP G:NP["^" DONE D WRITE

 ;

TOTLS ;

 D:$Y+5>IOSL NP I NP'["^" S TCPU=$S(TCNT:TCST/TCNT,1:"****") S:TCST<0&(TCPU>0) TCPU=-TCPU W !!,LN2,!!?15,"TOTALS =>",?35,$J(TCNT,9,0),?52,$J(TCST,12,2),?72,$J(TCPU,6,2)

 ;

DONE ;

 W:CML&($Y) @IOF,@IOF K %,CML,CNT,CPU,CST,LN1,LN2,NP,PSGID,PSGOD,PSGPDT,SN,TCNT,TCPU,TCST Q

 ;

WRITE ;

 S CNT=+CST,CST=$P(CST,"^",2),TCNT=TCNT+CNT,TCST=TCST+CST,CPU=$S(CNT:CST/CNT,1:0) S:CST<0&(CPU>0) CPU=-CPU W !?2,SN,?35,$J(CNT,9,0),?52,$J(CST,12,2),?72,$J(CPU,6,2),! Q

 ;

NP ;

 I 'CML W $C(7) R !,"'^' TO STOP ",NP:DTIME W:'$T $C(7) S:'$T NP="^" Q:NP["^"

 ;

HDR ;

 W:$Y @IOF W !!?24,"UNIT DOSE COST PER SERVICE REPORT",?63,PSGPDT,!?25,"FROM ",STRT," THROUGH ",STOP,!!?35,"TOTAL UNITS",?56,"TOTAL",?68,"AVERAGE COST",!?10,"SERVICE",?36,"DISPENSED",?56,"COST",?70,"PER UNIT",!,LN1,! Q

PSGSCT0   ;BIR/CML3-PRINT COST PER SERVICE REPORT ;14 JUL 94 / 9:36 AM

 +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 (NP,LN1,LN2)=""

           SET $PIECE(LN1,"-",81)=""

           SET $PIECE(LN2,"=",81)=""

           SET (TCNT,TCST)=0

 +2        USE IO

           DO HDR

           IF '$DATA(^UTILITY("PSG",$JOB))

               WRITE !!?23,"*** NO SERVICE COST DATA FOUND ***"

               GOTO DONE

 +3       ;

RUN       ;

 +1        SET SN=""

           FOR 

               SET SN=$ORDER(^UTILITY("PSG",$JOB,"S",SN))

               IF SN=""

                   QUIT 

               SET CST=^(SN)

               IF $Y+3>IOSL

                   DO NP

               IF NP["^"

                   GOTO DONE

               DO WRITE

 +2       ;

 +3        IF '$DATA(^UTILITY("PSG",$JOB,"W"))

               GOTO TOTLS

           IF $Y+3>IOSL

               DO NP

           IF NP["^"

               GOTO DONE

           WRITE !?9,"*** A SERVICE COULD NOT BE FOUND FOR THE FOLLOWING WARD(S) ***",!

 +4        SET SN=""

           FOR 

               SET SN=$ORDER(^UTILITY("PSG",$JOB,"W",SN))

               IF SN=""

                   QUIT 

               SET CST=^(SN)

               IF $Y+3>IOSL

                   DO NP

               IF NP["^"

                   GOTO DONE

               DO WRITE

 +5       ;

TOTLS     ;

 +1        IF $Y+5>IOSL

               DO NP

           IF NP'["^"

               SET TCPU=$SELECT(TCNT:TCST/TCNT,1:"****")

               IF TCST<0&(TCPU>0)

                   SET TCPU=-TCPU

               WRITE !!,LN2,!!?15,"TOTALS =>",?35,$JUSTIFY(TCNT,9,0),?52,$JUSTIFY(TCST,12,2),?72,$JUSTIFY(TCPU,6,2)

 +2       ;

DONE      ;

 +1        IF CML&($Y)

               WRITE @IOF,@IOF

           KILL %,CML,CNT,CPU,CST,LN1,LN2,NP,PSGID,PSGOD,PSGPDT,SN,TCNT,TCPU,TCST

           QUIT 

 +2       ;

WRITE     ;

 +1        SET CNT=+CST

           SET CST=$PIECE(CST,"^",2)

           SET TCNT=TCNT+CNT

           SET TCST=TCST+CST

           SET CPU=$SELECT(CNT:CST/CNT,1:0)

           IF CST<0&(CPU>0)

               SET CPU=-CPU

           WRITE !?2,SN,?35,$JUSTIFY(CNT,9,0),?52,$JUSTIFY(CST,12,2),?72,$JUSTIFY(CPU,6,2),!

           QUIT 

 +2       ;

NP        ;

 +1        IF 'CML

               WRITE $CHAR(7)

               READ !,"'^' TO STOP ",NP:DTIME

               IF '$TEST

                   WRITE $CHAR(7)

               IF '$TEST

                   SET NP="^"

               IF NP["^"

                   QUIT 

 +2       ;

HDR       ;

 +1        IF $Y

               WRITE @IOF

           WRITE !!?24,"UNIT DOSE COST PER SERVICE REPORT",?63,PSGPDT,!?25,"FROM ",STRT," THROUGH ",STOP,!!?35,"TOTAL UNITS",?56,"TOTAL",?68,"AVERAGE COST",!?10,"SERVICE",?36,"DISPENSED",?56,"COST",?70,"PER UNIT",!,LN1,!

           QUIT