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 ;**21**;4 JAN 94;Build 6
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'<BDT)&(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'<BDT)&(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'<BDT)&(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
; PSGW*2.3*21 - USE AR/WS AMIS CONVERSION NUMBER
S PSGWCNM=$S($P($G(LOC2),"^",3)="":1,1:$P(LOC2,"^",3))
;
COST I INC=0 S DRGCST=DRGQD*($P(LOC1,"^",6))*PSGWCNM
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'<CUT) ^TMP("PSGWHC",$J,"HI",UT1,UT2)=TOTCST_"^"_TOTQD G DRUGLP
;
PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
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)=""
D ^%ZTLOAD K ^TMP("PSGWHC",$J) G END^PSGWHC1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWHC0 2718 printed Dec 13, 2024@01:39:25 Page 2
PSGWHC0 ;BHAM ISC/PTD,CML-High Cost for Selected Date Range (Single AOU or Cumulative) - CONTINUED ; 19 Mar 93 / 8:30 AM
+1 ;;2.3;Automatic Replenishment/Ward Stock ;**21**;4 JAN 94;Build 6
ENQ ;ENTRY POINT WHEN QUEUED
+1 KILL ^TMP("PSGWHC",$JOB)
SET INVN=0
+2 FOR J=0:0
SET INVN=$ORDER(^PSI(58.19,INVN))
if 'INVN
QUIT
SET INVDT=$PIECE($PIECE(^PSI(58.19,INVN,0),"^"),".")
IF (INVDT'<BDT)&(INVDT'>EDT)
SET ^TMP("PSGWHC",$JOB,"INV",INVN)=""
AOU IF ALL=1
SET AOU=$ORDER(^PSI(58.1,AOU))
if 'AOU
GOTO CONV
IF $PIECE(^PSI(58.1,AOU,0),"^",3)=1
GOTO AOU
DRUG ;LOOP THROUGH DRUGS FOR AOU
+1 SET DRGDA=0
DRGLP SET DRGDA=$ORDER(^PSI(58.1,AOU,1,DRGDA))
if (ALL=0)&('DRGDA)
GOTO CONV
if (ALL=1)&('DRGDA)
GOTO AOU
SET DRGNM=$PIECE(^PSI(58.1,AOU,1,DRGDA,0),"^")
+1 ;
AR ;AUTO REPLENISH INVENTORIES
+1 SET DRGQD=0
SET INVDA=0
INVLP SET INVDA=$ORDER(^PSI(58.1,AOU,1,DRGDA,1,INVDA))
if 'INVDA
GOTO OD
+1 IF $DATA(^TMP("PSGWHC",$JOB,"INV",INVDA))
SET QD=$PIECE(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5)
SET DRGQD=DRGQD+QD
+2 GOTO INVLP
+3 ;
OD ;ON DEMAND REQUESTS
+1 SET ODA=0
ODLP SET ODA=$ORDER(^PSI(58.1,AOU,1,DRGDA,5,ODA))
if 'ODA
GOTO RET
SET ODT=$PIECE($PIECE(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^"),".")
+1 IF (ODT'<BDT)&(ODT'>EDT)
SET QD=$PIECE(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2)
SET DRGQD=DRGQD+QD
+2 GOTO ODLP
+3 ;
RET ;RETURNS
+1 SET RETDT=0
RETLP SET RETDT=$ORDER(^PSI(58.1,AOU,1,DRGDA,3,RETDT))
if 'RETDT
GOTO CHKDTA
+1 IF (RETDT'<BDT)&(RETDT'>EDT)
SET QD=$PIECE(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2)
SET DRGQD=DRGQD-QD
+2 GOTO RETLP
+3 ;
CHKDTA ;DETERMINE TOTAL COST FOR SELECTED DRUG
+1 if DRGQD=0
GOTO DRGLP
SET INC=0
IF $DATA(^PSDRUG(DRGNM,660))
SET LOC1=^(660)
+2 IF '$TEST
SET INC=1
+3 IF $DATA(^PSDRUG(DRGNM,"PSG"))
SET LOC2=^("PSG")
+4 IF '$TEST
SET INC=1
+5 IF $DATA(LOC1)
IF ($PIECE(LOC1,"^",6)="")
SET INC=1
+6 IF $DATA(LOC2)
IF ($PIECE(LOC2,"^",3)="")
SET INC=1
+7 ; PSGW*2.3*21 - USE AR/WS AMIS CONVERSION NUMBER
+8 SET PSGWCNM=$SELECT($PIECE($GET(LOC2),"^",3)="":1,1:$PIECE(LOC2,"^",3))
+9 ;
COST IF INC=0
SET DRGCST=DRGQD*($PIECE(LOC1,"^",6))*PSGWCNM
+1 IF '$TEST
SET DRGCST="NO DATA"
SETGL SET ^TMP("PSGWHC",$JOB,DRGNM,AOU)=DRGQD_"^"_DRGCST
GOTO DRGLP
+1 ;
CONV SET DRUG=0
DRUGLP SET (AOUN,TOTQD,TOTCST)=0
SET DRUG=$ORDER(^TMP("PSGWHC",$JOB,DRUG))
if ('DRUG)&($DATA(ZTQUEUED))
GOTO PRTQUE
if 'DRUG
GOTO EN1^PSGWHC1
AOULP SET AOUN=$ORDER(^TMP("PSGWHC",$JOB,DRUG,AOUN))
if 'AOUN
GOTO HIGH
SET LOCN=^TMP("PSGWHC",$JOB,DRUG,AOUN)
SET QUAN=$PIECE(LOCN,"^")
SET CST=$PIECE(LOCN,"^",2)
SET TOTQD=TOTQD+QUAN
SET TOTCST=$SELECT(CST'="NO DATA":TOTCST+CST,1:"NO DATA")
GOTO AOULP
+1 ;
HIGH SET DRN=$PIECE(^PSDRUG(DRUG,0),"^")
SET CF=$SELECT(TOTCST'="NO DATA":100000000-TOTCST,1:100000000)
SET UT1=$SELECT(SORT=1:CF,1:DRN)
SET UT2=$SELECT(SORT=1:DRN,1:CF)
+1 if (TOTCST="NO DATA")!(TOTCST'<CUT)
SET ^TMP("PSGWHC",$JOB,"HI",UT1,UT2)=TOTCST_"^"_TOTQD
GOTO DRUGLP
+2 ;
PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
+1 KILL ZTSAVE,ZTIO
SET ZTIO=PSGWIO
SET ZTRTN="^PSGWHC1"
SET ZTDESC="Print High Cost"
SET ZTDTH=$HOROLOG
SET ZTSAVE("^TMP(""PSGWHC"",$J,")=""
FOR G="BDT","EDT","AOU","ALL","CUT","SORT"
if $DATA(@G)
SET ZTSAVE(G)=""
+2 DO ^%ZTLOAD
KILL ^TMP("PSGWHC",$JOB)
GOTO END^PSGWHC1
+3 ;
