- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPOID3 2058 printed Mar 13, 2025@21:38:31 Page 2
- 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
