PSGDCR0 ;BIR/CML3-PRINT COST AT DISCHARGE REPORT ;09 JUL 94 / 10:53 AM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
;
START ;
D NOW^%DTC S PSGDT=%,PSGPDT=$$ENDTC^PSGMI(PSGDT),CML=IO'=IO(0)!(IOST'["C-"),(LINE,LN2,NP,PN)="",$P(LINE,"-",81)="",$P(LN2,"=",81)="",(TCNT,TCST)=0
;
RUN ;
U IO D HDR I '$D(^UTILITY($J)) W !!?18,"*** NO TOTAL COST PER PATIENT FOUND ***" G DONE
F D:PN]"" PTOT S PN=$O(^UTILITY($J,PN)) Q:PN="" F CDD=0:0 S CDD=$O(^UTILITY($J,PN,CDD)) Q:'CDD D PW G:NP["^" DONE S DRG="",(PCNT,PCST)=0 F S DRG=$O(^UTILITY($J,PN,CDD,DRG)) Q:DRG="" S CST=^(DRG) G:NP["^" DONE D DW
;
TOTLS ;
D:$Y+5>IOSL 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)
I NP'["^",CML F X=$Y:1:IOSL-4 W !
I W !?54,"(** = NON-FORMULARY ITEM)"
;
DONE ;
W:CML&($Y) @IOF,@IOF D:CML ^%ZISC K %,%H,%I,AD,CML,CNT,CST,HDR,HDRL,LINE,LN2,NP,P,PCNT,PCPU,PCST,PSGPDT,PSGWD,PSGWG,TCNT,TCPU,TCST Q
;
PTOT ;
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),!! Q
;
DW ;
I $Y+4>IOSL D NP Q:NP["^"
S CNT=+CST,CST=$P(CST,"^",2),PCNT=PCNT+CNT,PCST=PCST+CST
W !?4,$S('$P(DRG,"^",2):" ",1:"**")," ",$P(DRG,"^"),$S($P(DRG,"^")'=+$P(DRG,"^"):"",1:" (DRUG NOT FOUND)"),?52,$J(CNT,9,0),?67,$J(CST,12,2),! Q
;
NP ;
I 'CML W $C(7),!,"`^' TO STOP " R NP:DTIME W:'$T $C(7) S:'$T NP="^" Q:NP["^"
I CML F X=$Y:1:IOSL-4 W !
I W !?54,"(** = NON-FORMULARY ITEM)"
;
HDR ;
W:$Y @IOF W !!?28,"COST AT DISCHARGE REPORT",?64,PSGPDT,!!?3,"Patient",?45,"Admitting Date",?64,"Discharge Date",!?60,"Admitting Diagnosis",!?10,"Drug",?53,"Dispensed",?72,"Cost",!,LINE Q:PN=""
;
PW ;
G:$Y+7>IOSL NP S SSN=^UTILITY($J,PN,CDD),DIAG=$P(SSN,"^",2),AD=$$ENDTC^PSGMI($P(SSN,"^",3)),SSN=$P(SSN,"^"),PSGOD=$$ENDTC^PSGMI(CDD)
W !!?2,$S($P(PN,"^")]"":$P(PN,"^"),1:$P(PN,"^",2))," ("_SSN_")",?45,AD,?64,PSGOD,!?79-$L(DIAG),DIAG,! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGDCR0 2102 printed Dec 13, 2024@02:01 Page 2
PSGDCR0 ;BIR/CML3-PRINT COST AT DISCHARGE REPORT ;09 JUL 94 / 10:53 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
+2 ;
START ;
+1 DO NOW^%DTC
SET PSGDT=%
SET PSGPDT=$$ENDTC^PSGMI(PSGDT)
SET CML=IO'=IO(0)!(IOST'["C-")
SET (LINE,LN2,NP,PN)=""
SET $PIECE(LINE,"-",81)=""
SET $PIECE(LN2,"=",81)=""
SET (TCNT,TCST)=0
+2 ;
RUN ;
+1 USE IO
DO HDR
IF '$DATA(^UTILITY($JOB))
WRITE !!?18,"*** NO TOTAL COST PER PATIENT FOUND ***"
GOTO DONE
+2 FOR
if PN]""
DO PTOT
SET PN=$ORDER(^UTILITY($JOB,PN))
if PN=""
QUIT
FOR CDD=0:0
SET CDD=$ORDER(^UTILITY($JOB,PN,CDD))
if 'CDD
QUIT
DO PW
if NP["^"
GOTO DONE
SET DRG=""
SET (PCNT,PCST)=0
FOR
SET DRG=$ORDER(^UTILITY($JOB,PN,CDD,DRG))
if DRG=""
QUIT
SET CST=^(DRG)
if NP["^"
GOTO DONE
DO DW
+3 ;
TOTLS ;
+1 if $Y+5>IOSL
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 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
if CML
DO ^%ZISC
KILL %,%H,%I,AD,CML,CNT,CST,HDR,HDRL,LINE,LN2,NP,P,PCNT,PCPU,PCST,PSGPDT,PSGWD,PSGWG,TCNT,TCPU,TCST
QUIT
+2 ;
PTOT ;
+1 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),!!
QUIT
+2 ;
DW ;
+1 IF $Y+4>IOSL
DO NP
if NP["^"
QUIT
+2 SET CNT=+CST
SET CST=$PIECE(CST,"^",2)
SET PCNT=PCNT+CNT
SET PCST=PCST+CST
+3 WRITE !?4,$SELECT('$PIECE(DRG,"^",2):" ",1:"**")," ",$PIECE(DRG,"^"),$SELECT($PIECE(DRG,"^")'=+$PIECE(DRG,"^"):"",1:" (DRUG NOT FOUND)"),?52,$JUSTIFY(CNT,9,0),?67,$JUSTIFY(CST,12,2),!
QUIT
+4 ;
NP ;
+1 IF 'CML
WRITE $CHAR(7),!,"`^' TO STOP "
READ NP:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET NP="^"
if NP["^"
QUIT
+2 IF CML
FOR X=$Y:1:IOSL-4
WRITE !
+3 IF $TEST
WRITE !?54,"(** = NON-FORMULARY ITEM)"
+4 ;
HDR ;
+1 if $Y
WRITE @IOF
WRITE !!?28,"COST AT DISCHARGE REPORT",?64,PSGPDT,!!?3,"Patient",?45,"Admitting Date",?64,"Discharge Date",!?60,"Admitting Diagnosis",!?10,"Drug",?53,"Dispensed",?72,"Cost",!,LINE
if PN=""
QUIT
+2 ;
PW ;
+1 if $Y+7>IOSL
GOTO NP
SET SSN=^UTILITY($JOB,PN,CDD)
SET DIAG=$PIECE(SSN,"^",2)
SET AD=$$ENDTC^PSGMI($PIECE(SSN,"^",3))
SET SSN=$PIECE(SSN,"^")
SET PSGOD=$$ENDTC^PSGMI(CDD)
+2 WRITE !!?2,$SELECT($PIECE(PN,"^")]"":$PIECE(PN,"^"),1:$PIECE(PN,"^",2))," ("_SSN_")",?45,AD,?64,PSGOD,!?79-$LENGTH(DIAG),DIAG,!
QUIT
