| 1 | PSGWHC0 ;BHAM ISC/PTD,CML-High Cost for Selected Date Range (Single AOU or Cumulative) - CONTINUED ; 19 Mar 93 / 8:30 AM
|
|---|
| 2 | ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
|---|
| 3 | ENQ ;ENTRY POINT WHEN QUEUED
|
|---|
| 4 | K ^TMP("PSGWHC",$J) S INVN=0
|
|---|
| 5 | F J=0:0 S INVN=$O(^PSI(58.19,INVN)) Q:'INVN S INVDT=$P($P(^PSI(58.19,INVN,0),"^"),".") I (INVDT'<BDT)&(INVDT'>EDT) S ^TMP("PSGWHC",$J,"INV",INVN)=""
|
|---|
| 6 | AOU I ALL=1 S AOU=$O(^PSI(58.1,AOU)) G:'AOU CONV I $P(^PSI(58.1,AOU,0),"^",3)=1 G AOU
|
|---|
| 7 | DRUG ;LOOP THROUGH DRUGS FOR AOU
|
|---|
| 8 | S DRGDA=0
|
|---|
| 9 | DRGLP S DRGDA=$O(^PSI(58.1,AOU,1,DRGDA)) G:(ALL=0)&('DRGDA) CONV G:(ALL=1)&('DRGDA) AOU S DRGNM=$P(^PSI(58.1,AOU,1,DRGDA,0),"^")
|
|---|
| 10 | ;
|
|---|
| 11 | AR ;AUTO REPLENISH INVENTORIES
|
|---|
| 12 | S DRGQD=0,INVDA=0
|
|---|
| 13 | INVLP S INVDA=$O(^PSI(58.1,AOU,1,DRGDA,1,INVDA)) G:'INVDA OD
|
|---|
| 14 | I $D(^TMP("PSGWHC",$J,"INV",INVDA)) S QD=$P(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5),DRGQD=DRGQD+QD
|
|---|
| 15 | G INVLP
|
|---|
| 16 | ;
|
|---|
| 17 | OD ;ON DEMAND REQUESTS
|
|---|
| 18 | S ODA=0
|
|---|
| 19 | ODLP S ODA=$O(^PSI(58.1,AOU,1,DRGDA,5,ODA)) G:'ODA RET S ODT=$P($P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^"),".")
|
|---|
| 20 | I (ODT'<BDT)&(ODT'>EDT) S QD=$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2),DRGQD=DRGQD+QD
|
|---|
| 21 | G ODLP
|
|---|
| 22 | ;
|
|---|
| 23 | RET ;RETURNS
|
|---|
| 24 | S RETDT=0
|
|---|
| 25 | RETLP S RETDT=$O(^PSI(58.1,AOU,1,DRGDA,3,RETDT)) G:'RETDT CHKDTA
|
|---|
| 26 | I (RETDT'<BDT)&(RETDT'>EDT) S QD=$P(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2),DRGQD=DRGQD-QD
|
|---|
| 27 | G RETLP
|
|---|
| 28 | ;
|
|---|
| 29 | CHKDTA ;DETERMINE TOTAL COST FOR SELECTED DRUG
|
|---|
| 30 | G:DRGQD=0 DRGLP S INC=0 I $D(^PSDRUG(DRGNM,660)) S LOC1=^(660)
|
|---|
| 31 | E S INC=1
|
|---|
| 32 | I $D(^PSDRUG(DRGNM,"PSG")) S LOC2=^("PSG")
|
|---|
| 33 | E S INC=1
|
|---|
| 34 | I $D(LOC1),($P(LOC1,"^",6)="") S INC=1
|
|---|
| 35 | I $D(LOC2),($P(LOC2,"^",3)="") S INC=1
|
|---|
| 36 | COST I INC=0 S DRGCST=DRGQD*($P(LOC1,"^",6))
|
|---|
| 37 | E S DRGCST="NO DATA"
|
|---|
| 38 | SETGL S ^TMP("PSGWHC",$J,DRGNM,AOU)=DRGQD_"^"_DRGCST G DRGLP
|
|---|
| 39 | ;
|
|---|
| 40 | CONV S DRUG=0
|
|---|
| 41 | DRUGLP S (AOUN,TOTQD,TOTCST)=0 S DRUG=$O(^TMP("PSGWHC",$J,DRUG)) G:('DRUG)&($D(ZTQUEUED)) PRTQUE G:'DRUG EN1^PSGWHC1
|
|---|
| 42 | AOULP S AOUN=$O(^TMP("PSGWHC",$J,DRUG,AOUN)) G:'AOUN HIGH S LOCN=^TMP("PSGWHC",$J,DRUG,AOUN),QUAN=$P(LOCN,"^"),CST=$P(LOCN,"^",2),TOTQD=TOTQD+QUAN,TOTCST=$S(CST'="NO DATA":TOTCST+CST,1:"NO DATA") G AOULP
|
|---|
| 43 | ;
|
|---|
| 44 | HIGH S DRN=$P(^PSDRUG(DRUG,0),"^"),CF=$S(TOTCST'="NO DATA":100000000-TOTCST,1:100000000),UT1=$S(SORT=1:CF,1:DRN),UT2=$S(SORT=1:DRN,1:CF)
|
|---|
| 45 | S:(TOTCST="NO DATA")!(TOTCST'<CUT) ^TMP("PSGWHC",$J,"HI",UT1,UT2)=TOTCST_"^"_TOTQD G DRUGLP
|
|---|
| 46 | ;
|
|---|
| 47 | PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
|
|---|
| 48 | K ZTSAVE,ZTIO S ZTIO=PSGWIO,ZTRTN="^PSGWHC1",ZTDESC="Print High Cost",ZTDTH=$H,ZTSAVE("^TMP(""PSGWHC"",$J,")="" F G="BDT","EDT","AOU","ALL","CUT","SORT" S:$D(@G) ZTSAVE(G)=""
|
|---|
| 49 | D ^%ZTLOAD K ^TMP("PSGWHC",$J) G END^PSGWHC1
|
|---|
| 50 | ;
|
|---|
