source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGDCR0.m@ 1361

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1PSGDCR0 ;BIR/CML3-PRINT COST AT DISCHARGE REPORT ;09 JUL 94 / 10:53 AM
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,PN)="",$P(LINE,"-",81)="",$P(LN2,"=",81)="",(TCNT,TCST)=0
6 ;
7RUN ;
8 U IO D HDR I '$D(^UTILITY($J)) W !!?18,"*** NO TOTAL COST PER PATIENT FOUND ***" G DONE
9 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
10 ;
11TOTLS ;
12 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)
13 I NP'["^",CML F X=$Y:1:IOSL-4 W !
14 I W !?54,"(** = NON-FORMULARY ITEM)"
15 ;
16DONE ;
17 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
18 ;
19PTOT ;
20 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
21 ;
22DW ;
23 I $Y+4>IOSL D NP Q:NP["^"
24 S CNT=+CST,CST=$P(CST,"^",2),PCNT=PCNT+CNT,PCST=PCST+CST
25 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
26 ;
27NP ;
28 I 'CML W $C(7),!,"`^' TO STOP " R NP:DTIME W:'$T $C(7) S:'$T NP="^" Q:NP["^"
29 I CML F X=$Y:1:IOSL-4 W !
30 I W !?54,"(** = NON-FORMULARY ITEM)"
31 ;
32HDR ;
33 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=""
34 ;
35PW ;
36 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)
37 W !!?2,$S($P(PN,"^")]"":$P(PN,"^"),1:$P(PN,"^",2))," ("_SSN_")",?45,AD,?64,PSGOD,!?79-$L(DIAG),DIAG,! Q
Note: See TracBrowser for help on using the repository browser.