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

PSAHIS1.m

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