PSAVER4 ;;BIR/JMB-Verify Invoices - CONT'D ;9/8/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
;This routine prints the report of new drugs that will be added to
;each pharmacy location or master vault.
;
;Asks & prints all invoices the user can verify.
W @IOF,!,"The verified invoices contain new drugs for the assigned pharmacy location.",!,"A report will print by pharmacy location listing the new drugs. Use the"
W !,"Balance Adjustment option to enter an adjustment that reflects the total",!,"dispense units on hand for each new drug.",!!,"It is suggested that you send the report to a print."
K IO("Q") S %ZIS="Q" W !
D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" Q
I $D(IO("Q")) D G QUIT
.N ZTSAVE,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
.S ZTDESC="Drug Acct. - Print New Drugs",ZTDTH=$H,ZTRTN="PRINT^PSAVER4"
.S ZTSAVE("PSANEWD(")="" D ^%ZTLOAD
;
PRINT ;Sends invoices to printer
S (PSALOC,PSAOUT)=0,PSAPG=1,PSADLN="",$P(PSADLN,"=",80)="",PSASLN="",$P(PSASLN,"-",80)=""
F S PSALOC=+$O(PSANEWD(PSALOC)) Q:'PSALOC!(PSAOUT) S PSADRGN=1 D HDR Q:PSAOUT D Q:PSAOUT
.F S PSADRGN=$O(PSANEWD(PSALOC,PSADRGN)) Q:PSADRGN=""!(PSAOUT) D:$Y+5>IOSL HDR Q:PSAOUT W !,PSADRGN,!,PSASLN,!
D:$E(IOST,1,2)="C-"&('PSAOUT) END^PSAPROC W:$E(IOST)'="C" @IOF
K PSANEWD(PSALOC)
QUIT D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
Q
;
HDR ;Prints the header to the New Drug Report on the screen & paper.
I $E(IOST,1,2)="C-" D:PSAPG'=1 END^PSAPROC Q:PSAOUT W @IOF,!?28,"<<< NEW DRUG REPORT >>>"
I $E(IOST)'="C" W:PSAPG'=1 @IOF W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",!?28,"<<< NEW DRUG REPORT >>>",?72,"Page "_PSAPG
I $P($G(^PSD(58.8,PSALOC,0)),"^",2)="M" W !?34,"MASTER VAULT",!!,$P($G(^PSD(58.8,PSALOC,0)),"^")
I $P($G(^PSD(58.8,PSALOC,0)),"^",2)="P" D
.D SITES^PSAUTL1 S PSALOCN=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
.W !?31,"PHARMACY LOCATION",!!
.W:$L(PSALOCN)>76 $P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 PSALOCN
W !,PSADLN S PSAPG=PSAPG+1
Q
PSAVER4 ;;BIR/JMB-Verify Invoices - CONT'D ;9/8/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
+2 ;This routine prints the report of new drugs that will be added to
+3 ;each pharmacy location or master vault.
+4 ;
+5 ;Asks & prints all invoices the user can verify.
+6 WRITE @IOF,!,"The verified invoices contain new drugs for the assigned pharmacy location.",!,"A report will print by pharmacy location listing the new drugs. Use the"
+7 WRITE !,"Balance Adjustment option to enter an adjustment that reflects the total",!,"dispense units on hand for each new drug.",!!,"It is suggested that you send the report to a print."
+8 KILL IO("Q")
SET %ZIS="Q"
WRITE !
+9 DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR OUTPUT PRINTED!"
QUIT
+10 IF $DATA(IO("Q"))
Begin DoDot:1
+11 NEW ZTSAVE,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
+12 SET ZTDESC="Drug Acct. - Print New Drugs"
SET ZTDTH=$HOROLOG
SET ZTRTN="PRINT^PSAVER4"
+13 SET ZTSAVE("PSANEWD(")=""
DO ^%ZTLOAD
End DoDot:1
GOTO QUIT
+14 ;
PRINT ;Sends invoices to printer
+1 SET (PSALOC,PSAOUT)=0
SET PSAPG=1
SET PSADLN=""
SET $PIECE(PSADLN,"=",80)=""
SET PSASLN=""
SET $PIECE(PSASLN,"-",80)=""
+2 FOR
SET PSALOC=+$ORDER(PSANEWD(PSALOC))
IF 'PSALOC!(PSAOUT)
QUIT
SET PSADRGN=1
DO HDR
IF PSAOUT
QUIT
Begin DoDot:1
+3 FOR
SET PSADRGN=$ORDER(PSANEWD(PSALOC,PSADRGN))
IF PSADRGN=""!(PSAOUT)
QUIT
IF $Y+5>IOSL
DO HDR
IF PSAOUT
QUIT
WRITE !,PSADRGN,!,PSASLN,!
End DoDot:1
IF PSAOUT
QUIT
+4 IF $EXTRACT(IOST,1,2)="C-"&('PSAOUT)
DO END^PSAPROC
IF $EXTRACT(IOST)'="C"
WRITE @IOF
+5 KILL PSANEWD(PSALOC)
QUIT DO ^%ZISC
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL IO("Q")
+1 QUIT
+2 ;
HDR ;Prints the header to the New Drug Report on the screen & paper.
+1 IF $EXTRACT(IOST,1,2)="C-"
IF PSAPG'=1
DO END^PSAPROC
IF PSAOUT
QUIT
WRITE @IOF,!?28,"<<< NEW DRUG REPORT >>>"
+2 IF $EXTRACT(IOST)'="C"
IF PSAPG'=1
WRITE @IOF
WRITE !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",!?28,"<<< NEW DRUG REPORT >>>",?72,"Page "_PSAPG
+3 IF $PIECE($GET(^PSD(58.8,PSALOC,0)),"^",2)="M"
WRITE !?34,"MASTER VAULT",!!,$PIECE($GET(^PSD(58.8,PSALOC,0)),"^")
+4 IF $PIECE($GET(^PSD(58.8,PSALOC,0)),"^",2)="P"
Begin DoDot:1
+5 DO SITES^PSAUTL1
SET PSALOCN=$PIECE(^PSD(58.8,PSALOC,0),"^")_PSACOMB
+6 WRITE !?31,"PHARMACY LOCATION",!!
+7 IF $LENGTH(PSALOCN)>76
WRITE $PIECE(PSALOCN,"(IP)",1)_"(IP)",!?17,$PIECE(PSALOCN,"(IP)",2)
IF $LENGTH(PSALOCN)<77
WRITE PSALOCN
End DoDot:1
+8 WRITE !,PSADLN
SET PSAPG=PSAPG+1
+9 QUIT
