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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVCSED 1098 printed Dec 13, 2024@02:03:59 Page 2
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
