114 lines
6.8 KiB
Mathematica
114 lines
6.8 KiB
Mathematica
PSAHIS1 ;BIR/LTL,JMB-Drug Transaction History - CONT'D ;7/23/97
|
|
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3**; 10/24/97
|
|
;Prints the Show Drug Transaction History report in pharmacy location
|
|
;then date order. It is called by PSAHIS.
|
|
;
|
|
PRINT D HEADER S PSADRG="",PSACNT=0
|
|
F S PSADRG=$O(^TMP("PSAHIS",$J,PSADRG)) Q:PSADRG=""!(PSAOUT) D:$Y+6>IOSL HEADER Q:PSAOUT K PSABAL,PSATRCNT S PSADT=0 D Q:PSAOUT
|
|
.F S PSADT=+$O(^TMP("PSAHIS",$J,PSADRG,PSADT)) Q:'PSADT!(PSAOUT) D Q:PSAOUT
|
|
..S PSATR=0 F S PSATR=+$O(^TMP("PSAHIS",$J,PSADRG,PSADT,PSATR)) Q:'PSATR!(PSAOUT) D:$Y+6>IOSL HEADER Q:PSAOUT D TRANS
|
|
.Q:PSAOUT D:$Y+6>IOSL HEADER Q:PSAOUT D TOTALS
|
|
I 'PSACNT W !!,"No transactions were found for the pharmacy location."
|
|
Q:PSAOUT
|
|
;
|
|
DONE ;Holds screen or ejects paper if sent to printer
|
|
I $E(IOST,1,2)="C-" D
|
|
.S PSAS=21-$Y F PSASS=1:1:PSAS W !
|
|
.S DIR(0)="EA",DIR("A")="End of pharmacy location's display! Enter RETURN to continue or '^' to exit:" D ^DIR K DIR S:$G(DIRUT) PSAOUT=1
|
|
I $E(IOST)'="C" W !!!,"REPORT RUN: ",PSARUN W @IOF
|
|
Q
|
|
;
|
|
TRANS S PSATR0=$G(^PSD(58.81,PSATR,0)),PSACNT=1,PSATRCNT=$G(PSATRCNT)+1
|
|
;If it is first transaction for drug, print drug name & beg balance.
|
|
;Beg balance = 1st transaction + (receipts(+), adjs(+/-), &
|
|
;dispensing(-) made prior to beg date & fell within rpt date range)
|
|
I PSATRCNT=1 D
|
|
.W !,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" D WRAPDRUG
|
|
.S PSABAL=$P($G(^PSD(58.81,+^TMP("PSA",$J,PSADRG),0)),"^",10)+$G(PSABAD(PSADRG)) W ?72,$J(PSABAL,7)
|
|
;
|
|
;Print transaction date & +/- qty from balance
|
|
W !,$E(PSADT,4,5)_"-"_$E(PSADT,6,7)_"-"_$E(PSADT,2,3),?10,$E($P($G(^VA(200,+$P(PSATR0,"^",7),0)),"^"),1,28)
|
|
I $P(PSATR0,"^",2)'=24 S PSABAL=$S(119[$P(PSATR0,"^",2):PSABAL+$P(PSATR0,"^",6),1:PSABAL-$P(PSATR0,"^",6))
|
|
I $P(PSATR0,"^",2)=24 S PSABAL=PSABAL+$P(PSATR0,"^",6)
|
|
;Receipts
|
|
I $P(PSATR0,"^",2)=1 S PSAWRT=0 W ?37,"|",?41,$J($P(PSATR0,"^",6),6),?48,"|",?54,"|",?60,"|",?71,"|",?72,$J(PSABAL,7),! S PSARECT=$G(PSARECT)+$P(PSATR0,"^",6) D Q
|
|
.I $P($G(^PRC(442,+$P(PSATR0,"^",9),0)),"^") W ?11,"PO# ",$P($G(^(0)),"^"),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSALN=$G(PSALN)+1 S PSAWRT=1
|
|
.I $P($G(^PRCS(410,+$P(PSATR0,"^",8),0)),"^") W:PSAWRT ! W ?11,"TR# ",$P($G(^(0)),"^"),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSALN=$G(PSALN)+1,PSAWRT=1
|
|
.I $P($G(^PSD(58.81,PSATR,8)),"^",2)'="" W:PSAWRT ! W ?11,"ORD# ",$P($G(^(8)),"^",2),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSALN=$G(PSALN)+1,PSAWRT=1
|
|
.I $P($G(^PSD(58.81,PSATR,8)),"^")'="" W:PSAWRT ! W ?11,"INV# ",$P($G(^(8)),"^"),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSALN=$G(PSALN)+1,PSAWRT=1
|
|
.W:$G(PSAW) !?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" K PSAW
|
|
;Adjusted or transferred
|
|
I $P(PSATR0,"^",2)=9!($P(PSATR0,"^",2)=11)!($P(PSATR0,"^",2)=24) D Q
|
|
.W ?37,"|",?48,"|",?54,"|",?60,"|",?64,$J($P(PSATR0,"^",6),6),?71,"|",?72,$J(PSABAL,7)
|
|
.I +$P(PSATR0,"^",19) S PSADJDT=$P(PSATR0,"^",19) W !?11,"DATE ENTERED: "_$E(PSADJDT,4,5)_"-"_$E(PSADJDT,6,7)_"-"_$E(PSADJDT,2,3),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
|
|
.I $P(PSATR0,"^",2)=9!($P(PSATR0,"^",2)=11),$P(PSATR0,"^",16)'="" D REASON
|
|
.D:$P(PSATR0,"^",2)=24 TRANSFER S PSADJT=$G(PSADJT)+$P(PSATR0,"^",6)
|
|
;Dispensed by IP (2 means Unit Dose or Ward Stock 15 means IV)
|
|
I $P(PSATR0,"^",2)=2!($P(PSATR0,"^",2)=15) W ?10,"NIGHTLY BACKGROUND JOB",?37,"|",?48,"|",?49,$J($P(PSATR0,"^",6),5),?54,"|",?60,"|",?71,"|",?72,$J(PSABAL,7) S PSAIPT=$G(PSAIPT)+$P(PSATR0,"^",6) Q
|
|
;Dispensed by OP
|
|
I $P(PSATR0,"^",2)=6 W ?10,"NIGHTLY BACKGROUND JOB",?37,"|",?48,"|",?54,"|",?55,$J($P(PSATR0,"^",6),5),?60,"|",?71,"|",?72,$J(PSABAL,7) S PSAOPT=$G(PSAOPT)+$P(PSATR0,"^",6)
|
|
Q
|
|
;
|
|
HEADER ;Prints header info
|
|
S PSAPG=PSAPG+1 I PSAPG=1,$E(IOST,1,2)="C-" W @IOF
|
|
I $E(IOST,1,2)="C-",PSAPG>1 D Q:PSAOUT
|
|
.S PSAS=21-$Y F PSASS=1:1:PSAS W !
|
|
.S DIR(0)="E" D ^DIR K DIR W:'$G(DIRUT) @IOF S:$G(DIRUT) PSAOUT=1
|
|
I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),"^"),"." S PSAOUT=1 Q
|
|
I PSAPG>1,$E(IOST)'="C" W @IOF
|
|
W !?22,"D R U G A C C O U N T A B I L I T Y",?71,"Page ",$J(PSAPG,2)
|
|
W !?((42-$L(PSABDTR)-$L(PSARPDT))/2),"HISTORY OF DRUG TRANSACTIONS FROM ",PSABDTR," TO ",PSARPDT
|
|
W !?((80-$L(PSALOCN))/2),PSALOCN
|
|
W !!?37,"|",?48,"| DISPENSED |",?71,"|"
|
|
W !,"DATE",?10,"INITIATOR",?37,"| RECEIVED | IP | OP | ADJUSTED | BALANCE"
|
|
W !,PSADLN
|
|
I $G(PSADRG)'=""&($G(PSATRCNT)) D WRAPDRUG W ?72,$J(PSABAL,7)
|
|
Q
|
|
;
|
|
ALL ;Creates drug array with all drugs in location
|
|
S PSA50=0 F S PSA50=+$O(^PSD(58.8,PSALOC,1,PSA50)) Q:'PSA50 S:$P($G(^PSDRUG(PSA50,0)),"^")'="" ^TMP("PSADRG",$J,PSALOC,$P($G(^PSDRUG(PSA50,0)),"^"),PSA50)="",PSACNT=PSACNT+1
|
|
Q
|
|
;
|
|
WRAPDRUG ;Prints drug name w/o spliting words
|
|
I $L(PSADRG)<36 W !,"* ",PSADRG,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" Q
|
|
S PSAPC1="" F PSAPCS=1:1 S PSAPC=$P(PSADRG," ",PSAPCS) Q:PSAPC="" D
|
|
.I $L(PSAPC1)+$L(PSAPC)+1<36 S PSAPC1=PSAPC1_PSAPC_" " Q
|
|
.I $L(PSAPC1)+$L(PSAPC)+1>35 W !,"* "_PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSAPC1=PSAPC_" "
|
|
W:$L(PSAPC1) !?4,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
|
|
Q
|
|
;
|
|
REASON ;Prints transaction reason w/o spliting words
|
|
S PSAREA=$P(PSATR0,"^",16)
|
|
I $L(PSAREA)<27 W !?11,PSAREA,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" Q
|
|
S PSAPC1="" F PSAPCS=1:1 S PSAPC=$P(PSAREA," ",PSAPCS) Q:PSAPC="" D
|
|
.I $L(PSAPC1)+$L(PSAPC)+1<27 S PSAPC1=PSAPC1_PSAPC_" " Q
|
|
.I $L(PSAPC1)+$L(PSAPC)+1>26 W !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSAPC1=PSAPC_" "
|
|
W:$L(PSAPC1) !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
|
|
Q
|
|
;
|
|
TRANSFER ;Prints transfer pharm loc that rec'd or sent drugs
|
|
S PSATRANL=$P($G(^PSD(58.81,+$P(PSATR0,"^",17),0)),"^",3),PSAHOLD=PSALOC,PSAHOLDN=PSALOCN,PSALOC=PSATRANL
|
|
I PSALOC="" S PSAREA="TRANSFER DATA MISSING" S PSALOC=PSAHOLD,PSALOCN=PSAHOLDN Q
|
|
D SITES^PSAUTL1 S PSALOCN=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
|
|
S PSAREA="TRANSFER "_$S($P(PSATR0,"^",6)<0:"TO ",1:"FROM ") D TRAN
|
|
S PSALOC=PSAHOLD,PSALOCN=PSAHOLDN
|
|
S PSAPC1="" F PSAPCS=1:1 S PSAPC=$P(PSAREA," ",PSAPCS) Q:PSAPC="" D
|
|
.I $L(PSAPC1)+$L(PSAPC)+1<27 S PSAPC1=PSAPC1_PSAPC_" " Q
|
|
.I $L(PSAPC1)+$L(PSAPC)+1>26 W !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSAPC1=PSAPC_" "
|
|
W:$L(PSAPC1) !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
|
|
Q
|
|
;
|
|
TRAN ;Prints transferred location w/o spliting words
|
|
I $E(PSALOCN)="I" S PSAREA=PSAREA_"INPATIENT:"_$P($P(PSALOCN,":",2),"(IP)")
|
|
I $E(PSALOCN)="O" S PSAREA=PSAREA_"OUTPATIENT:"_$P($P(PSALOCN,":",2),"(OP)")
|
|
I $E(PSALOCN)="C" S PSAREA=PSAREA_"COMBINED:"_$P($P(PSALOCN,":",2),"(IP)")_"(IP)"_$P($P(PSALOCN,":",2),"(IP)",2)
|
|
W !?11,$P(PSAREA,":")_":",?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
|
|
S PSAREA=$P(PSAREA,": ",2)
|
|
Q
|
|
;
|
|
TOTALS ;Prints totals
|
|
W !?37,"|----------|-----|-----|----------|--------"
|
|
W !?25,"DRUG TOTALS",?37,"|",?41,$J($G(PSARECT),6),?48,"|",$J($G(PSAIPT),5),?54,"|",$J($G(PSAOPT),5),?60,"|",?64,$J($G(PSADJT),6),?71,"|",!,PSADLN
|
|
K PSADJT,PSAIPT,PSAOPT,PSARECT
|
|
Q
|