PSGWHC0 ;BHAM ISC/PTD,CML-High Cost for Selected Date Range (Single AOU or Cumulative) - CONTINUED ; 19 Mar 93 / 8:30 AM ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94 ENQ ;ENTRY POINT WHEN QUEUED K ^TMP("PSGWHC",$J) S INVN=0 F J=0:0 S INVN=$O(^PSI(58.19,INVN)) Q:'INVN S INVDT=$P($P(^PSI(58.19,INVN,0),"^"),".") I (INVDT'EDT) S ^TMP("PSGWHC",$J,"INV",INVN)="" 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 DRUG ;LOOP THROUGH DRUGS FOR AOU S DRGDA=0 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),"^") ; AR ;AUTO REPLENISH INVENTORIES S DRGQD=0,INVDA=0 INVLP S INVDA=$O(^PSI(58.1,AOU,1,DRGDA,1,INVDA)) G:'INVDA OD I $D(^TMP("PSGWHC",$J,"INV",INVDA)) S QD=$P(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5),DRGQD=DRGQD+QD G INVLP ; OD ;ON DEMAND REQUESTS S ODA=0 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),"^"),".") I (ODT'EDT) S QD=$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2),DRGQD=DRGQD+QD G ODLP ; RET ;RETURNS S RETDT=0 RETLP S RETDT=$O(^PSI(58.1,AOU,1,DRGDA,3,RETDT)) G:'RETDT CHKDTA I (RETDT'EDT) S QD=$P(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2),DRGQD=DRGQD-QD G RETLP ; CHKDTA ;DETERMINE TOTAL COST FOR SELECTED DRUG G:DRGQD=0 DRGLP S INC=0 I $D(^PSDRUG(DRGNM,660)) S LOC1=^(660) E S INC=1 I $D(^PSDRUG(DRGNM,"PSG")) S LOC2=^("PSG") E S INC=1 I $D(LOC1),($P(LOC1,"^",6)="") S INC=1 I $D(LOC2),($P(LOC2,"^",3)="") S INC=1 COST I INC=0 S DRGCST=DRGQD*($P(LOC1,"^",6)) E S DRGCST="NO DATA" SETGL S ^TMP("PSGWHC",$J,DRGNM,AOU)=DRGQD_"^"_DRGCST G DRGLP ; CONV S DRUG=0 DRUGLP S (AOUN,TOTQD,TOTCST)=0 S DRUG=$O(^TMP("PSGWHC",$J,DRUG)) G:('DRUG)&($D(ZTQUEUED)) PRTQUE G:'DRUG EN1^PSGWHC1 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 ; 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) S:(TOTCST="NO DATA")!(TOTCST'