PSGDCC ;BIR/CML3-CHANGE DRUG COST DATA IN 57.6 ;14 JUL 94 / 9:16 AM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
;
D ENCV^PSGSETU I $D(XQUIT) Q
K %DT,DIC S DIC="^PSDRUG(",DIC(0)="AEIMOQZ",DIC("A")="Select DRUG: " W ! D ^DIC K DIC I Y'>0 W !,"No drug chosen, or change made." G DONE
S DRG=+Y,DRGN=Y(0,0),CC=$S($D(^PSDRUG(DRG,660)):$P(^(660),"^",6),1:0) W !,$S('CC:"NO ",1:""),"CURRENT PRICE PER DISPENSE UNIT",$S(CC:" IS "_CC,1:".")
K DIR S DIR(0)="NAO^0:222:4",DIR("A")="Enter NEW COST: ",DIR("?")="^D NCM^PSGDCC" D ^DIR
I $D(DIRUT) W !,"No new cost entered. No changes made." G DONE
S NC=Y
F M="START","STOP" D DT G:Y'>0 DONE
;
CHG ;
W !!,"...This may take a few minutes..." F H 1 D NOW^%DTC I '$D(^PS(57.6,"ADCC",%)) S PSGDT=% Q
S X1=SD1,X2=-1 D C^%DTC S SD=X F S SD=$O(^PS(57.6,SD)) Q:'SD!(SD>FD) S W=0 F S W=$O(^PS(57.6,SD,1,W)) Q:'W S P=0 F S P=$O(^PS(57.6,SD,1,W,1,P)) Q:'P I $D(^PS(57.6,SD,1,W,1,P,1,DRG,0)) S OLD=^(0) D C1
I '$D(^PS(57.6,"ADCC",PSGDT)) W !!,$S('$D(^PSDRUG(DRG,0)):DRG,$P(^(0),"^")]"":$P(^(0),"^"),1:DRG)," NOT FOUND WITHIN THE DATE RANGE SPECIFIED."
E S ^PS(57.6,"ADCC",PSGDT)=DUZ_"^"_DRG_"^"_NC_"^"_SD1_"^"_FD D ^PSGDCCM
;
DONE ;
D ENKV^PSGSETU K CC,DRG,DRGN,FD,M,NC,OLD,OLDC,P,SD,SD1,W,XCNP,XMZ Q
;
NCM ;
W !!," Enter the new cost (Price Per Dispense Unit) for the drug chosen. The cost",!,"entered here will be used in resetting the data in the cost stats file.",!,"The cost entered may be a decimal value with no trailing zeros." Q
;
DT ;
S %DT="EX" S:M="STOP" %DT(0)=SD1 F S Y=-1 W !!,"Enter ",M," DATE: " R X:DTIME W:'$T $C(7) S:'$T X="^" Q:"^"[X D DTM:X?1."?",^%DT Q:Y>0
K %DT I Y'>0 W !?2,M," DATE NOT ENTERED. CHANGE TERMINATED." Q
S @$S(M="STOP":"FD",1:"SD1")=Y Q
;
DTM ;
W !!," Enter the ",$S(M="STOP":"stop",1:"start")," date of the range of dates over which the cost data is to be",!,"changed. The start and stop dates may be the same day, effectively creating a one day change,"
W " but the stop date may not come before the start date.",!," Time is not entered.",! Q
;
C1 ;
S OLDC=$S($P(OLD,"^",2):$P(OLD,"^",3)/$P(OLD,"^",2),1:"")_"^"_$S($P(OLD,"^",4):$P(OLD,"^",5)/$P(OLD,"^",4),1:"")
S ^PS(57.6,SD,1,W,1,P,1,DRG,0)=$P(OLD,"^",1,2)_"^"_($P(OLD,"^",2)*NC)_"^"_$P(OLD,"^",4)_"^"_($P(OLD,"^",4)*NC)_$S($P(OLD,"^",6,99)]"":"^"_$P(OLD,"^",6,99),1:""),^PS(57.6,"ADCC",PSGDT,SD,W,P)=OLDC Q
;
ENDEL ; delete cost data (completely!)
S PSGID=$O(^PS(57.6,0)) I 'PSGID W $C(7),!!,"NO COST DATA FOUND TO DELETE." G DELOUT
K %DT S PSGOD=$E($$ENDTC^PSGMI(PSGID),1,8),%DT="EXP",Y=-1 F R !!,"Enter LIMIT DATE: ",X:DTIME W:'$T $C(7) S:'$T X="^" Q:"^"[X D DELM:X?1."?",^%DT Q:X'?1."?"
W:Y'>0 !?2,"No date chosen, or data deleted." I Y>0 W !,"...a few moments, please..." D DELDC W:'H $C(7),$C(7),!,"No data found prior to date chosen!"
;
DELOUT ;
K %DT,PSGID,PSGOD,Q,X,Y Q
;
DELDC ;
S (F,H)=0 F X=0:0 S X=$O(^PS(57.6,X)) Q:'X!(X>Y) K ^(X) S F=1,H=X
F Q=0:0 S Q=$O(^PS(57.6,"ADCC",Q)) Q:'Q F X=0:0 S X=$O(^PS(57.6,"ADCC",Q,X)) Q:'X!(X>Y) K ^(X) K:$D(^PS(57.6,"ADCC",Q))<10 ^(Q)
Q
;
DELM ;
W !!?2,"ALL cost data for doses dispensed on or before the date selected will be",!,"completely deleted from the computer. The earliest date found is ",PSGOD,".",!!,"WARNING!! THIS DATA CANNOT BE REBUILT OR RECOMPILED!",! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGDCC 3347 printed Nov 22, 2024@17:11:04 Page 2
PSGDCC ;BIR/CML3-CHANGE DRUG COST DATA IN 57.6 ;14 JUL 94 / 9:16 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
+2 ;
+3 DO ENCV^PSGSETU
IF $DATA(XQUIT)
QUIT
+4 KILL %DT,DIC
SET DIC="^PSDRUG("
SET DIC(0)="AEIMOQZ"
SET DIC("A")="Select DRUG: "
WRITE !
DO ^DIC
KILL DIC
IF Y'>0
WRITE !,"No drug chosen, or change made."
GOTO DONE
+5 SET DRG=+Y
SET DRGN=Y(0,0)
SET CC=$SELECT($DATA(^PSDRUG(DRG,660)):$PIECE(^(660),"^",6),1:0)
WRITE !,$SELECT('CC:"NO ",1:""),"CURRENT PRICE PER DISPENSE UNIT",$SELECT(CC:" IS "_CC,1:".")
+6 KILL DIR
SET DIR(0)="NAO^0:222:4"
SET DIR("A")="Enter NEW COST: "
SET DIR("?")="^D NCM^PSGDCC"
DO ^DIR
+7 IF $DATA(DIRUT)
WRITE !,"No new cost entered. No changes made."
GOTO DONE
+8 SET NC=Y
+9 FOR M="START","STOP"
DO DT
if Y'>0
GOTO DONE
+10 ;
CHG ;
+1 WRITE !!,"...This may take a few minutes..."
FOR
HANG 1
DO NOW^%DTC
IF '$DATA(^PS(57.6,"ADCC",%))
SET PSGDT=%
QUIT
+2 SET X1=SD1
SET X2=-1
DO C^%DTC
SET SD=X
FOR
SET SD=$ORDER(^PS(57.6,SD))
if 'SD!(SD>FD)
QUIT
SET W=0
FOR
SET W=$ORDER(^PS(57.6,SD,1,W))
if 'W
QUIT
SET P=0
FOR
SET P=$ORDER(^PS(57.6,SD,1,W,1,P))
if 'P
QUIT
IF $DATA(^PS(57.6,SD,1,W,1,P,1,DRG,0))
SET OLD=^(0)
DO C1
+3 IF '$DATA(^PS(57.6,"ADCC",PSGDT))
WRITE !!,$SELECT('$DATA(^PSDRUG(DRG,0)):DRG,$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:DRG)," NOT FOUND WITHIN THE DATE RANGE SPECIFIED."
+4 IF '$TEST
SET ^PS(57.6,"ADCC",PSGDT)=DUZ_"^"_DRG_"^"_NC_"^"_SD1_"^"_FD
DO ^PSGDCCM
+5 ;
DONE ;
+1 DO ENKV^PSGSETU
KILL CC,DRG,DRGN,FD,M,NC,OLD,OLDC,P,SD,SD1,W,XCNP,XMZ
QUIT
+2 ;
NCM ;
+1 WRITE !!," Enter the new cost (Price Per Dispense Unit) for the drug chosen. The cost",!,"entered here will be used in resetting the data in the cost stats file.",!,"The cost entered may be a decimal value with no trailing zeros."
QUIT
+2 ;
DT ;
+1 SET %DT="EX"
if M="STOP"
SET %DT(0)=SD1
FOR
SET Y=-1
WRITE !!,"Enter ",M," DATE: "
READ X:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET X="^"
if "^"[X
QUIT
if X?1."?"
DO DTM
DO ^%DT
if Y>0
QUIT
+2 KILL %DT
IF Y'>0
WRITE !?2,M," DATE NOT ENTERED. CHANGE TERMINATED."
QUIT
+3 SET @$SELECT(M="STOP":"FD",1:"SD1")=Y
QUIT
+4 ;
DTM ;
+1 WRITE !!," Enter the ",$SELECT(M="STOP":"stop",1:"start")," date of the range of dates over which the cost data is to be",!,"changed. The start and stop dates may be the same day, effectively creating a one day change,"
+2 WRITE " but the stop date may not come before the start date.",!," Time is not entered.",!
QUIT
+3 ;
C1 ;
+1 SET OLDC=$SELECT($PIECE(OLD,"^",2):$PIECE(OLD,"^",3)/$PIECE(OLD,"^",2),1:"")_"^"_$SELECT($PIECE(OLD,"^",4):$PIECE(OLD,"^",5)/$PIECE(OLD,"^",4),1:"")
+2 SET ^PS(57.6,SD,1,W,1,P,1,DRG,0)=$PIECE(OLD,"^",1,2)_"^"_($PIECE(OLD,"^",2)*NC)_"^"_$PIECE(OLD,"^",4)_"^"_($PIECE(OLD,"^",4)*NC)_$SELECT($PIECE(OLD,"^",6,99)]"":"^"_$PIECE(OLD,"^",6,99),1:"")
SET ^PS(57.6,"ADCC",PSGDT,SD,W,P)=OLDC
QUIT
+3 ;
ENDEL ; delete cost data (completely!)
+1 SET PSGID=$ORDER(^PS(57.6,0))
IF 'PSGID
WRITE $CHAR(7),!!,"NO COST DATA FOUND TO DELETE."
GOTO DELOUT
+2 KILL %DT
SET PSGOD=$EXTRACT($$ENDTC^PSGMI(PSGID),1,8)
SET %DT="EXP"
SET Y=-1
FOR
READ !!,"Enter LIMIT DATE: ",X:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET X="^"
if "^"[X
QUIT
if X?1."?"
DO DELM
DO ^%DT
if X'?1."?"
QUIT
+3 if Y'>0
WRITE !?2,"No date chosen, or data deleted."
IF Y>0
WRITE !,"...a few moments, please..."
DO DELDC
if 'H
WRITE $CHAR(7),$CHAR(7),!,"No data found prior to date chosen!"
+4 ;
DELOUT ;
+1 KILL %DT,PSGID,PSGOD,Q,X,Y
QUIT
+2 ;
DELDC ;
+1 SET (F,H)=0
FOR X=0:0
SET X=$ORDER(^PS(57.6,X))
if 'X!(X>Y)
QUIT
KILL ^(X)
SET F=1
SET H=X
+2 FOR Q=0:0
SET Q=$ORDER(^PS(57.6,"ADCC",Q))
if 'Q
QUIT
FOR X=0:0
SET X=$ORDER(^PS(57.6,"ADCC",Q,X))
if 'X!(X>Y)
QUIT
KILL ^(X)
if $DATA(^PS(57.6,"ADCC",Q))<10
KILL ^(Q)
+3 QUIT
+4 ;
DELM ;
+1 WRITE !!?2,"ALL cost data for doses dispensed on or before the date selected will be",!,"completely deleted from the computer. The earliest date found is ",PSGOD,".",!!,"WARNING!! THIS DATA CANNOT BE REBUILT OR RECOMPILED!",!
QUIT
