| 1 | PSDTRVR1 ;BIR/JPW-CS Transfer Vaults Report (cont'd) ; 4 Aug 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | START ;compile data
|
|---|
| 4 | K ^TMP("PSDTRVR",$J) S PSDOUT=0
|
|---|
| 5 | F JJ=0:0 S JJ=$O(SITE(JJ)) Q:'JJ F TYP="M","S" F PSDS=0:0 S PSDS=$O(^PSD(58.8,"ASITE",+JJ,TYP,PSDS)) Q:'PSDS S PSDS(PSDS)=""
|
|---|
| 6 | F PSDS=0:0 S PSDS=$O(PSDS(PSDS)) Q:'PSDS F PSD=PSDSD:0 S PSD=$O(^PSD(58.81,"ACT",PSD)) Q:'PSD!(PSD>PSDED) F PSDR=0:0 S PSDR=$O(^PSD(58.81,"ACT",PSD,PSDS,PSDR)) Q:'PSDR D
|
|---|
| 7 | .F PSDA=0:0 S PSDA=$O(^PSD(58.81,"ACT",PSD,PSDS,PSDR,16,PSDA)) Q:'PSDA D
|
|---|
| 8 | ..Q:'$D(^PSD(58.81,PSDA,0)) S NODE=^PSD(58.81,PSDA,0)
|
|---|
| 9 | ..S PSDRN=$S($P($G(^PSDRUG(+PSDR,0)),"^")]"":$P(^(0),"^"),1:"ZZ/UNKNOWN")
|
|---|
| 10 | ..S PSDSN=$S($P($G(^PSD(58.8,+PSDS,0)),"^")]"":$P(^(0),"^"),1:"ZZ/UNKNOWN")
|
|---|
| 11 | ..S QTY=$P(NODE,"^",6),PHARM=$P(NODE,"^",7),PHARMN=$S($P($G(^VA(200,+PHARM,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
|---|
| 12 | ..S ^TMP("PSDTRVR",$J,PSDSN,PSDRN,PSD)=QTY_"^"_PHARMN
|
|---|
| 13 | PRINT ;print transfer between vaults by date
|
|---|
| 14 | S (PG,PSDOUT)=0
|
|---|
| 15 | K LN S $P(LN,"-",80)="" D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S RPDT=Y
|
|---|
| 16 | I '$D(^TMP("PSDTRVR",$J)) D HDR W !!,?10,"**** NO TRANSFER BETWEEN VAULTS DATA FOR THIS REPORT ****" G DONE
|
|---|
| 17 | S JJ="" F S JJ=$O(^TMP("PSDTRVR",$J,JJ)) Q:JJ=""!(PSDOUT) D HDR S KK="" F S KK=$O(^TMP("PSDTRVR",$J,JJ,KK)) Q:KK=""!(PSDOUT) D:$Y+9>IOSL HDR Q:PSDOUT W !,?2,"=> ",KK,!! F LL=0:0 S LL=$O(^TMP("PSDTRVR",$J,JJ,KK,LL)) Q:'LL!(PSDOUT) D
|
|---|
| 18 | .D:$Y+8>IOSL HDR Q:PSDOUT
|
|---|
| 19 | .S NODE=^TMP("PSDTRVR",$J,JJ,KK,LL),QTY=$P(NODE,"^")
|
|---|
| 20 | .S Y=LL X ^DD("DD") S PSDT=Y
|
|---|
| 21 | .W PSDT,?25,$J(QTY,8),?40,$P(NODE,"^",2),!
|
|---|
| 22 | .W:ASK !,?5,"Transferred/Received By: _______________________________________________",!!
|
|---|
| 23 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 24 | I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu" D ^DIR K DIR
|
|---|
| 25 | END ;
|
|---|
| 26 | K %,%DT,%H,%I,%ZIS,ASK,CNT,DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,JJ,KK,LL,LN,NODE,OK
|
|---|
| 27 | K PG,PHARM,PHARMN,POP,PSD,PSDA,PSDATE,PSDED,PSDOUT,PSDR,PSDRN,PSDS,PSDSD,PSDSN,PSDT,QTY,RPDT,SITE,SITEN,TYP,X,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK
|
|---|
| 28 | K ^TMP("PSDTRVR",$J) D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 29 | Q
|
|---|
| 30 | HDR ;header for log
|
|---|
| 31 | I $E(IOST,1,2)="C-",PG W ! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
|
|---|
| 32 | S PG=PG+1 W:$Y @IOF W !,?15,"TRANSFER CS DRUGS BETWEEN DISP SITES REPORT",?70,"Page: ",PG
|
|---|
| 33 | W !,?15,"TRANSACTIONS FOR PERIOD ",$P(PSDATE,"^")," TO ",$P(PSDATE,"^",2)
|
|---|
| 34 | W:$G(JJ)]"" !,?15,"DISPENSING SITE: ",JJ
|
|---|
| 35 | W !,?15,"PRINTED ",RPDT,!!,?2,"=> DRUG",!!,"DATE/TIME TRANSFERRED",?28,"QUANTITY",?40,"TRANSFERRED BY",!,LN,!
|
|---|
| 36 | Q
|
|---|
