| 1 | PSATRAN ;BIR/JMB-Transfer Drugs between Pharmacies ;8/21/97
|
|---|
| 2 | ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
|
|---|
| 3 | ;
|
|---|
| 4 | I $D(^XUSEC("PSAMGR",DUZ)),'$D(^XUSEC("PSJ RPHARM",DUZ)) W !!,"** Contact your Pharmacy Coordinator for access to transfer drugs between",!,?4,"pharmacies. PSAMGR and PSJ RPHARM security keys are required.",! Q
|
|---|
| 5 | S PSADUZ=DUZ,PSADUZN=$P($G(^VA(200,PSADUZ,0)),"^") D SIG^XUSESIG G:X1="" EXIT
|
|---|
| 6 | FROM ;select FROM pharmacy
|
|---|
| 7 | S (PSADD,PSACNT,PSAOUT)=0,PSASLN="",$P(PSASLN,"-",80)="",PSATRAN="F"
|
|---|
| 8 | D ^PSAUTL3 G:PSAOUT EXIT S PSACHK=$O(PSALOC(""))
|
|---|
| 9 | I PSACHK="",'PSALOC W !,"There are no active pharmacy locations." G EXIT
|
|---|
| 10 | S PSAFROM=+PSALOC,PSAFROMN=PSALOCN
|
|---|
| 11 | DRUG ;select drug
|
|---|
| 12 | I '$O(^PSD(58.8,PSAFROM,1,0)) W !!,"There are no drugs in the transferring pharmacy.",!! G EXIT
|
|---|
| 13 | W @IOF,!,PSAFROMN
|
|---|
| 14 | K DA,DIC S DIC("W")="W:$P(^PSDRUG(Y,0),""^"",9) "" N/F"" I $P(^PSD(58.8,PSAFROM,1,Y,0),""^"",14)]"""",$P(^(0),""^"",14)'>DT W $C(7),"" *** INACTIVE ***"""
|
|---|
| 15 | S DIC("A")="Select DRUG: ",DA(1)=+PSAFROM,DIC(0)="QEAM",DIC="^PSD(58.8,"_PSAFROM_",1,"
|
|---|
| 16 | D ^DIC K DIC G:Y<0 FROM I ($D(DTOUT))!($D(DUOUT)) G EXIT
|
|---|
| 17 | G:Y<0 FROM
|
|---|
| 18 | S PSADRG=+Y,PSADRGN=$P($G(^PSDRUG(PSADRG,0)),"^"),PSABAL=+$P($G(^PSD(58.8,PSAFROM,1,PSADRG,0)),"^",4)
|
|---|
| 19 | I PSABAL'>0 W $C(7),!!,PSADRGN," has a "_$S(PSABAL=0:"zero",1:"negative")_" balance.",!,"Select another drug to transfer." G DRUG
|
|---|
| 20 | QTY ;enter quantity
|
|---|
| 21 | S PSADU=$S($P($G(^PSDRUG(PSADRG,660)),"^",8)'="":$P($G(^PSDRUG(PSADRG,660)),"^",8),1:"Unknown")
|
|---|
| 22 | W !!,?5,"Dispense Unit: ",PSADU,?35,"Current Balance: "_PSABAL,!
|
|---|
| 23 | S DIR(0)="NO^1:"_PSABAL_":0",DIR("A")="Enter Quantity to Transfer",DIR("?")="Enter a whole number between 1 and "_PSABAL,DIR("??")="^D QTYHELP^PSATRAN"
|
|---|
| 24 | D ^DIR K DIR I $G(DIRUT) D MSG G DRUG
|
|---|
| 25 | S PSATQTY=+Y D TO
|
|---|
| 26 | ;
|
|---|
| 27 | CHK I '$D(^PSD(58.8,PSATO,1,PSADRG,0)) W $C(7),!!,PSATON," does not stock ",PSADRGN,"!",! D ADD G:'PSADD DRUG
|
|---|
| 28 | ASK ;ask ok
|
|---|
| 29 | W !,PSASLN,!,$P($G(^PSDRUG(PSADRG,0)),"^"),!,"Transferring: ",PSATQTY," (",$P($G(^PSDRUG(PSADRG,660)),"^",8),")",!!,"From: ",PSAFROMN,!,"To : ",PSATON,!,PSASLN,!
|
|---|
| 30 | K DIR,DIRUT S DIR(0)="Y",DIR("A")="OK to post",DIR("B")="Yes",DIR("?")="Answer 'YES' to post this transfer, 'NO' or '^' to quit.",DIR("??")="^D HELP^PSATRAN"
|
|---|
| 31 | D ^DIR K DIR I 'Y!$D(DIRUT) D MSG G DRUG
|
|---|
| 32 | D:PSADD ADD1 D ^PSATRAN1 G:'PSAOUT DRUG
|
|---|
| 33 | ;
|
|---|
| 34 | EXIT I $O(^TMP("PSASIG",$J,0)) D
|
|---|
| 35 | .W ! S DIR(0)="Y",DIR("A")="Print transfer signature sheets",DIR("B")="Y",DIR("?",1)="Enter YES to print transfer signature sheets for the transfers just entered."
|
|---|
| 36 | .S DIR("?")="Enter NO to bypass printing the sheets then exit the option.",DIR("??")="^D PRINTYN^PSATRAN" D ^DIR K DIR Q:$G(DIRUT)!('+Y)
|
|---|
| 37 | .D ^PSASIG
|
|---|
| 38 | ;
|
|---|
| 39 | KILL K %,DA,DIC,DIE,DINUM,DIR,DIRUT,DTOUT,DUOUT,PSABAL,PSACHK,PSACNT,PSADD,PSADISP,PSADJ,PSADRG,PSADRGN,PSADT,PSADU,PSADUZ,PSADUZN,PSAFRDA,PSAFROM,PSAFROMN
|
|---|
| 40 | K PSAJJ,PSALCNT,PSALES,PSALOC,PSALOCA,PSALOCN,PSANODE,PSARDT,PSAREC,PSAREPRT,PSARET,PSASEL,PSASLN,PSAOUT
|
|---|
| 41 | K PSATEMP,PSATF,PSATODA,PSATO,PSATON,PSATQTY,PSATRAN,X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,Y,YY
|
|---|
| 42 | Q
|
|---|
| 43 | MSG W $C(7),!!,"No action taken.",! H 1
|
|---|
| 44 | Q
|
|---|
| 45 | ADD ;ask to add drug
|
|---|
| 46 | K DIR,DIRUT S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("?")="Answer 'YES' to continue with this transfer, 'NO' or '^' to quit.",DIR("??")="^D HELP^PSATRAN"
|
|---|
| 47 | D ^DIR K DIR I $G(DIRUT) D MSG Q
|
|---|
| 48 | S PSADD=+Y
|
|---|
| 49 | Q
|
|---|
| 50 | ADD1 ;add drug
|
|---|
| 51 | Q:$D(^PSD(58.8,PSATO,1,PSADRG,0))
|
|---|
| 52 | S:'$D(^PSD(58.8,PSATO,1,0)) ^PSD(58.8,PSATO,1,0)="^58.8001IP^^"
|
|---|
| 53 | K DA,DD,DO S DIC(0)="L",DIC="^PSD(58.8,"_+PSATO_",1,",DA(1)=+PSATO,(X,DINUM)=+PSADRG D FILE^DICN K DA,DIC
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | TO ;transfer TO pharmacy
|
|---|
| 57 | K PSALOCA(PSAFROMN),DA
|
|---|
| 58 | S PSACNT=0,PSATON="" F S PSATON=$O(PSALOCA(PSATON)) Q:PSATON="" S PSACNT=PSACNT+1
|
|---|
| 59 | I PSACNT=1 S PSATON=$O(PSALOCA("")),PSATO=+$O(PSALOCA(PSATON,0)) Q:'$G(PSAREPRT)
|
|---|
| 60 | ;
|
|---|
| 61 | S PSACNT=0,PSATRAN="T" W ! D DISP^PSAUTL3 G:PSAOUT EXIT S PSACNT=0,PSACHK=$O(PSALOC(""))
|
|---|
| 62 | S PSATO=+PSALOC,PSATON=PSALOCN
|
|---|
| 63 | Q
|
|---|
| 64 | HELP ;Extended help for 'Do you want to continue?'
|
|---|
| 65 | W !?5,"Enter YES if it is okay to transfer this drug. Enter NO to abort the transfer."
|
|---|
| 66 | Q
|
|---|
| 67 | PRINTYN ;Extended help for 'Print transfer signature sheets?'
|
|---|
| 68 | W !?5,"Enter YES if you want to print sheets that can be carried with the drugs",!?5,"to the receiving pharmacy for signature. The person signing the sheet is",!?5,"signing that he/she received the drug(s)."
|
|---|
| 69 | W !!?5,"Enter NO if you do not want to print the signature sheets. You will exit",!?5,"from the option."
|
|---|
| 70 | Q
|
|---|
| 71 | QTYHELP ;Extended help for 'Enter Quantity to Transfer'
|
|---|
| 72 | W !?5,"Enter the number of dispense units to be transferred out of the",!?5,"pharmacy location. Enter a whole number between 1 and "_PSABAL_"."
|
|---|
| 73 | Q
|
|---|
