113 lines
7.8 KiB
Mathematica
113 lines
7.8 KiB
Mathematica
PSAOUT ;BHM/DB - Return Drugs to Manufacturer ;23 FEB 04
|
|
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**51,64**; 10/24/97;Build 4
|
|
;References to ^PSDRUG( are covered by IA #2095
|
|
;References to ^DIC(51.5 are covered by DBIA # 1931
|
|
;References to ^PSRX( are covered by DBIA # 254
|
|
;References to ^PSD(58.86 are covered by DBIA # 4472
|
|
S PSACNT=0
|
|
D Q
|
|
K DIR S DIR(0)="S^1:Print Report;2:Enter drugs Return to Manufacturer" D ^DIR K DIR G Q:$D(DIRUT) I +Y=1 G RPT
|
|
S (PSALOC,PSANUM)=0 F S PSALOC=+$O(^PSD(58.8,"ADISP","P",PSALOC)) Q:PSALOC'>0 S PSALOCN=PSALOC
|
|
1 ;Select Drug
|
|
R !!,"Scan Drug barcode or enter a drug name : ",AN:DTIME S PSACNT=$G(PSACNT)+1 G DONE:AN["^" G DONE:AN="" I AN=" " W "??" G 1
|
|
I $D(^PSDRUG("NDC",AN)) S PSADRG=$O(^PSDRUG("NDC",AN,0)) G FOUND
|
|
I $D(^PSDRUG("C",AN)) S PSADRG=$O(^PSDRUG("C",AN,0)) G FOUND
|
|
I AN?.AN,$D(^PSDRUG(AN,0)) S PSADRG=AN G FOUND
|
|
I AN["-",$P(AN,"-",3)'="" S PSANDC=$P(AN,"-")_$P(AN,"-",2)_$P(AN,"-",3) I $D(^PSDRUG("NDC",PSANDC)) S PSADRG=$O(^PSDRUG("NDC",PSANDC,0)) G FOUND
|
|
I AN["-",$P(AN,"-",3)="" S PSARX=$P(AN,"-",2),PSADRG=$P($G(^PSRX(PSARX,0)),"^",6) I $G(PSADRG)>0 G FOUND
|
|
I AN?.AE S X=AN,DIC(0)="QEZ",DIC("S")="I $S('$D(^(""I"")):1,+^(""I"")>DT:1,1:0),$P($G(^(2)),""^"",3)'[""N""",DIC="^PSDRUG(" D ^DIC K DIC G:+Y'>0 NONDRUG S PSADRG=+Y G FOUND
|
|
W !!,"Sorry, I could not find a match. Please enter the drug name.",!! G FM
|
|
FOUND ;Might have match
|
|
S PSADRUGN=$P($G(^PSDRUG(PSADRG,0)),"^") W " ",$G(PSADRUGN) S DIC("B")=PSADRUGN
|
|
I $P($G(^PSDRUG(PSADRG,2)),"^",3)["N" W !!,"Sorry, Controlled Substances cannot be selected through this option." K PSADRG,PSADRUGN,X,AN G 1
|
|
OK K DIR S DIR("A")="Is this correct",DIR(0)="Y",DIR("B")="YES" D ^DIR G DONE:$D(DIRUT)
|
|
I +Y>0 G PROCEED
|
|
FM ;Fileman search
|
|
S DIC(0)="AEQMZ",DIC("A")="Select Drug : ",DIC("S")="I $S('$D(^(""I"")):1,+^(""I"")>DT:1,1:0),$P($G(^(2)),""^"",3)'[""N""",DIC="^PSDRUG(" D ^DIC G DONE:+Y'>0 S PSADRG=+Y K DIC G FOUND
|
|
PROCEED ;On to the next series of questions
|
|
CON K DIR S DIR(0)="N",DIR("A")="Number of containers " D ^DIR K DIR S PSACON=+Y I $D(DIRUT) G DONE
|
|
K PSAOU
|
|
S PSAOU=$P($G(^PSDRUG(PSADRG,"660")),"^",2) I $G(PSAOU)>0 S PSAOU(1)=$P(^DIC(51.5,PSAOU,0),"^")
|
|
S PSAPDUOU=$P($G(^PSDRUG(PSADRG,660)),"^",6)
|
|
QTY K DIR S DIR(0)="N",DIR("A")="Number of Dispense units being returned: " D ^DIR G DONE:$D(DIRUT)>0 S PSAQTY=Y
|
|
OU K DIC,Y,X S DIC(0)="QAEMZ",DIC="^DIC(51.5,",DIC("A")="Package type: ",DR=.01 S:$G(PSAOU(1))'="" DIC("B")=PSAOU(1) D ^DIC K DIC I +Y<0 G DONE
|
|
S PSAOU(1)=Y(0)
|
|
K DIR S DIR("A")="Is it ok to file the data entered",DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR G Q:$D(DIRUT) I Y'>0 W !,"ok, try again,",! G CON
|
|
W !,"Updating Destruction holding file."
|
|
F L +^PSD(58.86,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|
FIND S PSAHLD=$P(^PSD(58.86,0),"^",3)+1 I $D(^PSD(58.86,PSAHLD)) S $P(^PSD(58.86,0),"^",3)=PSAHLD G FIND
|
|
D NOW^%DTC S PSADT=%
|
|
K DA,DIC,DLAYGO S (DIC,DLAYGO)=58.86,DIC(0)="L",(X,DINUM)=PSAHLD D ^DIC K DIC,DINUM,DLAYGO
|
|
L -^PSD(58.86,0)
|
|
W !,"Updating Drug Accountability Transaction file."
|
|
PSTRAN S PSAIEN=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAIEN)) S $P(^PSD(58.81,0),"^",3)=PSAIEN G PSTRAN
|
|
S DIC="^PSD(58.81,",DIC(0)="L",DLAYG0=58.81,(DINUM,X)=PSAIEN D ^DIC K DIC,DLAYGO
|
|
S DIE="^PSD(58.81,",DA=PSAIEN,DR="1////^S X=10;3////^S X=PSADT;4////^S X=PSADRG;6////^S X=DUZ;47////^S X=PSAHLD" D ^DIE
|
|
UPDT K DA,DIE,DR S DIE=58.86,DA=PSAHLD,DR="1////"_+PSADRG_";2////"_PSAQTY_";11////"_PSACON_";12////"_$P(PSAOU(1),U,1)_";9///^S X=DUZ;10////^S X=PSADT;6////^S X=PSALOCN;19////^S X=$G(PSAPDUOU)"
|
|
I +PSADRG=99999999 S ^PSD(58.86,DA,1)=PSADRUGN
|
|
D ^DIE K DIE,DA,DR S ^PSD(58.86,PSAHLD,2)="Returned to Manufacturer"
|
|
S ^XTMP("PSA",$J,PSACNT)=PSADRG_"^"_PSAQTY_"^"_PSAOU_"^"_PSACON
|
|
W !!!!!!! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y G DONE
|
|
G 1
|
|
DONE I $G(PSACNT)'>0 G Q
|
|
K DIR S DIR("A")="Would you like to print the returns report ",DIR(0)="Y",DIR("B")="YES" D ^DIR G Q:$D(DIRUT)>0 I Y'>0 G Q
|
|
RPT ;print report
|
|
W !,"If you are returning the items to the manufacturer at this time, the program",!,"will add today's date to the item to show when it was actually returned.",!
|
|
K DIR S DIR("A")="Are you returning items to the manufacturer at this time",DIR(0)="Y",DIR("B")="YES" D ^DIR G Q:$D(DIRUT)>0 I Y>0 S PSARET=1
|
|
D NOW^%DTC S X1=X,X2=-90 D C^%DTC S Y=X D DD^%DT S %DT("B")=Y
|
|
BGNDT S %DT="AEP",%DT("A")="Beginning Date: " D ^%DT I +Y<1!($D(DTOUT))!(X["^")!(X']"") G Q
|
|
S PSABEG=+Y
|
|
ENDDT D NOW^%DTC S Y=+% D DD^%DT S %DT("B")=$P(Y,"@"),%DT="AE",%DT("A")="Ending Date : " D ^%DT I +Y<1!($D(DTOUT))!(X["^")!(X']"") S PSAOUT=1 G Q
|
|
I Y<PSABEG W !!,"Ending Date cannot be before the Start Date." G ENDDT
|
|
S PSAEND=+Y
|
|
K IO("Q") S %ZIS="Q" W ! D ^%ZIS I POP W !,"NO DEVICE SELECTED.",! G Q
|
|
I $D(IO("Q")) K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK S ZTRTN="START^PSAOUT",ZTDTH=$H,ZTDESC="PSA OUTDATED REPORT" F X="PSARET","PSABEG","PSAEND" S ZTSAVE(X)=""
|
|
I D ^%ZTLOAD,HOME^%ZIS G Q
|
|
U IO
|
|
START ;
|
|
K ^XTMP("PSA",$J) S PG=0
|
|
S Y=PSABEG,PSADT=PSABEG-.1 D DD^%DT S PSABEG(1)=Y
|
|
S Y=PSAEND D DD^%DT S PSAEND(1)=Y,PSAEND=PSAEND+.999999
|
|
D NOW^%DTC S PSARETD=$P(%,"."),^XTMP("PSA",$J,0)=PSARETD_"^"_PSARETD,Y=PSARETD
|
|
D DD^%DT S PSARETD=Y K Y
|
|
LOOP ;Loop through "AC" xref
|
|
;^PSD(58.86,"AC",DATE/TIME DESTROYED,DISPENSING SITE,DRUG,DA)=""
|
|
S PSADT=$O(^PSD(58.86,"AC",PSADT)) G BEGIN:PSADT'>0 G BEGIN:PSADT>PSAEND
|
|
S PSALOC1=0
|
|
LOC S PSALOC1=$O(^PSD(58.86,"AC",PSADT,PSALOC1)) G LOOP:PSALOC1'>0 G LOOP:PSALOC1'>0 S PSADRG=0
|
|
DRG S PSADRG=$O(^PSD(58.86,"AC",PSADT,PSALOC1,PSADRG)) G LOC:PSADRG'>0 S PSAIEN=0
|
|
IEN S PSAIEN=$O(^PSD(58.86,"AC",PSADT,PSALOC1,PSADRG,PSAIEN)) G DRG:PSAIEN'>0
|
|
S PSADATA=$G(^PSD(58.86,PSAIEN,0)),PSADATA2=$G(^PSD(58.86,PSAIEN,2))
|
|
I $E(PSADATA2,1,3)'="Ret" G IEN
|
|
F X=1:1:14 S PSA(X)=$P(PSADATA,"^",X)
|
|
I $G(PSA(2))=99999999 S PSA(2)=$G(^PSD(58.86,PSAIEN,1))
|
|
S ^XTMP("PSA",$J,PSA(1))=PSA(8)_"^"_PSA(2)_"^"_PSA(3)_"^"_PSA(10)_"^"_PSA(9)_"^"_PSADT_"^"_$G(^PSD(58.86,PSAIEN,2))_"^"_PSA(12)_"^"_PSA(14)
|
|
I $G(PSARET)=1,$G(^PSD(58.86,PSAIEN,2))'["on" S ^PSD(58.86,PSAIEN,2)=^PSD(58.86,PSAIEN,2)_" on "_PSARETD
|
|
G IEN
|
|
PRINT ;Print data
|
|
S PG=$G(PG)+1 W @IOF,!!!,?25,"Items to be Returned Report",?70,"Page : ",$G(PG),!,?24,PSABEG(1)," thru ",PSAEND(1),!,"Printed on: ",PSADT(1),?50,"Printed by: ",$P($G(^VA(200,DUZ,0)),"^"),! F X=1:1:((IOM/2)-2) W "- "
|
|
W !,?50,"Total Dispense"
|
|
W !,"Drug Name",?30,"Containers",?50,"Units / Cost",?66,"Entered by",! F X=1:1:(IOM-1) W "-"
|
|
Q
|
|
BEGIN S PSAIEN=0 D NOW^%DTC S Y=+% D DD^%DT S PSADT(1)=Y D PRINT
|
|
PNT1 S PSAIEN=$O(^XTMP("PSA",$J,PSAIEN)) G EORPT:PSAIEN'>0 S PSADATA=^XTMP("PSA",$J,PSAIEN),PSADRUGN=$P(PSADATA,"^",2)
|
|
W !,$S('$D(^PSDRUG(PSADRUGN,0)):PSADRUGN,1:$P(^PSDRUG(PSADRUGN,0),"^")) I $L(PSADRUGN)>37 W !
|
|
W ?38,$J($P(PSADATA,"^",1),2)," (",$P(PSADATA,"^",8),")",?50,$J($P(PSADATA,"^",3),3)
|
|
I $P(PSADATA,"^",9)]"",$P(PSADATA,"^",1)]"" W ?55,$J(($P(PSADATA,"^",1)*$P(PSADATA,"^",9)),5,2)
|
|
S PSANAME=$S($P(PSADATA,"^",4)']"":"",1:$P($G(^VA(200,$P(PSADATA,"^",4),0)),"^")) I PSANAME'="" S PSANM1=$P(PSANAME,",",1),PSANM2=$P(PSANAME,",",2),PSANAME=$E(PSANM2,1)_$E(PSANM1,1)
|
|
W ?64,PSANAME S DATA=$P(PSADATA,"^",6),X2=$E(DATA,1,3)+1700 W " (",$E(DATA,4,5),"/",$E(DATA,6,7),"/",$E(X2,3,4),")"
|
|
I $Y>(IOSL-5) D HDR G Q:$G(PSAOUT)=1
|
|
G PNT1
|
|
EORPT W !!,"End of report" D ^%ZISC
|
|
Q K AN,DA,DATA,DIC,DIR,DIE,DIRUT,DLAYG0,DR,PG,PSA,PSABEG,PSACNT,PSACON,PSADATA,PSADATA2,PSADRG
|
|
K PSADRUGN,PSADT,PSAEND,PSAHLD,PSAIEN,PSALOC,PSALOC1,PSALOCN,PSANAME,PSANDC,PSANM1,PSANM2,PSANUM,PSAOU
|
|
K PSAPDUOU,PSAOUT,PSAQTY,PSARET,PSARETD,PSARX,X,X1,X2,Y,^XTMP("PSA",$J) Q
|
|
NONDRUG W !,"The item could not be found in the drug file.",!
|
|
K DIR S DIR("A")="Is this a non-va drug",DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR G Q:$D(DIRUT)=1
|
|
I +Y'>0 G FM
|
|
S PSADRG=99999999,PSADRUGN=AN
|
|
ASKD W !,PSADRUGN," //" R AN:DTIME I AN="" G CON
|
|
G Q:AN["^" S PSADRUGN=AN W " ok, press ENTER to confirm.",! G ASKD
|
|
HDR I $E(IOST,1,2)="C-",PG W ! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSAOUT=1 Q
|
|
D PRINT Q
|