PSGWHV0 ;BHAM ISC/PTD,CML-High Volume for Selected Date Range (Single AOU or Cumulative) - CONTINUED ; 02/13/90 15:32
;;2.3;Automatic Replenishment/Ward Stock ;**21**;4 JAN 94;Build 6
ENQ ;ENTRY POINT WHEN QUEUED
K ^TMP("PSGWHV",$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("PSGWHV",$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("PSGWHV",$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("PSGWHV",$J,DRGNM,AOU)=DRGQD_"^"_DRGCST G DRGLP
;
CONV S DRUG=0
DRUGLP S (AOUN,TOTQD,TOTCST)=0 S DRUG=$O(^TMP("PSGWHV",$J,DRUG)) G:('DRUG)&($D(ZTQUEUED)) PRTQUE G:'DRUG EN1^PSGWHV1
AOULP S AOUN=$O(^TMP("PSGWHV",$J,DRUG,AOUN)) G:'AOUN HIGH S LOCN=^TMP("PSGWHV",$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=100000-TOTQD S:(TOTCST="NO DATA")!(TOTQD'<CUT) ^TMP("PSGWHV",$J,"VL",CF,DRN)=TOTQD_"^"_TOTCST G DRUGLP
;
PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
K ZTSAVE,ZTIO S ZTIO=PSGWIO,ZTRTN="^PSGWHV1",ZTDESC="Print High Volume",ZTDTH=$H,ZTSAVE("^TMP(""PSGWHV"",$J,")="" F G="BDT","EDT","AOU","ALL","CUT" S:$D(@G) ZTSAVE(G)=""
D ^%ZTLOAD K ^TMP("PSGWHV",$J) G END^PSGWHV1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWHV0 2620 printed Dec 13, 2024@01:39:28 Page 2
PSGWHV0 ;BHAM ISC/PTD,CML-High Volume for Selected Date Range (Single AOU or Cumulative) - CONTINUED ; 02/13/90 15:32
+1 ;;2.3;Automatic Replenishment/Ward Stock ;**21**;4 JAN 94;Build 6
ENQ ;ENTRY POINT WHEN QUEUED
+1 KILL ^TMP("PSGWHV",$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("PSGWHV",$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("PSGWHV",$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("PSGWHV",$JOB,DRGNM,AOU)=DRGQD_"^"_DRGCST
GOTO DRGLP
+1 ;
CONV SET DRUG=0
DRUGLP SET (AOUN,TOTQD,TOTCST)=0
SET DRUG=$ORDER(^TMP("PSGWHV",$JOB,DRUG))
if ('DRUG)&($DATA(ZTQUEUED))
GOTO PRTQUE
if 'DRUG
GOTO EN1^PSGWHV1
AOULP SET AOUN=$ORDER(^TMP("PSGWHV",$JOB,DRUG,AOUN))
if 'AOUN
GOTO HIGH
SET LOCN=^TMP("PSGWHV",$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=100000-TOTQD
if (TOTCST="NO DATA")!(TOTQD'<CUT)
SET ^TMP("PSGWHV",$JOB,"VL",CF,DRN)=TOTQD_"^"_TOTCST
GOTO DRUGLP
+1 ;
PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
+1 KILL ZTSAVE,ZTIO
SET ZTIO=PSGWIO
SET ZTRTN="^PSGWHV1"
SET ZTDESC="Print High Volume"
SET ZTDTH=$HOROLOG
SET ZTSAVE("^TMP(""PSGWHV"",$J,")=""
FOR G="BDT","EDT","AOU","ALL","CUT"
if $DATA(@G)
SET ZTSAVE(G)=""
+2 DO ^%ZTLOAD
KILL ^TMP("PSGWHV",$JOB)
GOTO END^PSGWHV1
+3 ;
