PSSPOID3 ;BIR/RTR/WRT-Edit Orderable Item from matching option ;02/04/00
;;1.0;PHARMACY DATA MANAGEMENT;**38,47**;9/30/97
N DA,PSBEFORE,PSAFTER,PSINORDE,PSSDTENT,PSCREATE,PSAFTER,PSSDACTI,PSSSACTI,PSSAACTI,PSSDACT,PSSSACT,PSSAACT
S PSSDTENT=0 W ! K DIE N MFLG S PSBEFORE=$P(^PS(50.7,PSSOOIEN,0),"^",4),PSAFTER=0,PSINORDE="" D
.W !,"This Orderable Item is "_$S($P($G(^PS(50.7,PSSOOIEN,0)),"^",12):"Non-Formulary.",1:"Formulary."),!
.S DIE="^PS(50.7,",DA=PSSOOIEN,DR=6 S PSCREATE=1 D ^DIE K DIE,PSCREATE I $D(DTOUT)!($D(Y)) Q
.K DIR S DIR(0)="DO",DIR("A")="INACTIVE DATE" D D ^DIR K DIR I $G(Y)["^"!($D(DTOUT))!($G(DUOUT)) Q
..I $G(PSBEFORE) S Y=PSBEFORE D DD^%DT S DIR("B")=$G(Y)
.I $G(PSBEFORE),'$G(Y) W ?40,"Inactive Date deleted!"
.S PSSDTENT=$G(Y) I $G(Y) D DD^%DT W ?40,$G(Y)
.S PSSOTH=$S($P($G(^PS(59.7,1,40.2)),"^"):1,1:0)
.S DIE="^PS(50.7,",DA=PSSOOIEN,DR=".05;.06;.07;.08;7;S:'$G(PSSOTH) Y=""@1"";7.1;@1"
.S PSCREATE=1 D ^DIE K DIE,PSCREATE,PSSOTH
.S $P(^PS(50.7,PSSOOIEN,0),"^",4)=PSSDTENT,PSAFTER=PSSDTENT
S:PSBEFORE&('$P(^PS(50.7,PSSOOIEN,0),"^",4)) PSINORDE="D" S:$P(^PS(50.7,PSSOOIEN,0),"^",4) PSINORDE="I"
I PSINORDE'="" D CHECK^PSSPOID2(PSSOOIEN) D
.I PSINORDE="D" D Q
..I $O(PSSDACTI(0))!($O(PSSSACTI(0)))!($O(PSSAACTI(0))) D
...W !!,"There are inactive "_$S($O(PSSDACTI(0)):"drugs, ",1:"")_$S($O(PSSAACTI(0)):"additives, ",1:"")_$S($O(PSSSACTI(0)):"solutions,",1:""),!,"matched to this Pharmacy Orderable Item."
.I $O(PSSDACT(0))!($O(PSSSACT(0)))!($O(PSSAACT(0))) D
..W !!,"There are active "_$S($O(PSSDACT(0)):"drugs, ",1:"")_$S($O(PSSAACT(0)):"additives, ",1:"")_$S($O(PSSSACT(0)):"solutions,",1:""),!,"matched to this Pharmacy Orderable Item."
I $G(PSINORDE)="D" I $O(PSSDACTI(0))!($O(PSSSACTI(0)))!($O(PSSAACTI(0))) D REST^PSSPOIDT(PSSOOIEN)
I $G(PSINORDE)="I" I $O(PSSDACT(0))!($O(PSSSACT(0)))!($O(PSSAACT(0))) D REST^PSSPOIDT(PSSOOIEN)
S DIK="^PS(50.7,",DA=PSSOOIEN,DIK(1)=.04 D EN^DIK K DIK
K PSBEFORE,PSAFTER,PSINORDE,PSSDTENT,PSSDACT,PSSDACTI,PSSSACT,PSSSACTI,PSSAACT,PSSAACTI
Q
PSSPOID3 ;BIR/RTR/WRT-Edit Orderable Item from matching option ;02/04/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**38,47**;9/30/97
+2 NEW DA,PSBEFORE,PSAFTER,PSINORDE,PSSDTENT,PSCREATE,PSAFTER,PSSDACTI,PSSSACTI,PSSAACTI,PSSDACT,PSSSACT,PSSAACT
+3 SET PSSDTENT=0
WRITE !
KILL DIE
NEW MFLG
SET PSBEFORE=$PIECE(^PS(50.7,PSSOOIEN,0),"^",4)
SET PSAFTER=0
SET PSINORDE=""
Begin DoDot:1
+4 WRITE !,"This Orderable Item is "_$SELECT($PIECE($GET(^PS(50.7,PSSOOIEN,0)),"^",12):"Non-Formulary.",1:"Formulary."),!
+5 SET DIE="^PS(50.7,"
SET DA=PSSOOIEN
SET DR=6
SET PSCREATE=1
DO ^DIE
KILL DIE,PSCREATE
IF $DATA(DTOUT)!($DATA(Y))
QUIT
+6 KILL DIR
SET DIR(0)="DO"
SET DIR("A")="INACTIVE DATE"
Begin DoDot:2
+7 IF $GET(PSBEFORE)
SET Y=PSBEFORE
DO DD^%DT
SET DIR("B")=$GET(Y)
End DoDot:2
DO ^DIR
KILL DIR
IF $GET(Y)["^"!($DATA(DTOUT))!($GET(DUOUT))
QUIT
+8 IF $GET(PSBEFORE)
IF '$GET(Y)
WRITE ?40,"Inactive Date deleted!"
+9 SET PSSDTENT=$GET(Y)
IF $GET(Y)
DO DD^%DT
WRITE ?40,$GET(Y)
+10 SET PSSOTH=$SELECT($PIECE($GET(^PS(59.7,1,40.2)),"^"):1,1:0)
+11 SET DIE="^PS(50.7,"
SET DA=PSSOOIEN
SET DR=".05;.06;.07;.08;7;S:'$G(PSSOTH) Y=""@1"";7.1;@1"
+12 SET PSCREATE=1
DO ^DIE
KILL DIE,PSCREATE,PSSOTH
+13 SET $PIECE(^PS(50.7,PSSOOIEN,0),"^",4)=PSSDTENT
SET PSAFTER=PSSDTENT
End DoDot:1
+14 IF PSBEFORE&('$PIECE(^PS(50.7,PSSOOIEN,0),"^",4))
SET PSINORDE="D"
IF $PIECE(^PS(50.7,PSSOOIEN,0),"^",4)
SET PSINORDE="I"
+15 IF PSINORDE'=""
DO CHECK^PSSPOID2(PSSOOIEN)
Begin DoDot:1
+16 IF PSINORDE="D"
Begin DoDot:2
+17 IF $ORDER(PSSDACTI(0))!($ORDER(PSSSACTI(0)))!($ORDER(PSSAACTI(0)))
Begin DoDot:3
+18 WRITE !!,"There are inactive "_$SELECT($ORDER(PSSDACTI(0)):"drugs, ",1:"")_$SELECT($ORDER(PSSAACTI(0)):"additives, ",1:"")_$SELECT($ORDER(PSSSACTI(0)):"solutions,",1:""),!,"matched to this Pharmacy Orderable Item."
End DoDot:3
End DoDot:2
QUIT
+19 IF $ORDER(PSSDACT(0))!($ORDER(PSSSACT(0)))!($ORDER(PSSAACT(0)))
Begin DoDot:2
+20 WRITE !!,"There are active "_$SELECT($ORDER(PSSDACT(0)):"drugs, ",1:"")_$SELECT($ORDER(PSSAACT(0)):"additives, ",1:"")_$SELECT($ORDER(PSSSACT(0)):"solutions,",1:""),!,"matched to this Pharmacy Orderable Item."
End DoDot:2
End DoDot:1
+21 IF $GET(PSINORDE)="D"
IF $ORDER(PSSDACTI(0))!($ORDER(PSSSACTI(0)))!($ORDER(PSSAACTI(0)))
DO REST^PSSPOIDT(PSSOOIEN)
+22 IF $GET(PSINORDE)="I"
IF $ORDER(PSSDACT(0))!($ORDER(PSSSACT(0)))!($ORDER(PSSAACT(0)))
DO REST^PSSPOIDT(PSSOOIEN)
+23 SET DIK="^PS(50.7,"
SET DA=PSSOOIEN
SET DIK(1)=.04
DO EN^DIK
KILL DIK
+24 KILL PSBEFORE,PSAFTER,PSINORDE,PSSDTENT,PSSDACT,PSSDACTI,PSSSACT,PSSSACTI,PSSAACT,PSSAACTI
+25 QUIT
