source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSATRAN.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1PSATRAN ;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
6FROM ;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
11DRUG ;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
20QTY ;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 ;
27CHK I '$D(^PSD(58.8,PSATO,1,PSADRG,0)) W $C(7),!!,PSATON," does not stock ",PSADRGN,"!",! D ADD G:'PSADD DRUG
28ASK ;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 ;
34EXIT 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 ;
39KILL 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
43MSG W $C(7),!!,"No action taken.",! H 1
44 Q
45ADD ;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
50ADD1 ;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 ;
56TO ;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
64HELP ;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
67PRINTYN ;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
71QTYHELP ;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
Note: See TracBrowser for help on using the repository browser.