PSASIG ;BIR/JMB-Transfer Signature Sheet ;7/23/97
 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
 ;This routine prints transfer signature sheets.
 ;
TEMP ;Entry point for printing immediately after transfer is entered. It is
 ;called by PSATRAN1. All transactions are placed in ^TMP("PSASIG",$J)
 ;while inputing the transaction. The transfer sheets are printed using
 ;this array.
 W ! S %ZIS="Q" D ^%ZIS G:POP EXIT
 I $D(IO("Q")) D  G EXIT
 .S ZTDESC="Drug Acct.-Print Transfer Signature Sheets",ZTRTN="TQUE^PSASIG"
 .S ZTSAVE("^TMP(""PSASIG"",$J,")="" D ^%ZTLOAD
TQUE S PSAOUT=0,PSAFIRST=1,PSASLN="",$P(PSASLN,"-",80)="",PSADLN="",$P(PSADLN,"=",80)=""
 D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S PSARPDT=Y
 S PSAFROM=0 F  S PSAFROM=+$O(^TMP("PSASIG",$J,PSAFROM)) Q:'PSAFROM!(PSAOUT)  S PSATO=0 F  S PSATO=+$O(^TMP("PSASIG",$J,PSAFROM,PSATO)) Q:'PSATO!(PSAOUT)  D
 .S PSAPG=0,PSALOC=PSAFROM D SITES^PSAUTL1 S PSAFROMN=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
 .S PSALOC=PSATO D SITES^PSAUTL1 S PSATON=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
 .D HDR Q:PSAOUT
 .S PSADA=0 F  S PSADA=$O(^TMP("PSASIG",$J,PSAFROM,PSATO,PSADA)) Q:'PSADA!(PSAOUT)  D PRINT S PSAFIRST=0
EXIT I $E(IOST)'="C" W @IOF
 I $E(IOST,1,2)="C-",'PSAOUT D
 .S PSASS=21-$Y F PSAKK=1:1:PSASS W !
 .S DIR(0)="E",DIR("A")="END OF REPORT!  Press <RET> to return to the menu" D ^DIR K DIR W @IOF
 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
 K ^TMP("PSASIG",$J),%,%ZIS,DIR,DTOUT,PSABAL,PSABEG,PSACHK,PSACNT,PSACOMB,PSADA,PSADLN,PSADRG,PSADT,PSAEND,PSAFIRST,PSAFROM,PSAFROMN,PSAKK
 K PSALOC,PSALOCA,PSALOCN,PSANODE,PSAOUT,PSAPG,PSAQTY,PSAREPRT,PSARPDT,PSASAVE,PSASEL,PSASLN,PSASS,PSATO,PSATON,PSATRAN,PSATRDT,PSAWHO,Y,ZTDESC,ZTRTN,ZTSAVE
 Q
 ;
REPRINT ;Entry point for Transfer Signature Sheets. It prompts for the
 ;dispensing pharmacy location, receiving pharmacy location, beginning
 ;date, then ending date.
 S PSAREPRT=1,(PSACNT,PSAOUT)=0,PSATRAN="F"
 D ^PSAUTL3 G:PSAOUT EXIT S PSACNT=0,PSACHK=$O(PSALOC(""))
 I PSACHK="",'PSALOC W !,"There are no active pharmacy locations." G EXIT
 S PSAFROM=+PSALOC,PSAFROMN=PSALOCN D TO^PSATRAN
 D BDATE^PSAPV
 W ! S %ZIS="Q" D ^%ZIS G:POP EXIT
 I $D(IO("Q")) D  G EXIT
 .S ZTDESC="Drug Acct.-Reprint Transfer Signature Sheets",ZTRTN="RQUE^PSASIG"
 .F PSASAVE="PSABEG","PSAEND","PSAFROM","PSAFROMN","PSATO","PSATON" S:$D(PSASAVE) ZTSAVE(PSASAVE)=""
 .S ZTSAVE("^TMP(""PSASIG"",$J,")="" D ^%ZTLOAD
RQUE S (PSAPG,PSAOUT)=0,PSAREPRT=1,PSASLN="",$P(PSASLN,"-",80)="",PSADLN="",$P(PSADLN,"=",80)="",PSADT=PSABEG
 D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S PSARPDT=Y,PSAFIRST=1
 D HDR S PSAFIRST=0
 F  S PSADT=+$O(^PSD(58.81,"AF",PSADT)) Q:'PSADT!($P(PSADT,".")>PSAEND)!(PSAOUT)  S PSADA=0 F  S PSADA=+$O(^PSD(58.81,"AF",PSADT,PSAFROM,24,PSADA)) Q:'PSADA!(PSAOUT)  D
 .S PSANODE=$G(^PSD(58.81,PSADA,0)) I $P(PSANODE,"^",6)<0,$P($G(^PSD(58.81,+$P(PSANODE,"^",17),0)),"^",3)=PSATO D PRINT
 G EXIT
 ;
PRINT S PSANODE=$G(^PSD(58.81,PSADA,0)),PSATRDT=$E($$FMTE^XLFDT($P(PSANODE,"^",4),1),1,18),PSADRG=$P(PSANODE,"^",5)
 S PSAQTY=$P(PSANODE,"^",6),PSAWHO=$P($G(^VA(200,+$P(PSANODE,"^",7),0)),"^"),PSABAL=+$P(PSANODE,"^",10)
 S:PSAQTY<0 PSAQTY=-PSAQTY D:$Y+7>IOSL HDR Q:PSAOUT
 W !,PSATRDT,?20,$J(PSAQTY,6),?30,$S($P($G(^PSDRUG(PSADRG,0)),"^")'="":$P($G(^PSDRUG(PSADRG,0)),"^"),1:"UNKNOWN"),?73,$S(+PSABAL:$J((PSABAL-PSAQTY),6),1:"UNKNOWN")
 W !!,?2,"Dispensed by:  "_$S(PSAWHO'="":PSAWHO,1:"_____________________"),?40,"Rec'd by:  ____________________________"
 W !,?20,"(Full Name)",?55,"(Full Name)",!,PSADLN
 Q
 ;
HDR ;Header
 I $E(IOST,1,2)="C-",'PSAFIRST D  I 'Y S PSAOUT=1 Q
 .S PSASS=21-$Y F PSAKK=1:1:PSASS W !
 .S DIR(0)="E" D ^DIR K DIR
 I $E(IOST,1,2)="C-",'PSAPG W @IOF
 W:$E(IOST,1,2)'="C-"&('PSAPG)&('PSAFIRST) @IOF
 W:PSAPG @IOF S PSAPG=PSAPG+1
 W:$G(PSAREPRT) !,?32,"*** REPRINT ***"
 W !,PSARPDT,?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?72,"Page: ",PSAPG
 W !?18,"DRUG TRANSFER BETWEEN PHARMACIES SIGNATURE SHEET"
 W:$L(PSAFROMN)>76 !!,$P(PSAFROMN,"(IP)",1)_"(IP)",!?17,$P(PSAFROMN,"(IP)",2) W:$L(PSAFROMN)<77 !?((80-$L(PSAFROMN))/2),PSAFROMN
 W !!!,"TRANSFERRED TO: " W:$L(PSATON)>63 $P(PSATON,"(IP)",1)_"(IP)",!?17,$P(PSATON,"(IP)",2) W:$L(PSATON)<74 PSATON W !,PSASLN
 W !,"TRANSFER DATE",?23,"QTY",?30,"DRUG",?68,"NEW BALANCE",!,PSASLN
 Q