source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAVERA3.m@ 1639

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PSAVERA3 ;BHM/DB - RECORD TRANSACTION & UPDATE DRUG FILE;31JAN00
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,42**; 10/24/97
3 ;
4 ;References to ^PSDRUG( are covered by IA #2095
5 ;References to ^DIC(51.5 are covered by IA #1931
6 ;
7OU S DIC(0)="QAEMZ",DIC="^DIC(51.5,",DIC("A")="Select New Order Unit: "
8 D ^DIC G Q:+Y'>0 S PSAOU=+Y
9 I $G(PSAOU)=$G(PSAAOU) W !,"No change." G Q
10 S DIR("B")=$S($P($G(^PSDRUG(PSADRG,660)),"^",5)'="":$P($G(^PSDRUG(PSADRG,660)),"^",5),1:"Blank")
11 S DIR(0)="NO^::2",DIR("A")="DISPENSE UNITS PER ORDER UNIT"
12 S DIR("?")="Enter the number of dispense units contained in one order unit",DIR("??")="^D DUOUHELP^PSAPROC3"
13 D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 G Q
14 S PSANDUOU=+Y
15 S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2),"^")=+Y S:+Y PSASET=1
16 ;
17DRG K PSASUB S X1=0 F S X1=$O(^PSDRUG(PSADRG,1,X1)) Q:X1'>0 S DATA=$G(^PSDRUG(PSADRG,1,X1,0)) I $P(DATA,"^",1)=PSANDC S PSASUB=X1
18 W !,"Old Dispense Units Per Order Unit: "_$P($G(^PSDRUG(PSADRG,660)),"^",5),?45,"Price Per Disp. Unit: "_$J($P($G(^PSDRUG(PSADRG,660)),"^",6),8,2)
19 W !,"New Dispense Units Per Order Unit: "_PSANDUOU
20 I PSANDUOU=$P($G(^PSDRUG(PSADRG,660)),"^",5) W ?45," unchanged " G UPDATE
21 W ?64,$J((PSAPRICE/PSANDUOU),8,2)
22UPDATE ;update file
23 I $G(PSANDC)'="",$L(PSANDC)'=11 D
24 .I $G(PSANDC)'="" S X=11,X1=$L(PSANDC) F X=1:1:(11-X1) S PSANDC="0"_PSANDC ;*42 11 digit NDC
25 .S NDC0=1 F X=1:1:$L(PSANDC) I $E(PSANDC,X)'=0&($E(PSANDC,X)'="-") K NDC0
26 .I $G(NDC0)=1 S PSANDC=""
27 D PSANDC1^PSAHELP S PSADASH=PSANDCX K PSANDCX
28 I $P($G(^PSDRUG(PSADRG,2)),"^",4)'=$G(PSADASH) S DIE="^PSDRUG(",DA=PSADRG,DR="31////^S X=PSADASH" D ^DIE
29 S PSANPDU=PSAPRICE/PSANDUOU
30 W !,"Updating Drug File's Synonym data"
31 I $G(PSASUB)=""!('$D(^PSDRUG(PSADRG,1))) S DA(1)=PSADRG,DIC="^PSDRUG("_DA(1)_",1,",DIC(0)="L",X=PSANDC,DLAYGO=50 D ^DIC S PSASUB=+Y
32 S DA(1)=PSADRG,DIE="^PSDRUG("_DA(1)_",1,",DA=PSASUB,DR="401////^S X=PSAOU;403////^S X=PSANDUOU;404////^S X=PSANPDU" D ^DIE
33 W !,"Updating Drug File's Dispense Units Per Order Unit & Price Per Dispense Unit"
34 K DR,DIE
35 S DIE="^PSDRUG("_DA(1),DR="12///^S X=PSAOU;13////^S X=PSAPRICE;Q;15////^S X=PSANDUOU" D ^DIE
36 S PSADJFLD="O",PSADJ=PSAOU,PSAREA="" D RECORD^PSAVER2
37 W !,"making adjustment in DRUG ACCOUNTABILITY ORDER file"
38 W !,"TAKING A BREAK !?"
39 Q
40Q Q
Note: See TracBrowser for help on using the repository browser.