| 1 | PSAVERA3 ;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 | ;
|
|---|
| 7 | OU 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 | ;
|
|---|
| 17 | DRG 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)
|
|---|
| 22 | UPDATE ;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
|
|---|
| 40 | Q Q
|
|---|
