source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGTCTD0.m@ 1258

Last change on this file since 1258 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1PSGTCTD0 ;BIR/CML3-PRINT TOTAL COST TO DATE REPORT ;31 OCT 95 / 2:10 PM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3 ;
4START ;
5 D NOW^%DTC S PSGDT=%,PSGPDT=$$ENDTC^PSGMI(PSGDT),CML=IO'=IO(0)!(IOST'["C-"),(LINE,LN2,NP)="",$P(LINE,"-",81)="",$P(LN2,"=",81)="",(TCNT,TCST)=0
6 ;
7 I 'PSGWG G:PSGWD W S HDR="(BY PATIENT)" G RUN
8 I $D(^PS(57.5,PSGWG,0)),$P(^(0),"^")]"" S HDR="(FOR WARD GROUP: "_$P(^(0),"^")_")" G RUN
9 S HDR="(BY WARD GROUP)" G RUN
10W I $D(^DIC(42,PSGWD,0)),$P(^(0),"^")]"" S HDR="(FOR WARD: "_$P(^(0),"^")_")"
11 E S HDR="(BY WARD)"
12 ;
13RUN ;
14 S HDRL=80-$L(HDR)\2,PN="" U IO D HDR I '$D(^TMP("PSG",$J)) W !!?18,"*** NO TOTAL COST PER PATIENT FOUND ***" G DONE
15 F D:PN]"" PTOT S PN=$O(^TMP("PSG",$J,PN)) Q:PN="" D PW G:NP["^" DONE S DRG="",(PCNT,PCST)=0 F S DRG=$O(^TMP("PSG",$J,PN,DRG)) Q:DRG="" S CST=^(DRG) D:$Y+4>IOSL NP G:NP["^" DONE D DW
16 ;
17TOTLS ;
18 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)
19 I NP'["^",CML F X=$Y:1:IOSL-4 W !
20 I W !?54,"(** = NON-FORMULARY ITEM)"
21 ;
22DONE ;
23 W:CML&($Y) @IOF,@IOF K AD,CML,CST,DIAG,HDR,HDRL,LINE,NP,P,PCNT,PCPU,PCST,PN,PSGPDT,TCNT,TCPU,TCST Q
24 ;
25PTOT ;
26 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
27 ;
28DW ;
29 S CNT=+CST,CST=$P(CST,"^",2),PCNT=PCNT+CNT,PCST=PCST+CST
30 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
31 ;
32NP ;
33 I 'CML W $C(7),!,"'^' TO STOP " R NP:DTIME W:'$T $C(7) S:'$T NP="^" Q:NP["^"
34 I CML F X=$Y:1:IOSL-4 W !
35 I W !?54,"(** = NON-FORMULARY ITEM)"
36 ;
37HDR ;
38 W:$Y @IOF W !!?27,"TOTAL COST TO DATE REPORT",?64,PSGPDT,!?HDRL,HDR,!!?7,"Patient",?45,"Admitting Date",!?60,"Admitting Diagnosis",!?10,"Drug",?53,"Dispensed",?72,"Cost",!,LINE Q:PN=""
39 ;
40PW ;
41 G:$Y+7>IOSL NP S PSN=^TMP("PSG",$J,PN),AD=$P(PSN,"^"),DIAG=$S($P(PSN,"^",3)]"":$P(PSN,"^",3),1:"DIAGNOSIS NOT FOUND"),PSN=$P(PSN,"^",2)
42 W !!?2,$P(PN,"^"),$S($P(PN,"^")'=$P(PN,"^",2):"",1:$P(PN,"^",2)_";DPT(")," (",PSN,")",?45,AD,!?79-$L(DIAG),DIAG,! Q
Note: See TracBrowser for help on using the repository browser.