PSIVCSED.m

PSIVCSED ;BIR/PR-EDIT DRUG COST AND BROADCAST ;04 OCT 94 / 9:42 AM

 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

R1 ;Get the file, the drug, and edit the cost.

 R !!,"Indicate if drug is an ADDITIVE (enter A) or a SOLUTION (enter S): ",FI:DTIME G:"^"[FI K S:'$T FI="" G:'$T K I FI["?" S HELP="AORS" D ^PSIVHLP1 G R1

 S FI=$E(FI),FI=$S(FI="S":52.7,FI="A":52.6,1:"??") W:'FI $C(7),FI G:'FI R1 S DIC=FI,DIC(0)="AEQM" D ^DIC G:Y<0 K S DA=+Y,DRUG=$P(Y,U,2),DIE=FI,DR=7,C1=$P(^PS(FI,DA,0),U,7) D ^DIE S C2=$P(^PS(FI,DA,0),U,7) G:C1=C2 K

 ;

MAIL ;Send mail to holders of PSJI MGR key if drug cost was changed.

 S XMDUZ=$P(^VA(200,DUZ,0),U),XMSUB="IV DRUG COST CHANGED IN THE "_$S(FI[6:"ADDITIVES",1:"SOLUTIONS")_" FILE.",MESS(1,0)=DRUG_" HAS BEEN CHANGED FROM "_$S(C1="":"''",1:C1)_" TO "_$S(C2="":"''",1:C2),XMTEXT="MESS("

 K XMY I $D(^XUSEC("PSJI MGR")) F PDUZ=0:0 S PDUZ=$O(^XUSEC("PSJI MGR",PDUZ)) Q:'PDUZ  S:'$D(^XUSEC("XUPROG",PDUZ)) XMY(PDUZ)=""

 D:$D(XMY) ^XMD

K ;

 K D,D0,D1,DI,DQ,DZ,I,Z,DIC,DIE,C1,C2,DA,DR,XMSUB,XMTEXT,XMY,XCNP,XMDUZ,XMZ,PDUZ,DRUG,X,Y,MESS G:FI'=""&(FI'="^") R1 K FI Q

PSIVCSED  ;BIR/PR-EDIT DRUG COST AND BROADCAST ;04 OCT 94 / 9:42 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

R1        ;Get the file, the drug, and edit the cost.

 +1        READ !!,"Indicate if drug is an ADDITIVE (enter A) or a SOLUTION (enter S): ",FI:DTIME

           IF "^"[FI

               GOTO K

           IF '$TEST

               SET FI=""

           IF '$TEST

               GOTO K

           IF FI["?"

               SET HELP="AORS"

               DO ^PSIVHLP1

               GOTO R1

 +2        SET FI=$EXTRACT(FI)

           SET FI=$SELECT(FI="S":52.7,FI="A":52.6,1:"??")

           IF 'FI

               WRITE $CHAR(7),FI

           IF 'FI

               GOTO R1

           SET DIC=FI

           SET DIC(0)="AEQM"

           DO ^DIC

           IF Y<0

               GOTO K

           SET DA=+Y

           SET DRUG=$PIECE(Y,U,2)

           SET DIE=FI

           SET DR=7

           SET C1=$PIECE(^PS(FI,DA,0),U,7)

           DO ^DIE

           SET C2=$PIECE(^PS(FI,DA,0),U,7)

           IF C1=C2

               GOTO K

 +3       ;

MAIL      ;Send mail to holders of PSJI MGR key if drug cost was changed.

 +1        SET XMDUZ=$PIECE(^VA(200,DUZ,0),U)

           SET XMSUB="IV DRUG COST CHANGED IN THE "_$SELECT(FI[6:"ADDITIVES",1:"SOLUTIONS")_" FILE."

           SET MESS(1,0)=DRUG_" HAS BEEN CHANGED FROM "_$SELECT(C1="":"''",1:C1)_" TO "_$SELECT(C2="":"''",1:C2)

           SET XMTEXT="MESS("

 +2        KILL XMY

           IF $DATA(^XUSEC("PSJI MGR"))

               FOR PDUZ=0:0

                   SET PDUZ=$ORDER(^XUSEC("PSJI MGR",PDUZ))

                   IF 'PDUZ

                       QUIT 

                   IF '$DATA(^XUSEC("XUPROG",PDUZ))

                       SET XMY(PDUZ)=""

 +3        IF $DATA(XMY)

               DO ^XMD

K         ;

 +1        KILL D,D0,D1,DI,DQ,DZ,I,Z,DIC,DIE,C1,C2,DA,DR,XMSUB,XMTEXT,XMY,XCNP,XMDUZ,XMZ,PDUZ,DRUG,X,Y,MESS

           IF FI'=""&(FI'="^")

               GOTO R1

           KILL FI

           QUIT