133 lines
9.4 KiB
Mathematica
133 lines
9.4 KiB
Mathematica
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
|