source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAHIS1.m@ 931

Last change on this file since 931 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1PSAHIS1 ;BIR/LTL,JMB-Drug Transaction History - CONT'D ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3**; 10/24/97
3 ;Prints the Show Drug Transaction History report in pharmacy location
4 ;then date order. It is called by PSAHIS.
5 ;
6PRINT D HEADER S PSADRG="",PSACNT=0
7 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
8 .F S PSADT=+$O(^TMP("PSAHIS",$J,PSADRG,PSADT)) Q:'PSADT!(PSAOUT) D Q:PSAOUT
9 ..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
10 .Q:PSAOUT D:$Y+6>IOSL HEADER Q:PSAOUT D TOTALS
11 I 'PSACNT W !!,"No transactions were found for the pharmacy location."
12 Q:PSAOUT
13 ;
14DONE ;Holds screen or ejects paper if sent to printer
15 I $E(IOST,1,2)="C-" D
16 .S PSAS=21-$Y F PSASS=1:1:PSAS W !
17 .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
18 I $E(IOST)'="C" W !!!,"REPORT RUN: ",PSARUN W @IOF
19 Q
20 ;
21TRANS S PSATR0=$G(^PSD(58.81,PSATR,0)),PSACNT=1,PSATRCNT=$G(PSATRCNT)+1
22 ;If it is first transaction for drug, print drug name & beg balance.
23 ;Beg balance = 1st transaction + (receipts(+), adjs(+/-), &
24 ;dispensing(-) made prior to beg date & fell within rpt date range)
25 I PSATRCNT=1 D
26 .W !,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" D WRAPDRUG
27 .S PSABAL=$P($G(^PSD(58.81,+^TMP("PSA",$J,PSADRG),0)),"^",10)+$G(PSABAD(PSADRG)) W ?72,$J(PSABAL,7)
28 ;
29 ;Print transaction date & +/- qty from balance
30 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)
31 I $P(PSATR0,"^",2)'=24 S PSABAL=$S(119[$P(PSATR0,"^",2):PSABAL+$P(PSATR0,"^",6),1:PSABAL-$P(PSATR0,"^",6))
32 I $P(PSATR0,"^",2)=24 S PSABAL=PSABAL+$P(PSATR0,"^",6)
33 ;Receipts
34 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
35 .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
36 .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
37 .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
38 .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
39 .W:$G(PSAW) !?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" K PSAW
40 ;Adjusted or transferred
41 I $P(PSATR0,"^",2)=9!($P(PSATR0,"^",2)=11)!($P(PSATR0,"^",2)=24) D Q
42 .W ?37,"|",?48,"|",?54,"|",?60,"|",?64,$J($P(PSATR0,"^",6),6),?71,"|",?72,$J(PSABAL,7)
43 .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,"|"
44 .I $P(PSATR0,"^",2)=9!($P(PSATR0,"^",2)=11),$P(PSATR0,"^",16)'="" D REASON
45 .D:$P(PSATR0,"^",2)=24 TRANSFER S PSADJT=$G(PSADJT)+$P(PSATR0,"^",6)
46 ;Dispensed by IP (2 means Unit Dose or Ward Stock 15 means IV)
47 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
48 ;Dispensed by OP
49 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)
50 Q
51 ;
52HEADER ;Prints header info
53 S PSAPG=PSAPG+1 I PSAPG=1,$E(IOST,1,2)="C-" W @IOF
54 I $E(IOST,1,2)="C-",PSAPG>1 D Q:PSAOUT
55 .S PSAS=21-$Y F PSASS=1:1:PSAS W !
56 .S DIR(0)="E" D ^DIR K DIR W:'$G(DIRUT) @IOF S:$G(DIRUT) PSAOUT=1
57 I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),"^"),"." S PSAOUT=1 Q
58 I PSAPG>1,$E(IOST)'="C" W @IOF
59 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)
60 W !?((42-$L(PSABDTR)-$L(PSARPDT))/2),"HISTORY OF DRUG TRANSACTIONS FROM ",PSABDTR," TO ",PSARPDT
61 W !?((80-$L(PSALOCN))/2),PSALOCN
62 W !!?37,"|",?48,"| DISPENSED |",?71,"|"
63 W !,"DATE",?10,"INITIATOR",?37,"| RECEIVED | IP | OP | ADJUSTED | BALANCE"
64 W !,PSADLN
65 I $G(PSADRG)'=""&($G(PSATRCNT)) D WRAPDRUG W ?72,$J(PSABAL,7)
66 Q
67 ;
68ALL ;Creates drug array with all drugs in location
69 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
70 Q
71 ;
72WRAPDRUG ;Prints drug name w/o spliting words
73 I $L(PSADRG)<36 W !,"* ",PSADRG,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" Q
74 S PSAPC1="" F PSAPCS=1:1 S PSAPC=$P(PSADRG," ",PSAPCS) Q:PSAPC="" D
75 .I $L(PSAPC1)+$L(PSAPC)+1<36 S PSAPC1=PSAPC1_PSAPC_" " Q
76 .I $L(PSAPC1)+$L(PSAPC)+1>35 W !,"* "_PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSAPC1=PSAPC_" "
77 W:$L(PSAPC1) !?4,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
78 Q
79 ;
80REASON ;Prints transaction reason w/o spliting words
81 S PSAREA=$P(PSATR0,"^",16)
82 I $L(PSAREA)<27 W !?11,PSAREA,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" Q
83 S PSAPC1="" F PSAPCS=1:1 S PSAPC=$P(PSAREA," ",PSAPCS) Q:PSAPC="" D
84 .I $L(PSAPC1)+$L(PSAPC)+1<27 S PSAPC1=PSAPC1_PSAPC_" " Q
85 .I $L(PSAPC1)+$L(PSAPC)+1>26 W !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSAPC1=PSAPC_" "
86 W:$L(PSAPC1) !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
87 Q
88 ;
89TRANSFER ;Prints transfer pharm loc that rec'd or sent drugs
90 S PSATRANL=$P($G(^PSD(58.81,+$P(PSATR0,"^",17),0)),"^",3),PSAHOLD=PSALOC,PSAHOLDN=PSALOCN,PSALOC=PSATRANL
91 I PSALOC="" S PSAREA="TRANSFER DATA MISSING" S PSALOC=PSAHOLD,PSALOCN=PSAHOLDN Q
92 D SITES^PSAUTL1 S PSALOCN=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
93 S PSAREA="TRANSFER "_$S($P(PSATR0,"^",6)<0:"TO ",1:"FROM ") D TRAN
94 S PSALOC=PSAHOLD,PSALOCN=PSAHOLDN
95 S PSAPC1="" F PSAPCS=1:1 S PSAPC=$P(PSAREA," ",PSAPCS) Q:PSAPC="" D
96 .I $L(PSAPC1)+$L(PSAPC)+1<27 S PSAPC1=PSAPC1_PSAPC_" " Q
97 .I $L(PSAPC1)+$L(PSAPC)+1>26 W !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSAPC1=PSAPC_" "
98 W:$L(PSAPC1) !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
99 Q
100 ;
101TRAN ;Prints transferred location w/o spliting words
102 I $E(PSALOCN)="I" S PSAREA=PSAREA_"INPATIENT:"_$P($P(PSALOCN,":",2),"(IP)")
103 I $E(PSALOCN)="O" S PSAREA=PSAREA_"OUTPATIENT:"_$P($P(PSALOCN,":",2),"(OP)")
104 I $E(PSALOCN)="C" S PSAREA=PSAREA_"COMBINED:"_$P($P(PSALOCN,":",2),"(IP)")_"(IP)"_$P($P(PSALOCN,":",2),"(IP)",2)
105 W !?11,$P(PSAREA,":")_":",?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
106 S PSAREA=$P(PSAREA,": ",2)
107 Q
108 ;
109TOTALS ;Prints totals
110 W !?37,"|----------|-----|-----|----------|--------"
111 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
112 K PSADJT,PSAIPT,PSAOPT,PSARECT
113 Q
Note: See TracBrowser for help on using the repository browser.