Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSGWHV0

PSGWHV0.m

Go to the documentation of this file.
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
 ;