PSDPAT1 ;B'ham ISC/JPW,BJW - Prt activity report (Patient/Drug) ; 17 Apr 98
 ;;3.0; CONTROLLED SUBSTANCES ;**7,62**;13 Feb 97;Build 3
 ;modified for nois:det-0198-42285;displays drugs for destruction,returns,waste,transfers
START ;entry for compile and print
 K ^TMP("PSDPAT",$J) S (AQTY,CNT)=0
 I $D(ALL) F PSDR=0:0 S PSDR=$O(^PSD(58.8,+NAOU,1,PSDR)) Q:'PSDR  I $D(^PSD(58.8,+NAOU,1,+PSDR,0)) S PSDRG(+PSDR)=+$P(^(0),"^",4)
 F PSDR=0:0 S PSDR=$O(PSDRG(PSDR)) Q:'PSDR  F PSD=PSDSD:0 S PSD=$O(^PSD(58.81,"ACT",PSD)) Q:'PSD!(PSD>PSDED)   D
 .F TYP=0:0 S TYP=$O(^PSD(58.81,"ACT",PSD,+NAOU,PSDR,TYP)) Q:'TYP  F PSDA=0:0 S PSDA=$O(^PSD(58.81,"ACT",PSD,+NAOU,PSDR,TYP,PSDA)) Q:'PSDA  D SET
 ;; *62 RJS>
 F PSDR=0:0 S PSDR=$O(PSDRG(PSDR)) Q:'PSDR  F PSDA=0:0 S PSDA=$O(^PSD(58.8,+NAOU,1,PSDR,3,PSDA)) Q:'PSDA  D
 .Q:'$D(^PSD(58.8,NAOU,1,PSDR,3,PSDA,0))  S NODE=^(0),PSD=$P(NODE,"^",15)
 .I (PSD>PSDSD),(PSD<PSDED) D
 ..S NUR1=+$P(NODE,"^",7),NUR2="",QTY=+$P(NODE,"^",20),PAT="PHARMACY DISP #"_$P(NODE,U,16),PSDRN=$S($P($G(^PSDRUG(+PSDR,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSDR_" NAME MISSING") S PSDTR=+$P($G(NODE),"^",17)
 ..I (TYP=18)!(TYP=17) S $P(PSDRG(+PSDR),"^",2)=+$P(PSDRG(+PSDR),"^",2)+QTY
 ..S NUR1=$S($P($G(^VA(200,NUR1,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
 ..S (WQTY,WREAS,RQTY,RREAS,DRUGNO,SOQTY,DQTY,DREAS,PSDRET,DDATE)=""
 ..S NODE9="",$P(NODE,U,16)="",TYP=0
 ..S $P(NODE,U,10)=$P(NODE,U,22) D SET1
 ;; *62 RJS>
 F PSD=PSDSD:0 S PSD=$O(^PSD(58.81,"ATRN",PSD)) Q:'PSD!(PSD>PSDED)  D
 .F PSDA=0:0 S PSDA=$O(^PSD(58.81,"ATRN",PSD,PSDA)) Q:'PSDA  D
 ..S NODE=^PSD(58.81,PSDA,0) Q:$P(NODE,U,18)'=NAOU!('$D(PSDRG($P(NODE,U,5))))  D SET2
 ;; <*62 RJS
 F  S PSDR=$O(PSDRG(PSDR)) Q:'PSDR  I $G(PSDRG(PSDR))  S PSDRN=$S($P($G(^PSDRUG(+PSDR,0)),U)]"":$P(^(0),U),1:"ZZ/"_PSDR_" NAME MISSING") D:'$D(^TMP("PSDPAT",$J,PSDRN))
 .S ^TMP("PSDPAT",$J,PSDRN,DT,"NO ACTIVITY",1)=0
 .S ^TMP("PSDPATL",$J,PSDRN)=U_PSDRG(PSDR)
PRINT ;prints data
 I SUM="S" D ^PSDPAT2 G DONE
 S (PG,PSDOUT,AQTY)=0,PSDRN="",$P(LN,"-",132)="" D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S RPDT=Y
 I '$D(^TMP("PSDPAT",$J)) D HDR W !!,?15,"**** NO DISPENSING ACTIVITY ****",!! G DONE
 D HDR S PSDRG="" F  S PSDRG=$O(^TMP("PSDPAT",$J,PSDRG)) Q:PSDRG=""!(PSDOUT)  W !,?5,"=> ",PSDRG,! D CHK F PSD=0:0 S PSD=$O(^TMP("PSDPAT",$J,PSDRG,PSD)) D:'PSD TOT Q:PSD=""!(PSDOUT)  D  Q:PSDOUT
 .S PAT="" F  S PAT=$O(^TMP("PSDPAT",$J,PSDRG,PSD,PAT)) Q:PAT=""!(PSDOUT)  F PSD1=0:0 S PSD1=$O(^TMP("PSDPAT",$J,PSDRG,PSD,PAT,PSD1)) Q:'PSD1!(PSDOUT)  D  Q:PSDOUT
 ..S (QTY,SOQTY,RQTY,WQTY,DQTY,NEWBAL,ORDST)=0,(RREAS,WREAS,DREAS)=""
 ..S NODE=^TMP("PSDPAT",$J,PSDRG,PSD,PAT,PSD1),PSDRGN=PSDRG
 ..Q:$P(NODE,U,4)=3
 ..W !
 ..I $Y+8>IOSL D HDR Q:PSDOUT  W !,?5,"=> ",PSDRG,!
 ..S Y=+$E(PSD,1,12) X ^DD("DD") S DATE=Y
 ..S TYP=+$P(NODE,"^",4),PSDR=$P(NODE,"^",11),ORDST=+$P(NODE,"^",24)
 ..S QTY=+$P(NODE,"^")
 ..I (TYP)=9 S PQTY=+$P(NODE,U,7)+QTY,NEWBAL=PQTY W DATE,?22,PAT,?55,$J(QTY,6),?75,$J(PQTY,6),?98,$P(NODE,U,2),!,?98,$P(NODE,U,3),!,?25,$P(NODE,U,6),!
 ..I TYP=11 S PQTY=+$P(NODE,U,7)+QTY,NEWBAL=PQTY W DATE,?22,PAT,?55,$J(QTY,6),?75,$J(PQTY,6),?98,$P(NODE,U,2),!,?98,$P(NODE,U,3),!
 ..I TYP=17 S SOQTY=+$P(NODE,"^",12),NEWBAL=+$P(NODE,"^",7)-SOQTY D
 ...W DATE,?22,PAT,?54 W:TYP=17 "-" W $J(SOQTY,6)
 ...W ?75,$J(NEWBAL,6),?98,$P(NODE,"^",2),!,?98,$P(NODE,"^",3),!
 ..I (TYP=17),(+$P(NODE,"^",9)) S RQTY=+$P(NODE,"^",9) D
 ...S RREAS=$P(NODE,"^",10),NEWBAL=+NEWBAL+RQTY,PSDRET=$P(NODE,"^",15),Y=PSDRET X ^DD("DD") S PSDRET=$E(Y,1,17)
 ...S:$G(PSDRET)=0 PSDRET="" W PSDRET,?22,PAT,?45,"*RETURN*",?55,$J(RQTY,6),?75,$J(NEWBAL,6),?98,$P(NODE,"^",2),!,?25,RREAS,?98,$P(NODE,"^",3),!
 ..I +$P(NODE,U,5) S WQTY=+$P(NODE,U,5),WREAS=$P(NODE,"^",6),QTY=QTY-WQTY D
 ...W DATE,?22,PAT,?45,"*WASTED*",?55,$J(WQTY,6)
 ...W ?98,$P(NODE,"^",2),!,?25,WREAS,?98,$P(NODE,"^",3),!
 ..I +$P(NODE,U,13) S DQTY=+$P(NODE,U,13),DREAS=$P(NODE,U,14),DDATE=+$P(NODE,U,16) D
 ...W DATE,?22,PAT,?45,"*DESTROY*",?55,$J(DQTY,6),?98,$P(NODE,"^",2),!,?25,DREAS,?98,$P(NODE,"^",3),!
 ..W:TYP=17 DATE,?22,PAT,?45,"*GIVEN*",?55,$J(QTY,6),!
 ..I TYP=23 S PQTY=+$P(NODE,U,7)+QTY,NEWBAL=PQTY W DATE,?22,PAT,?55,$J(QTY,6),?75,$J(PQTY,6),?98,$P(NODE,U,2),!,?98,$P(NODE,U,3),!
 ..I TYP=0,'$G(ORDST) S PQTY=+$P(NODE,U,7)+QTY,NEWBAL=PQTY W DATE,?22,PAT,?55,$J(QTY,6),?75,$J(PQTY,6),?98,$P(NODE,U,2),!,?98,$P(NODE,U,3),!
 ..I TYP=0,$G(ORDST)=10 D  ; *62 RJS .
 ...S PQTY=+$P(NODE,"^")+$P(NODE,"^",7)+$P(NODE,"^",23),NEWBAL=PQTY
 ...W:$P(NODE,"^")'="" DATE,?22,PAT,?55,$J(QTY,6),?75,$J(PQTY,6),?98,$P(NODE,U,2),!,?98,$P(NODE,U,3),!  ; < *62 RJS
 ... S TFDTE=$P(NODE,"^",17),Y=TFDTE X ^DD("DD") S TFDTE=$E(Y,1,17),TFNUR=$P(NODE,"^",18),T2NAOU=$P(NODE,"^",19),TTDTE=$P(NODE,"^",20)
 ...S TTNUR=$P(NODE,"^",21),TRQTY=+$P(NODE,"^",23),NEWBAL=+NEWBAL-TRQTY
 ...W TFDTE,?22,PAT,?45,"*TRFER*",?54 W:TYP=0 "-" W $J(TRQTY,6),?75,$J(NEWBAL,6)
 ...W ?98,$P(NODE,"^",18),!,?32,"*TRANSFER TO "_$P(NODE,"^",19),"*",?98,$P(NODE,"^",21)
 ;..W:$P(NODE,U,8) " recorded by ",$P($G(^VA(200,$P(NODE,U,8),0)),U)
DONE I $E(IOST)'="C" W @IOF
 I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT!  Press <RET> to return to the menu" D ^DIR K DIR
END ;
 D KVAR^VADPT K VA
 K %,%DT,%H,%I,%ZIS,ALL,AQTY,BAL,CNT,DA,DATE,DDATE,DFN,DIC,DIR,DIROUT,DIRUT,DQTY,DTOUT,DREAS,DRUGNO,DUOUT,LN,LOOP,NAOU,NAOUN,NEWBAL,NODE,NODE3,NODE7,NODE9,NUR1,NUR2,ORDST
 K PAT,PG,POP,PSD,PSD1,PSDA,PSDATE,PSDED,PSDOUT,PSDPN,PQTY,PSDR,PSDRET,PSDRG,PSDRGN,PSDRN,PSDSD,RQTY,RREAS,RPDT,SOQTY
 K T2NAOU,TFDTE,TFNUR,TPRVTR,TRQTY,TTDTE,TTNUR,TTONAOU,TQTY,TYP,QTY,SUM,UQTY,VADM,VAERR,WQTY,WREAS,X,Y
 K ^TMP("PSDPAT",$J),^TMP("PSDPATL",$J),ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
 Q
SET ;sets data
 ;Q:TYP=11
 Q:'$D(^PSD(58.81,PSDA,0))  S NODE=^(0),QTY=+$P(NODE,"^",6)
 S NODE9=$G(^PSD(58.81,PSDA,9)) S SOQTY=+$P(NODE9,"^",3),WQTY=+$P(NODE9,"^",4)
 I +$P(NODE,"^",5) S DRUGNO=+$P(NODE,"^",5)
 I TYP=17 S $P(PSDRG(+PSDR),"^",2)=+$P(PSDRG(+PSDR),"^",2)+SOQTY
 S NODE3=$G(^PSD(58.81,PSDA,3)) S PSDRET=+$P(NODE3,"^"),RQTY=+$P(NODE3,"^",2),RREAS=$P(NODE3,"^",3),DQTY=+$P(NODE3,"^",5),DREAS=$P(NODE3,"^",6),DDATE=+$P(NODE3,"^",4)
 S DFN=+$P($G(NODE9),"^") D DEM^VADPT S PAT=$S(TYP=18:"WASTED AMOUNT",TYP=11:"INITIALIZE BALANCE",TYP=9:"BALANCE ADJUSTMENT",TYP=23:"COUNT VERIFICATION",'VAERR:VADM(1),1:"UNKNOWN")
 S NUR1=$S($P(NODE9,U,2):$P(NODE9,U,2),1:$P(NODE,U,7))
 S:NUR1'=$P(NODE,U,7) NUR1(1)=$P(NODE,U,7)
 ;S NUR1=$S(TYP=11:+$P(NODE,"^",7),1:+$P($G(NODE9),"^",2)) S:TYP=9 NUR1=$S(+$P(NODE,"^",7):+$P(NODE,"^",7),1:+$P($G(NODE9),"^",2))
 S NUR1=$S($P($G(^VA(200,+NUR1,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
 S NUR2=$P($G(NODE9),"^",6) S:NUR2 NUR2=$S($P($G(^VA(200,+NUR2,0)),"^")]"":$P(^(0),"^"),1:"")
 S PSDRN=$S($P($G(^PSDRUG(+PSDR,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSDR_" NAME MISSING")
 ;I +$P(NODE9,"^",4) S QTY=+$P(NODE9,"^",4)
 ;I +$P(NODE9,"^",7) S QTY=+$P(NODE9,"^",7)-$P(NODE9,"^",3)
 ;I +$P(NODE9,"^",5) S QTY=+$P(NODE9,"^",5)
 ;12/9/97 added next line;added to tmp-file
SET1 ;sets ^tmp
 I TYP=0 D CHKNOD7
 S CNT=CNT+1,^TMP("PSDPAT",$J,PSDRN,PSD,PAT,CNT)=QTY_"^"_NUR1_"^"_NUR2_"^"_TYP_"^"_WQTY_"^"_$P(NODE,U,16)_U_$P(NODE,U,10)_"^"_$G(NUR1(1))_"^"_RQTY_"^"_RREAS_"^"_DRUGNO_"^"_SOQTY_"^"_DQTY_"^"_DREAS_"^"_PSDRET_"^"_DDATE
 I $G(TRQTY) S ^TMP("PSDPAT",$J,PSDRN,PSD,PAT,CNT)=^TMP("PSDPAT",$J,PSDRN,PSD,PAT,CNT)_"^"_TFDTE_"^"_TFNUR_"^"_T2NAOU_"^"_TTDTE_"^"_TTNUR_"^"_TPRVTR_"^"_TRQTY_"^"_ORDST
 S:'$D(^TMP("PSDPATL",$J,PSDRN)) ^TMP("PSDPATL",$J,PSDRN)=0
 S ^TMP("PSDPATL",$J,PSDRN)=+^TMP("PSDPATL",$J,PSDRN)+($S(TYP=18:-QTY,TYP=17:-SOQTY,1:QTY)),$P(^(PSDRN),"^",2)=+PSDRG(PSDR)
 S $P(^TMP("PSDPATL",$J,PSDRN),"^",3)=+$P(^TMP("PSDPATL",$J,PSDRN),"^",3)+$P(PSDRG(+PSDR),"^",2)
 K QTY,NUR1,NUR2,NODE,NODE3,NODE7,PSDTR Q
SET2 ;SETS TRANSFER DATA ONLY  ;; *62 RJS >
 N PSDTRDT,PAT
 S PSDR=$P(NODE,U,5),PSDRN=$S($P($G(^PSDRUG(+PSDR,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSDR_" NAME MISSING")
 S PSDTRDT=$P(^PSD(58.81,PSDA,1),U,4)
 Q:$D(^TMP("PSDPAT",$J,PSDRN,PSDTRDT))
 S PSDTR=PSDA D CHKNOD7
 I $G(TRQTY) S CNT=CNT+1,PAT="PHARMACY DISP #"_$P(NODE,U,17),^TMP("PSDPAT",$J,PSDRN,PSD,PAT,CNT)="^^^0^^^^^^^^^^^^^"_TFDTE_"^"_TFNUR_"^"_T2NAOU_"^"_TTDTE_"^"_TTNUR_"^"_TPRVTR_"^"_TRQTY_"^"_ORDST
 S:'$D(^TMP("PSDPATL",$J,PSDRN)) ^TMP("PSDPATL",$J,PSDRN)=0
 S $P(^TMP("PSDPATL",$J,PSDRN),"^",3)=+$P(^TMP("PSDPATL",$J,PSDRN),"^",3)+$P(PSDRG(+PSDR),"^",2)
 K QTY,NUR1,NUR2,NODE,NODE3,NODE7,PSDTR
 Q  ; < *62 RJS
CHKNOD7 ;
 S NODE7=$G(^PSD(58.81,+PSDTR,7))
 S ORDST=$P($G(^PSD(58.81,+PSDTR,0)),"^",11)
 S TFDTE=+$P(NODE7,"^"),TTONAOU=+$P(NODE7,U,3),T2NAOU=$P($G(^PSD(58.8,TTONAOU,0)),U),TTDTE=+$P(NODE7,U,4),TPRVTR=+$P(NODE7,U,6),TRQTY=+$P(NODE7,U,7)
 S TFNUR=$S($P(NODE7,U,2):$P(NODE7,U,2),1:$P(NODE,U,7))
 S:TFNUR'=$P(NODE,U,7) TFNUR(1)=$P(NODE,U,7) S TFNUR=$S($P($G(^VA(200,+TFNUR,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
 S TTNUR=$P($G(NODE7),"^",5) S:TTNUR TTNUR=$S($P($G(^VA(200,+TTNUR,0)),"^")]"":$P(^(0),"^"),1:"")
 Q
HDR ;header
 I $E(IOST,1,2)="C-",PG K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
 S PG=PG+1 W:$Y @IOF W !,?20,"Activity Report for ",NAOUN,?55,RPDT,?115,"Page: ",PG,!,?20,"Date: ",$P(PSDATE,"^")," to ",$P(PSDATE,"^",2),!!
 W ?5,"=>  DRUG",!,"DATE/TIME",?22,"PATIENT",?55,"QUANTITY",?75,"BALANCE",?98,"NURSE 1",!,?98,"NURSE2",!,LN,!!
 Q
CHK ;sets total qty used and balance
 S TQTY=+$G(^TMP("PSDPATL",$J,PSDRG)),BAL=+$P($G(^TMP("PSDPATL",$J,PSDRG)),"^",2),UQTY=BAL-TQTY
 Q
TOT ;prints total qty used and balance
 I $Y+4>IOSL D HDR Q:PSDOUT  W !,?5,"=> ",$S(PSDRG]"":PSDRG,1:PSDRGN),!
 ;W !,?55,"----------",?75,"----------",!,?5,"Total Quantity Used and Balance",?55,$J(AQTY,6),?70,$J(PQTY,6),!
 W ! S AQTY=0
 Q