- 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 Apr 23, 2025@18:05:37 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.",!
