PSAVERA3 ;BHM/DB - RECORD TRANSACTION & UPDATE DRUG FILE;31JAN00
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,42**; 10/24/97
;
;References to ^PSDRUG( are covered by IA #2095
;References to ^DIC(51.5 are covered by IA #1931
;
OU S DIC(0)="QAEMZ",DIC="^DIC(51.5,",DIC("A")="Select New Order Unit: "
D ^DIC G Q:+Y'>0 S PSAOU=+Y
I $G(PSAOU)=$G(PSAAOU) W !,"No change." G Q
S DIR("B")=$S($P($G(^PSDRUG(PSADRG,660)),"^",5)'="":$P($G(^PSDRUG(PSADRG,660)),"^",5),1:"Blank")
S DIR(0)="NO^::2",DIR("A")="DISPENSE UNITS PER ORDER UNIT"
S DIR("?")="Enter the number of dispense units contained in one order unit",DIR("??")="^D DUOUHELP^PSAPROC3"
D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 G Q
S PSANDUOU=+Y
S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2),"^")=+Y S:+Y PSASET=1
;
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
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)
W !,"New Dispense Units Per Order Unit: "_PSANDUOU
I PSANDUOU=$P($G(^PSDRUG(PSADRG,660)),"^",5) W ?45," unchanged " G UPDATE
W ?64,$J((PSAPRICE/PSANDUOU),8,2)
UPDATE ;update file
I $G(PSANDC)'="",$L(PSANDC)'=11 D
.I $G(PSANDC)'="" S X=11,X1=$L(PSANDC) F X=1:1:(11-X1) S PSANDC="0"_PSANDC ;*42 11 digit NDC
.S NDC0=1 F X=1:1:$L(PSANDC) I $E(PSANDC,X)'=0&($E(PSANDC,X)'="-") K NDC0
.I $G(NDC0)=1 S PSANDC=""
D PSANDC1^PSAHELP S PSADASH=PSANDCX K PSANDCX
I $P($G(^PSDRUG(PSADRG,2)),"^",4)'=$G(PSADASH) S DIE="^PSDRUG(",DA=PSADRG,DR="31////^S X=PSADASH" D ^DIE
S PSANPDU=PSAPRICE/PSANDUOU
W !,"Updating Drug File's Synonym data"
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
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
W !,"Updating Drug File's Dispense Units Per Order Unit & Price Per Dispense Unit"
K DR,DIE
S DIE="^PSDRUG("_DA(1),DR="12///^S X=PSAOU;13////^S X=PSAPRICE;Q;15////^S X=PSANDUOU" D ^DIE
S PSADJFLD="O",PSADJ=PSAOU,PSAREA="" D RECORD^PSAVER2
W !,"making adjustment in DRUG ACCOUNTABILITY ORDER file"
W !,"TAKING A BREAK !?"
Q
Q Q
PSAVERA3 ;BHM/DB - RECORD TRANSACTION & UPDATE DRUG FILE;31JAN00
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,42**; 10/24/97
+2 ;
+3 ;References to ^PSDRUG( are covered by IA #2095
+4 ;References to ^DIC(51.5 are covered by IA #1931
+5 ;
OU SET DIC(0)="QAEMZ"
SET DIC="^DIC(51.5,"
SET DIC("A")="Select New Order Unit: "
+1 DO ^DIC
IF +Y'>0
GOTO Q
SET PSAOU=+Y
+2 IF $GET(PSAOU)=$GET(PSAAOU)
WRITE !,"No change."
GOTO Q
+3 SET DIR("B")=$SELECT($PIECE($GET(^PSDRUG(PSADRG,660)),"^",5)'="":$PIECE($GET(^PSDRUG(PSADRG,660)),"^",5),1:"Blank")
+4 SET DIR(0)="NO^::2"
SET DIR("A")="DISPENSE UNITS PER ORDER UNIT"
+5 SET DIR("?")="Enter the number of dispense units contained in one order unit"
SET DIR("??")="^D DUOUHELP^PSAPROC3"
+6 DO ^DIR
KILL DIR
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
GOTO Q
+7 SET PSANDUOU=+Y
+8 SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2),"^")=+Y
IF +Y
SET PSASET=1
+9 ;
DRG KILL PSASUB
SET X1=0
FOR
SET X1=$ORDER(^PSDRUG(PSADRG,1,X1))
IF X1'>0
QUIT
SET DATA=$GET(^PSDRUG(PSADRG,1,X1,0))
IF $PIECE(DATA,"^",1)=PSANDC
SET PSASUB=X1
+1 WRITE !,"Old Dispense Units Per Order Unit: "_$PIECE($GET(^PSDRUG(PSADRG,660)),"^",5),?45,"Price Per Disp. Unit: "_$JUSTIFY($PIECE($GET(^PSDRUG(PSADRG,660)),"^",6),8,2)
+2 WRITE !,"New Dispense Units Per Order Unit: "_PSANDUOU
+3 IF PSANDUOU=$PIECE($GET(^PSDRUG(PSADRG,660)),"^",5)
WRITE ?45," unchanged "
GOTO UPDATE
+4 WRITE ?64,$JUSTIFY((PSAPRICE/PSANDUOU),8,2)
UPDATE ;update file
+1 IF $GET(PSANDC)'=""
IF $LENGTH(PSANDC)'=11
Begin DoDot:1
+2 ;*42 11 digit NDC
IF $GET(PSANDC)'=""
SET X=11
SET X1=$LENGTH(PSANDC)
FOR X=1:1:(11-X1)
SET PSANDC="0"_PSANDC
+3 SET NDC0=1
FOR X=1:1:$LENGTH(PSANDC)
IF $EXTRACT(PSANDC,X)'=0&($EXTRACT(PSANDC,X)'="-")
KILL NDC0
+4 IF $GET(NDC0)=1
SET PSANDC=""
End DoDot:1
+5 DO PSANDC1^PSAHELP
SET PSADASH=PSANDCX
KILL PSANDCX
+6 IF $PIECE($GET(^PSDRUG(PSADRG,2)),"^",4)'=$GET(PSADASH)
SET DIE="^PSDRUG("
SET DA=PSADRG
SET DR="31////^S X=PSADASH"
DO ^DIE
+7 SET PSANPDU=PSAPRICE/PSANDUOU
+8 WRITE !,"Updating Drug File's Synonym data"
+9 IF $GET(PSASUB)=""!('$DATA(^PSDRUG(PSADRG,1)))
SET DA(1)=PSADRG
SET DIC="^PSDRUG("_DA(1)_",1,"
SET DIC(0)="L"
SET X=PSANDC
SET DLAYGO=50
DO ^DIC
SET PSASUB=+Y
+10 SET DA(1)=PSADRG
SET DIE="^PSDRUG("_DA(1)_",1,"
SET DA=PSASUB
SET DR="401////^S X=PSAOU;403////^S X=PSANDUOU;404////^S X=PSANPDU"
DO ^DIE
+11 WRITE !,"Updating Drug File's Dispense Units Per Order Unit & Price Per Dispense Unit"
+12 KILL DR,DIE
+13 SET DIE="^PSDRUG("_DA(1)
SET DR="12///^S X=PSAOU;13////^S X=PSAPRICE;Q;15////^S X=PSANDUOU"
DO ^DIE
+14 SET PSADJFLD="O"
SET PSADJ=PSAOU
SET PSAREA=""
DO RECORD^PSAVER2
+15 WRITE !,"making adjustment in DRUG ACCOUNTABILITY ORDER file"
+16 WRITE !,"TAKING A BREAK !?"
+17 QUIT
Q QUIT
