PSAVERA2 ;BHM/DB - Edit previously verified invoices #2;21DEC99
;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,49**; 10/24/97
;References to ^PSDRUG( are covered by IA #2095
;
ASKDRUG ;Change drug
S PSAGAIN=0,PSABEFOR=PSADRG,DIC(0)="AEQMZ",DIC="^PSDRUG(" D ^DIC K DIC
I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
S PSADJFLD="D",PSAREA="",PSASUPP=0
I +Y=-1 D Q:PSASUPP!(PSAOUT)
.S PSAVER=1 D SUPPLY^PSANDF Q:PSAOUT I 'PSASUPP S PSAGAIN=1 Q
.S PSA50IEN=0,PSADJ=PSAREA,PSAREA=""
.D RECORD
G:$G(PSAGAIN) ASKDRUG
S (PSA50IEN,PSADJ,PSADRG)=+Y D RECORD,VERDISP^PSAUTL4
I PSANDC'="",$O(^PSDRUG("C",PSANDC,PSA50IEN,0)) D
.S PSASUB=+$O(^PSDRUG("C",PSANDC,PSA50IEN,0)),$P(^PSD(58.811,PSAIEN,1,PSAIEN1,2),"^",3)=PSASUB
.I '+$P($G(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7) D DUOU^PSAVER2 Q
.I +$P($G(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7),+$P($G(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7)'=+$P($G(^PSDRUG(PSABEFOR,1,PSASUB,0)),"^",7) D DUOU^PSAVER2
W !,"Decrementing balance of "_PSABAL_" from "_$P($G(^PSDRUG(PSADRG,0)),"^")
W !,"Increasing balance of "_PSANEWD_" by "_PSABAL_"."
Q
W !!,"Note that if you change the drug on this line item, the balances will be",!,"updated."
LOCATION ;Change pharmacy location
W !,"If the location is changed, the balances will be decremented from the original",!,"location, the transaction file will record the proper changes.",!
LST ;List all data associated with location/drug
;get data from 58.8 & 58.81
;Show allsysnonym data from drug file.
RECORD ;Add adjusted data to DA Orders file
K PSASUBB
W !,"ok, we'll update the files now at RECORD"
S PSABFR=0 F S PSABFR=$O(^PSDRUG(PSABEFOR,1,PSABFR)) Q:PSABFR=$G(PSASUB) Q:PSABFR'>0 S PSASUBB=PSABFR
I $G(PSASUBB) S PREVDATA=$G(^PSDRUG(PSABEFOR,1,PSASUBB,0)) D
.W !,"Will update old drug data with previous synonym data of : ",!,?20,PREVDATA
I '$G(PSASUBB) W !,"Could not find previous sysnonym data, therefore the prices will remain as",!,"they are.",!
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAVERA2 1976 printed Sep 23, 2025@19:27:13 Page 2
PSAVERA2 ;BHM/DB - Edit previously verified invoices #2;21DEC99
+1 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,49**; 10/24/97
+2 ;References to ^PSDRUG( are covered by IA #2095
+3 ;
ASKDRUG ;Change drug
+1 SET PSAGAIN=0
SET PSABEFOR=PSADRG
SET DIC(0)="AEQMZ"
SET DIC="^PSDRUG("
DO ^DIC
KILL DIC
+2 IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+3 SET PSADJFLD="D"
SET PSAREA=""
SET PSASUPP=0
+4 IF +Y=-1
Begin DoDot:1
+5 SET PSAVER=1
DO SUPPLY^PSANDF
if PSAOUT
QUIT
IF 'PSASUPP
SET PSAGAIN=1
QUIT
+6 SET PSA50IEN=0
SET PSADJ=PSAREA
SET PSAREA=""
+7 DO RECORD
End DoDot:1
if PSASUPP!(PSAOUT)
QUIT
+8 if $GET(PSAGAIN)
GOTO ASKDRUG
+9 SET (PSA50IEN,PSADJ,PSADRG)=+Y
DO RECORD
DO VERDISP^PSAUTL4
+10 IF PSANDC'=""
IF $ORDER(^PSDRUG("C",PSANDC,PSA50IEN,0))
Begin DoDot:1
+11 SET PSASUB=+$ORDER(^PSDRUG("C",PSANDC,PSA50IEN,0))
SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,2),"^",3)=PSASUB
+12 IF '+$PIECE($GET(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7)
DO DUOU^PSAVER2
QUIT
+13 IF +$PIECE($GET(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7)
IF +$PIECE($GET(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7)'=+$PIECE($GET(^PSDRUG(PSABEFOR,1,PSASUB,0)),"^",7)
DO DUOU^PSAVER2
End DoDot:1
+14 WRITE !,"Decrementing balance of "_PSABAL_" from "_$PIECE($GET(^PSDRUG(PSADRG,0)),"^")
+15 WRITE !,"Increasing balance of "_PSANEWD_" by "_PSABAL_"."
+16 QUIT
+17 WRITE !!,"Note that if you change the drug on this line item, the balances will be",!,"updated."
LOCATION ;Change pharmacy location
+1 WRITE !,"If the location is changed, the balances will be decremented from the original",!,"location, the transaction file will record the proper changes.",!
LST ;List all data associated with location/drug
+1 ;get data from 58.8 & 58.81
+2 ;Show allsysnonym data from drug file.
RECORD ;Add adjusted data to DA Orders file
+1 KILL PSASUBB
+2 WRITE !,"ok, we'll update the files now at RECORD"
+3 SET PSABFR=0
FOR
SET PSABFR=$ORDER(^PSDRUG(PSABEFOR,1,PSABFR))
if PSABFR=$GET(PSASUB)
QUIT
if PSABFR'>0
QUIT
SET PSASUBB=PSABFR
+4 IF $GET(PSASUBB)
SET PREVDATA=$GET(^PSDRUG(PSABEFOR,1,PSASUBB,0))
Begin DoDot:1
+5 WRITE !,"Will update old drug data with previous synonym data of : ",!,?20,PREVDATA
End DoDot:1
+6 IF '$GET(PSASUBB)
WRITE !,"Could not find previous sysnonym data, therefore the prices will remain as",!,"they are.",!
