- 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
