| [613] | 1 | PSGTCTD ;BIR/CML3-SHOW TOTAL COST TO DATE OF PATIENTS ; 15 May 98 / 9:26 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**3**;16 DEC 97
|
|---|
| 3 | START ;
|
|---|
| 4 | D ENCV^PSGSETU I '$D(XQUIT) S PSGSSH="TCR",PSJACNWP=1,(PSGWG,PSGWD,PSGPAT)=0 D ^PSGSEL I "^"'[PSGSS D @PSGSS I +Y>0 D DEV I 'POP,'$D(IO("Q")) D ENQ,^%ZISC
|
|---|
| 5 | ;
|
|---|
| 6 | DONE ;
|
|---|
| 7 | D ENKV^PSGSETU K AMT,CNTR,COST,DRG,DRGN,LN2,ND,PSJJORD,PSGDICA,PSGP,PSGPAT,PSGPN,PSGSS,PSGSSH,PSGWD,PSGWDN,PSGWG,PSN,SD,ZTOUT Q
|
|---|
| 8 | ;
|
|---|
| 9 | ENQ ;
|
|---|
| 10 | D NOW^%DTC S PSGDT=%,DT=$P(%,".") K ^TMP("PSG",$J) D @("G"_PSGSS),^PSGTCTD0
|
|---|
| 11 | K ^TMP("PSG",$J) Q
|
|---|
| 12 | ;
|
|---|
| 13 | GG ;
|
|---|
| 14 | F PSGWD=0:0 S PSGWD=$O(^PS(57.5,"AC",PSGWG,PSGWD)) Q:'PSGWD D GW
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | GW ;
|
|---|
| 18 | I $D(^DIC(42,PSGWD,0)),$P(^(0),"^")]"" S PSGWDN=$P(^(0),"^") F PSGP=0:0 S PSGP=$O(^DPT("CN",PSGWDN,PSGP)) Q:'PSGP D PAT
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | GP ;
|
|---|
| 22 | F PSGP=0:0 S PSGP=$O(PSGPAT(PSGP)) Q:'PSGP D PAT
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | PAT ;
|
|---|
| 26 | S COST=0 D ^PSJAC S PSGPN=$S($P(PSGP(0),"^")]"":$P(PSGP(0),"^"),1:PSGP)_"^"_PSGP,PSN=$E($P(PSJPSSN,"^"),6,10)
|
|---|
| 27 | F SD=+PSJPAD:0 S SD=$O(^PS(55,PSGP,5,"AUS",SD)) Q:'SD F PSJJORD=0:0 S PSJJORD=$O(^PS(55,PSGP,5,"AUS",SD,PSJJORD)) Q:'PSJJORD D ADD
|
|---|
| 28 | S:$D(^TMP("PSG",$J,PSGPN)) ^(PSGPN)=$P(PSJPAD,"^",2)_"^"_PSN_"^"_PSJPDX Q
|
|---|
| 29 | ;
|
|---|
| 30 | ADD ;
|
|---|
| 31 | N X F X=0:0 S X=$O(^PS(55,PSGP,5,PSJJORD,1,X)) Q:'X D
|
|---|
| 32 | .; naked ref below refers to line above
|
|---|
| 33 | .S ND=^(X,0),DRG=+ND,DRGN=$G(^PSDRUG(DRG,0)),DRGN=$S($P(DRGN,"^")]"":$P(DRGN,"^"),1:DRG)_$S('$P(DRGN,"^",9):"",1:"^1"),DRG=+$P($G(^(660)),"^",6)
|
|---|
| 34 | .S AMT=$P(ND,"^",6)+$P(ND,"^",10)+$P(ND,"^",12)-$P(ND,"^",7) I DRG*AMT S ND=$G(^TMP("PSG",$J,PSGPN,DRGN)),^(DRGN)=+ND+AMT_"^"_(DRG*AMT+$P(ND,"^",2))
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | G ;
|
|---|
| 38 | S DIC="^PS(57.5,",DIC(0)="QEAMI",DIC("A")="Select WARD GROUP: " W ! D ^DIC K DIC S PSGWG=+Y Q
|
|---|
| 39 | W ;
|
|---|
| 40 | S DIC="^DIC(42,",DIC(0)="QEAMI",DIC("A")="Select WARD: " W ! D ^DIC K DIC S PSGWD=+Y Q
|
|---|
| 41 | P ;
|
|---|
| 42 | K PSGPAT S PSGPAT=0 F CNTR=1:1 S:CNTR>1 PSGDICA="another" D ENDPT^PSGP Q:PSGP'>0 S PSGPAT(PSGP)="",PSGPAT=PSGP
|
|---|
| 43 | S Y=PSGPAT Q
|
|---|
| 44 | ;
|
|---|
| 45 | DEV ;
|
|---|
| 46 | K ZTSAVE S PSGTIR="ENQ^PSGTCTD",ZTDESC="TOTAL COST REPORT" F X="PSGSS","PSGWG","PSGWD","PSGPAT(" S ZTSAVE(X)=""
|
|---|
| 47 | D ENDEV^PSGTI Q
|
|---|
