| 1 | PSAMON1 ;BIR/LTL,JMB-Monthly Summary - CONT'D;9/11/97
|
|---|
| 2 | ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
|
|---|
| 3 | ;This routine allows the user to print a report per pharmacy location
|
|---|
| 4 | ;of the drug, beginning balance, ending balance, total received, total
|
|---|
| 5 | ;dispensed, and total adjustments. Specific or all drugs can be selected
|
|---|
| 6 | ;for the report. The report can be sent to the screen and printer.
|
|---|
| 7 | ;
|
|---|
| 8 | PRINT ;Prints totals report
|
|---|
| 9 | S (PSAGADJ,PSAGDISP,PSAGREC,PSAGTF,PSAPG)=0 D HEADER
|
|---|
| 10 | S PSADRUG="" F S PSADRUG=$O(^TMP("PSAG",$J,PSADRUG)) Q:PSADRUG=""!(PSAOUT) D Q:PSAOUT
|
|---|
| 11 | .D:$Y+4>IOSL HEADER Q:PSAOUT
|
|---|
| 12 | .S PSANODE=^TMP("PSAG",$J,PSADRUG),PSAGREC=PSAGREC+$P(PSANODE,"^"),PSAGDISP=PSAGDISP+$P(PSANODE,"^",2),PSAGADJ=PSAGADJ+$P(PSANODE,"^",3),PSAGTF=PSAGTF+$P(PSANODE,"^",4)
|
|---|
| 13 | .D WRAPDRG
|
|---|
| 14 | .W ?36,$J($P(PSANODE,"^"),6,0),?49,$J($P(PSANODE,"^",2),6,0),?60,$J($P(PSANODE,"^",3),6,0),?73,$J($P(PSANODE,"^",4),6,0),!
|
|---|
| 15 | .W:$O(^TMP("PSAG",$J,PSADRUG))'="" PSASLN W:$O(^TMP("PSAG",$J,PSADRUG))="" PSADLN
|
|---|
| 16 | I 'PSAOUT D:$Y+4>IOSL HEADER Q:PSAOUT W !,"GRAND TOTAL",?36,$J(PSAGREC,6,0),?49,$J(PSAGDISP,6,0),?60,$J(PSAGADJ,6,0),?73,$J(PSAGTF,6,0),!,PSADLN,!
|
|---|
| 17 | ;
|
|---|
| 18 | END I $E($G(IOST))="C",'$G(PSAOUT) D
|
|---|
| 19 | .S PSAS=22-$Y F PSASS=1:1:PSAS W !
|
|---|
| 20 | .S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu." D ^DIR K DIR I $G(DIRUT) S PSAOUT=1
|
|---|
| 21 | W @IOF
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | HEADER ;prints header info
|
|---|
| 25 | I $E(IOST,1,2)="C-",PSAPG D Q:PSAOUT
|
|---|
| 26 | .S PSAS=22-$Y F PSASS=1:1:PSAS W !
|
|---|
| 27 | .S DIR(0)="E" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1
|
|---|
| 28 | I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSAOUT=1 Q
|
|---|
| 29 | I $E(IOST,1,2)="C-" W @IOF
|
|---|
| 30 | I $E(IOST)'="C",PSAPG W @IOF
|
|---|
| 31 | S PSAPG=PSAPG+1 W:$E(IOST)'="C" !,PSARPDT W:$E(IOST,1,2)="C-" !
|
|---|
| 32 | W ?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?71,"PAGE: ",PSAPG
|
|---|
| 33 | W !?19,"MONTHLY SUMMARY TOTALS REPORT FOR "_PSAMONN
|
|---|
| 34 | F PSAPC=1:1 S PSAPICK=+$P(PSASEL,",",PSAPC) Q:'PSAPICK D
|
|---|
| 35 | .S PSALOCN="" F S PSALOCN=$O(PSAMENU(PSAPICK,PSALOCN)) Q:PSALOCN=""!(PSAOUT) S PSALOC=0 F S PSALOC=$O(PSAMENU(PSAPICK,PSALOCN,PSALOC)) Q:'PSALOC!(PSAOUT) D
|
|---|
| 36 | ..W:$L(PSALOCN)>79 !!,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<80 !?((80-$L(PSALOCN))/2),PSALOCN
|
|---|
| 37 | W !!?36,"TOTAL",?48,"TOTAL",?60,"TOTAL",?72,"TOTAL"
|
|---|
| 38 | W !,"DRUG",?34,"RECEIVED",?46,"DISPENSED",?58,"ADJUSTED",?69,"TRANSFERRED",!,PSADLN
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | WRAPDRG ;Wraps the drug name if it is longer than 34 characters
|
|---|
| 42 | I $L(PSADRUG)<36 W !,PSADRUG Q
|
|---|
| 43 | S PSAPC1="" F PSAPCS=1:1 S PSAPC=$P(PSADRUG," ",PSAPCS) Q:PSAPC="" D
|
|---|
| 44 | .I $L(PSAPC1)+$L(PSAPC)+1<36 S PSAPC1=PSAPC1_PSAPC_" " Q
|
|---|
| 45 | .I $L(PSAPC1)+$L(PSAPC)+1>35 W !,PSAPC1 S PSAPC1=PSAPC_" "
|
|---|
| 46 | W:$L(PSAPC1) !?4,PSAPC1
|
|---|
| 47 | Q
|
|---|
