PSAVERA2.m

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.",!

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.",!