- 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
