- PSSPOIMO ;BIR/RTR/WRT-Edit Orderable Item Name and Inactive date ;05-Jun-2013 22:18;PLS
- ;;1.0;PHARMACY DATA MANAGEMENT;**29,32,38,47,68,102,125,141,1015**;9/30/97;Build 62
- ;Modified - IHS/MSC/PLS - 06/05/13 - Line IMMUN+2
- S PSSITE=+$O(^PS(59.7,0)) I +$P($G(^PS(59.7,PSSITE,80)),"^",2)<2 W !!?3,"Orderable Item Auto-Create has not been completed yet!",! K PSSITE K DIR S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR Q
- K PSSITE W !!,"This option enables you to edit Orderable Item names, Formulary status,",!,"drug text, Inactive Dates, and Synonyms."
- EN I $D(PSOIEN) L -^PS(50.7,PSOIEN)
- K PSSCROSS
- K DIC ; S PY=$P($G(^PS(59.7,1,31)),"^",2)
- S PSS1="W "" ""_$P(^PS(50.606,$P(^PS(50.7,+Y,0),""^"",2),0),""^"")_"" ""_$S($P($G(^PS(50.7,+Y,0)),""^"",4):$E($P(^(0),""^"",4),4,5)_""-""_$E($P(^(0),""^"",4),6,7)_""-""_$E($P(^(0),""^"",4),2,3),1:"""")"
- S PSS2=" S NF=$P($G(^PS(50.7,+Y,0)),""^"",12) I NF S NF="" N/F"" W NF"
- S DIC("W")=PSS1_PSS2,DIC("S")="I '$P($G(^PS(50.7,+Y,0)),""^"",3)"
- ;PSO*7*102;ONLY SEARCH B AND C X-REFS
- S $P(PLINE,"-",79)="" W !! K PSOUT S DIC="^PS(50.7,",DIC(0)="QEAMZ",D="B^C" D MIX^DIC1 K DIC,PY,D G:Y<0!($D(DTOUT))!($D(DUOUT)) END
- S PSOIEN=+Y,PSOINAME=$P(Y,"^",2),PSDOSE=+$P(^PS(50.7,PSOIEN,0),"^",2) L +^PS(50.7,PSOIEN):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T W !,$C(7),"Another person is editing this one." Q
- W !!!,?5,"Orderable Item -> ",PSOINAME,!?5,"Dosage Form -> ",$P($G(^PS(50.606,PSDOSE,0)),"^"),!
- ;I $P($G(^PS(50.7,PSOIEN,0)),"^",3) W !?3,"*** This Orderable Item is flagged for IV use! ***",!
- ;G:$P($G(^PS(50.7,PSOIEN,0)),"^",3) ADDIT
- K DIR S DIR("?")=" ",DIR("?",1)="Enter 'Yes' to see all of the Dispense Drugs, IV Additives, and IV Solutions",DIR("?",2)="that are matched to this Orderable Item. IV Additives will be identified with"
- S DIR("?",3)="an (A), and IV Solutions with an (S)."
- S DIR(0)="Y",DIR("B")="YES",DIR("A")="List all Drugs/Additives/Solutions tied to this Orderable Item" D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) G EN
- I Y D DISP
- EDIT K DIR W ! S DIR(0)="Y",DIR("A")="Are you sure you want to edit this Orderable Item",DIR("B")="NO",DIR("?")="Answer YES to edit the fields associated with this Orderable Item." D ^DIR K DIR I 'Y!($D(DTOUT))!($D(DUOUT)) G EN
- W !!?3,"Now editing Orderable Item:",!?3,PSOINAME," ",$P($G(^PS(50.606,PSDOSE,0)),"^")
- DIR K DIR S DIR(0)="F^3:40",DIR("B")=PSOINAME,DIR("A")="Orderable Item Name" D ^DIR
- I Y["^"!($D(DUOUT))!($D(DTOUT)) G EN
- I X[""""!($A(X)=45)!('(X'?1P.E))!(X?2"z".E) W $C(7),!!?5,"??" G DIR
- I X'=PSOINAME S ZZFLAG=0 D @$S('$P($G(^PS(50.7,PSOIEN,0)),"^",3):"CHECK",1:"ZCHECK") I ZZFLAG G DIR
- S PSONEW=X,DIE="^PS(50.7,",DA=PSOIEN,DR=".01////"_X D ^DIE I PSONEW'=PSOINAME W !!,"Name changed from ",PSOINAME,!?15,"to ",PSONEW
- ;I $P($G(^PS(59.7,1,20.4)),"^",16)=1,$P(^PS(50.7,PSOIEN,0),"^",3)=1,$P(^PS(50.7,PSOIEN,0),"^",11)="" D UDMSG K DIE S DIE="^PS(50.7,",DR="3",DA=PSOIEN D ^DIE
- ;I $P($G(^PS(59.7,1,20.4)),"^",16)=1,$P(^PS(50.7,PSOIEN,0),"^",3)'=1,$P(^PS(50.7,PSOIEN,0),"^",10)="" D IVMSG K DIE S DIE="^PS(50.7,",DR="4",DA=PSOIEN D ^DIE
- S PSSDTENT=0 W ! K DIE N MFLG S PSBEFORE=$P(^PS(50.7,PSOIEN,0),"^",4),PSAFTER=0,PSINORDE="" D
- .;If reactivate OI, prompt to reactivate DD's only if there are any, then always give message saying OI now Active. If Inactivate, prompt to inactivate any active DD's if there are any, and give message
- .;but if OI is reactivated, and there are no actitives matched to it, and user does not want to activate the drugs, then inactivate the OI again, and give a clear message explaining this.
- .W !,"This Orderable Item is "_$S($P($G(^PS(50.7,PSOIEN,0)),"^",12):"Non-Formulary.",1:"Formulary."),!
- .I $P($G(^PS(50.7,PSOIEN,0)),"^",10) W !,"This Orderable Item is marked as a Non-VA Med.",!
- .S DIE="^PS(50.7,",DA=PSOIEN,DR=6 S PSCREATE=1 D ^DIE K DIE,PSCREATE I $D(DTOUT)!($D(Y)) Q
- .;PSS*1*102;ADD DRUG TEXT AS SYNONYM IS REQUESTED BY USER
- .D ADDSYN^PSSPOIMP
- .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=PSOIEN,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,PSOIEN,0),"^",4)=PSSDTENT,PSAFTER=PSSDTENT
- S:PSBEFORE&('$P(^PS(50.7,PSOIEN,0),"^",4)) PSINORDE="D" S:$P(^PS(50.7,PSOIEN,0),"^",4) PSINORDE="I"
- I PSINORDE'="" D CHECK^PSSPOID2(PSOIEN) 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(PSOIEN)
- I $G(PSINORDE)="I" I $O(PSSDACT(0))!($O(PSSSACT(0)))!($O(PSSAACT(0))) D REST^PSSPOIDT(PSOIEN)
- S DIK="^PS(50.7,",DA=PSOIEN,DIK(1)=.04 D EN^DIK K DIK
- K PSBEFORE,PSAFTER,PSINORDE,PSSDTENT,PSSDACT,PSSDACTI,PSSSACT,PSSSACTI,PSSAACT,PSSAACTI
- IMMUN ;PSS*1*141 FOR 'IMMUNIZATIONS DOCUMENTATION BY BCMA'
- I $O(^PSDRUG("AOC",PSOIEN,"IM000"))'["IM" G SYN ;ASK WHEN APPROPRIATE
- ;W ! S DIE="^PS(50.7,",DA=PSOIEN,DR=9 D ^DIE K DIE ;IHS/MSC/PLS - 06/05/13 - Commented out per IHS
- SYN W ! K DIC S:'$D(^PS(50.7,PSOIEN,2,0)) ^PS(50.7,PSOIEN,2,0)="^50.72^0^0" S DIC="^PS(50.7,"_PSOIEN_",2,",DA(1)=PSOIEN,DIC(0)="QEAMZL",DIC("A")="Select SYNONYM: ",DLAYGO=50.72 D ^DIC K DIC
- I Y<0!($D(DUOUT))!($D(DTOUT)) K:'$O(^PS(50.7,PSOIEN,2,0)) ^PS(50.7,PSOIEN,2,0) D EN^PSSPOIDT(PSOIEN),EN2^PSSHL1(PSOIEN,"MUP") G EN
- W ! S DA=+Y,DIE="^PS(50.7,"_PSOIEN_",2,",DA(1)=PSOIEN,DR=.01 D ^DIE K DIE G SYN
- D EN^PSSPOIDT(PSOIEN),EN2^PSSHL1(PSOIEN,"MUP")
- G EN
- END K ZZFLAG,DIC,DIR,DIE,DTOUT,DUOUT,FLAG,PSOINAME,PSOUT,PSDOSE,PSONEW,UPFLAG,VV,ZZ,AA,BB,Y,AAA,SSS,PSOARR,PSOARRAD,PLINE I $D(PSOIEN) L -^PS(50.7,PSOIEN) K PSOIEN
- Q
- DISP N PSSLFLAG,PSSLDATE S FLAG=1 D HEAD F ZZ=0:0 S ZZ=$O(^PSDRUG("ASP",PSOIEN,ZZ)) Q:'ZZ!($G(PSOUT)) S FLAG=0 D:($Y+5)>IOSL HEAD Q:$G(PSOUT) I ZZ W !,$P($G(^PSDRUG(ZZ,0)),"^") W:$P($G(^PSDRUG(ZZ,0)),"^",9) " N/F" D DTE
- Q:$G(PSOUT)
- S (FLAG,PSSLFLAG)=0
- F ZZ=0:0 S ZZ=$O(^PS(52.6,"AOI",PSOIEN,ZZ)) Q:'ZZ!($G(PSOUT)) D:($Y+5)>IOSL HEAD Q:$G(PSOUT) I ZZ D
- .S PSSLFLAG=1
- .W !,$P($G(^PS(52.6,ZZ,0)),"^"),?42,"(A)"
- .S PSSLDATE=$P($G(^PS(52.6,ZZ,"I")),"^") I PSSLDATE D DTEX
- Q:$G(PSOUT)
- ;I $G(PSSLFLAG) W !
- F ZZ=0:0 S ZZ=$O(^PS(52.7,"AOI",PSOIEN,ZZ)) Q:'ZZ!($G(PSOUT)) D:($Y+5)>IOSL HEAD Q:$G(PSOUT) I ZZ D
- .W !,$P($G(^PS(52.7,ZZ,0)),"^"),?31,$P($G(^(0)),"^",3),?42,"(S)"
- .S PSSLDATE=$P($G(^PS(52.7,ZZ,"I")),"^") I PSSLDATE D DTEX
- Q
- HEAD I 'FLAG W ! K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR I 'Y S PSOUT=1 Q
- W @IOF W !,?6,"Orderable Item -> ",PSOINAME,!?6,"Dosage Form -> ",$P($G(^PS(50.606,+$P($G(^PS(50.7,PSOIEN,0)),"^",2),0)),"^"),!!,"Dispense Drugs:"_$S('FLAG:" (continued)",1:""),!,"---------------"
- Q
- ADDIT ;If orderable item is flagged for IV
- S AA=$O(^PS(52.6,"AOI",PSOIEN,0))
- S BB=$O(^PS(52.7,"AOI",PSOIEN,0))
- I 'AA,'BB W $C(7),!,"This Orderable Item is flagged for IV use, but currently there are no IV",!,"Additives or IV Solutions matched to this Orderable Item!" G EDIT
- G SOL
- CHECK ;
- S ZZFLAG=0 F VV=0:0 S VV=$O(^PS(50.7,"ADF",X,PSDOSE,VV)) Q:'VV I VV,'$P($G(^PS(50.7,VV,0)),"^",3) S ZZFLAG=1
- I ZZFLAG W $C(7),!!?5,"There is already an Orderable Item with this same name and Dosage Form",!?5,"that is not flagged as 'IV'. Use the 'DISPENSE DRUG/ORDERABLE ITEM",!?5,"MAINTENANCE' option if you want to re-match to this Orderable Item!",!
- Q
- ZCHECK ;
- S ZZFLAG=0 F VV=0:0 S VV=$O(^PS(50.7,"ADF",X,PSDOSE,VV)) Q:'VV I VV,$P($G(^PS(50.7,VV,0)),"^",3) S ZZFLAG=1
- I ZZFLAG W $C(7),!!?5,"There is already an Orderable Item with the same name and Dosage Form,",!?5,"that is flagged for 'IV' use.",!
- Q
- SOL ;
- K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="List all Additives and Solutions tied to this Orderable Item" D ^DIR K DIR G:Y["^"!($D(DTOUT)) EN G:Y=0 EDIT
- H 1 K PSOARR,PSOARRAD S AAA=$O(^PS(52.6,"AOI",PSOIEN,0)) I AAA,$D(^PS(52.6,AAA,0)) S PSOARRAD=AAA
- F SSS=0:0 S SSS=$O(^PS(52.7,"AOI",PSOIEN,SSS)) Q:'SSS S:$D(^PS(52.7,SSS,0)) PSOARR(SSS)=""
- S FLAG=1,UPFLAG=0 D SHEAD F ZZ=0:0 S ZZ=$O(PSOARR(ZZ)) Q:'ZZ!($G(PSOUT))!($G(UPFLAG)) S FLAG=0 D:($Y+7)>IOSL SHEAD Q:$G(PSOUT)!($G(UPFLAG)) I ZZ W !,$P($G(^PS(52.7,ZZ,0)),"^")," ",$P($G(^(0)),"^",3)
- G:$G(PSOUT) EN
- G EDIT
- SHEAD I 'FLAG W ! K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR I 'Y S:Y="" PSOUT=1 S:Y=0 UPFLAG=1 Q
- W @IOF W !?6,"Orderable Item -> ",PSOINAME,?68,"(IV)",!?6,"Dosage Form -> ",$P($G(^PS(50.606,+$P($G(^PS(50.7,PSOIEN,0)),"^",2),0)),"^"),!,PLINE I FLAG,'$G(PSOARRAD) W !?5,"IV Solutions:",!
- I 'FLAG W !?5,"IV Solutions:",!
- I FLAG,$G(PSOARRAD) W !,$P($G(^PS(52.6,PSOARRAD,0)),"^")," ","(IV Additive)",! I $D(PSOARR) W !?5,"IV Solutions:",!
- Q
- DTE I $D(^PSDRUG(ZZ,"I")) S Y=$P(^PSDRUG(ZZ,"I"),"^") D DD^%DT W ?50,Y K Y
- Q
- DTEX S Y=$G(PSSLDATE) D DD^%DT W ?50,$G(Y) K Y
- Q
- IVMSG ; display a message if the CORRESPONDING IV field is entered
- ;
- S PSSIVMSG=$P(^PS(50.7,PSOIEN,0),"^",11) I PSSIVMSG="" Q
- S PSSIVFRM=$P(^PS(50.7,PSSIVMSG,0),"^",2) I PSSIVFRM S PSSIVFRM=$P(^PS(50.606,PSSIVFRM,0),"^")
- S PSSIVMSG=$P(^PS(50.7,PSSIVMSG,0),"^")_" "_PSSIVFRM
- W !!,"The Corresponding IV Item is currently identified as: "_PSSIVMSG,!
- K PSSIVFRM,PSSIVMSG
- Q
- UDMSG ; display a message if the CORRESPONDING UD field is entered
- ;
- S PSSUDMSG=$P(^PS(50.7,PSOIEN,0),"^",10) I PSSUDMSG="" Q
- S PSSUDFRM=$P(^PS(50.7,PSSUDMSG,0),"^",2) I PSSUDFRM S PSSUDFRM=$P(^PS(50.606,PSSUDFRM,0),"^")
- S PSSUDMSG=$P(^PS(50.7,PSSUDMSG,0),"^")_" "_PSSUDFRM
- W !!,"The Corresponding UD Item is currently identified as: "_PSSUDMSG,!
- K PSSUDMSG,PSSUDFRM
- Q
- PSSPOIMO ;BIR/RTR/WRT-Edit Orderable Item Name and Inactive date ;05-Jun-2013 22:18;PLS
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**29,32,38,47,68,102,125,141,1015**;9/30/97;Build 62
- +2 ;Modified - IHS/MSC/PLS - 06/05/13 - Line IMMUN+2
- +3 SET PSSITE=+$ORDER(^PS(59.7,0))
- IF +$PIECE($GET(^PS(59.7,PSSITE,80)),"^",2)<2
- WRITE !!?3,"Orderable Item Auto-Create has not been completed yet!",!
- KILL PSSITE
- KILL DIR
- SET DIR("A")="Press RETURN to continue"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +4 KILL PSSITE
- WRITE !!,"This option enables you to edit Orderable Item names, Formulary status,",!,"drug text, Inactive Dates, and Synonyms."
- EN IF $DATA(PSOIEN)
- LOCK -^PS(50.7,PSOIEN)
- +1 KILL PSSCROSS
- +2 ; S PY=$P($G(^PS(59.7,1,31)),"^",2)
- KILL DIC
- +3 SET PSS1="W "" ""_$P(^PS(50.606,$P(^PS(50.7,+Y,0),""^"",2),0),""^"")_"" ""_$S($P($G(^PS(50.7,+Y,0)),""^"",4):$E($P(^(0),""^"",4),4,5)_""-""_$E($P(^(0),""^"",4),6,7)_""-""_$E($P(^(0),""^"",4),2,3),1:"""")"
- +4 SET PSS2=" S NF=$P($G(^PS(50.7,+Y,0)),""^"",12) I NF S NF="" N/F"" W NF"
- +5 SET DIC("W")=PSS1_PSS2
- SET DIC("S")="I '$P($G(^PS(50.7,+Y,0)),""^"",3)"
- +6 ;PSO*7*102;ONLY SEARCH B AND C X-REFS
- +7 SET $PIECE(PLINE,"-",79)=""
- WRITE !!
- KILL PSOUT
- SET DIC="^PS(50.7,"
- SET DIC(0)="QEAMZ"
- SET D="B^C"
- DO MIX^DIC1
- KILL DIC,PY,D
- IF Y<0!($DATA(DTOUT))!($DATA(DUOUT))
- GOTO END
- +8 SET PSOIEN=+Y
- SET PSOINAME=$PIECE(Y,"^",2)
- SET PSDOSE=+$PIECE(^PS(50.7,PSOIEN,0),"^",2)
- LOCK +^PS(50.7,PSOIEN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
- IF '$TEST
- WRITE !,$CHAR(7),"Another person is editing this one."
- QUIT
- +9 WRITE !!!,?5,"Orderable Item -> ",PSOINAME,!?5,"Dosage Form -> ",$PIECE($GET(^PS(50.606,PSDOSE,0)),"^"),!
- +10 ;I $P($G(^PS(50.7,PSOIEN,0)),"^",3) W !?3,"*** This Orderable Item is flagged for IV use! ***",!
- +11 ;G:$P($G(^PS(50.7,PSOIEN,0)),"^",3) ADDIT
- +12 KILL DIR
- SET DIR("?")=" "
- SET DIR("?",1)="Enter 'Yes' to see all of the Dispense Drugs, IV Additives, and IV Solutions"
- SET DIR("?",2)="that are matched to this Orderable Item. IV Additives will be identified with"
- +13 SET DIR("?",3)="an (A), and IV Solutions with an (S)."
- +14 SET DIR(0)="Y"
- SET DIR("B")="YES"
- SET DIR("A")="List all Drugs/Additives/Solutions tied to this Orderable Item"
- DO ^DIR
- KILL DIR
- IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
- GOTO EN
- +15 IF Y
- DO DISP
- EDIT KILL DIR
- WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="Are you sure you want to edit this Orderable Item"
- SET DIR("B")="NO"
- SET DIR("?")="Answer YES to edit the fields associated with this Orderable Item."
- DO ^DIR
- KILL DIR
- IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))
- GOTO EN
- +1 WRITE !!?3,"Now editing Orderable Item:",!?3,PSOINAME," ",$PIECE($GET(^PS(50.606,PSDOSE,0)),"^")
- DIR KILL DIR
- SET DIR(0)="F^3:40"
- SET DIR("B")=PSOINAME
- SET DIR("A")="Orderable Item Name"
- DO ^DIR
- +1 IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
- GOTO EN
- +2 IF X[""""!($ASCII(X)=45)!('(X'?1P.E))!(X?2"z".E)
- WRITE $CHAR(7),!!?5,"??"
- GOTO DIR
- +3 IF X'=PSOINAME
- SET ZZFLAG=0
- DO @$SELECT('$PIECE($GET(^PS(50.7,PSOIEN,0)),"^",3):"CHECK",1:"ZCHECK")
- IF ZZFLAG
- GOTO DIR
- +4 SET PSONEW=X
- SET DIE="^PS(50.7,"
- SET DA=PSOIEN
- SET DR=".01////"_X
- DO ^DIE
- IF PSONEW'=PSOINAME
- WRITE !!,"Name changed from ",PSOINAME,!?15,"to ",PSONEW
- +5 ;I $P($G(^PS(59.7,1,20.4)),"^",16)=1,$P(^PS(50.7,PSOIEN,0),"^",3)=1,$P(^PS(50.7,PSOIEN,0),"^",11)="" D UDMSG K DIE S DIE="^PS(50.7,",DR="3",DA=PSOIEN D ^DIE
- +6 ;I $P($G(^PS(59.7,1,20.4)),"^",16)=1,$P(^PS(50.7,PSOIEN,0),"^",3)'=1,$P(^PS(50.7,PSOIEN,0),"^",10)="" D IVMSG K DIE S DIE="^PS(50.7,",DR="4",DA=PSOIEN D ^DIE
- +7 SET PSSDTENT=0
- WRITE !
- KILL DIE
- NEW MFLG
- SET PSBEFORE=$PIECE(^PS(50.7,PSOIEN,0),"^",4)
- SET PSAFTER=0
- SET PSINORDE=""
- Begin DoDot:1
- +8 ;If reactivate OI, prompt to reactivate DD's only if there are any, then always give message saying OI now Active. If Inactivate, prompt to inactivate any active DD's if there are any, and give message
- +9 ;but if OI is reactivated, and there are no actitives matched to it, and user does not want to activate the drugs, then inactivate the OI again, and give a clear message explaining this.
- +10 WRITE !,"This Orderable Item is "_$SELECT($PIECE($GET(^PS(50.7,PSOIEN,0)),"^",12):"Non-Formulary.",1:"Formulary."),!
- +11 IF $PIECE($GET(^PS(50.7,PSOIEN,0)),"^",10)
- WRITE !,"This Orderable Item is marked as a Non-VA Med.",!
- +12 SET DIE="^PS(50.7,"
- SET DA=PSOIEN
- SET DR=6
- SET PSCREATE=1
- DO ^DIE
- KILL DIE,PSCREATE
- IF $DATA(DTOUT)!($DATA(Y))
- QUIT
- +13 ;PSS*1*102;ADD DRUG TEXT AS SYNONYM IS REQUESTED BY USER
- +14 DO ADDSYN^PSSPOIMP
- +15 KILL DIR
- SET DIR(0)="DO"
- SET DIR("A")="INACTIVE DATE"
- Begin DoDot:2
- +16 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
- +17 IF $GET(PSBEFORE)
- IF '$GET(Y)
- WRITE ?40,"Inactive Date deleted!"
- +18 SET PSSDTENT=$GET(Y)
- IF $GET(Y)
- DO DD^%DT
- WRITE ?40,$GET(Y)
- +19 SET PSSOTH=$SELECT($PIECE($GET(^PS(59.7,1,40.2)),"^"):1,1:0)
- +20 SET DIE="^PS(50.7,"
- SET DA=PSOIEN
- SET DR=".05;.06;.07;.08;7;S:'$G(PSSOTH) Y=""@1"";7.1;@1"
- +21 SET PSCREATE=1
- DO ^DIE
- KILL DIE,PSCREATE,PSSOTH
- +22 SET $PIECE(^PS(50.7,PSOIEN,0),"^",4)=PSSDTENT
- SET PSAFTER=PSSDTENT
- End DoDot:1
- +23 IF PSBEFORE&('$PIECE(^PS(50.7,PSOIEN,0),"^",4))
- SET PSINORDE="D"
- IF $PIECE(^PS(50.7,PSOIEN,0),"^",4)
- SET PSINORDE="I"
- +24 IF PSINORDE'=""
- DO CHECK^PSSPOID2(PSOIEN)
- Begin DoDot:1
- +25 IF PSINORDE="D"
- Begin DoDot:2
- +26 IF $ORDER(PSSDACTI(0))!($ORDER(PSSSACTI(0)))!($ORDER(PSSAACTI(0)))
- Begin DoDot:3
- +27 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
- +28 IF $ORDER(PSSDACT(0))!($ORDER(PSSSACT(0)))!($ORDER(PSSAACT(0)))
- Begin DoDot:2
- +29 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
- +30 IF $GET(PSINORDE)="D"
- IF $ORDER(PSSDACTI(0))!($ORDER(PSSSACTI(0)))!($ORDER(PSSAACTI(0)))
- DO REST^PSSPOIDT(PSOIEN)
- +31 IF $GET(PSINORDE)="I"
- IF $ORDER(PSSDACT(0))!($ORDER(PSSSACT(0)))!($ORDER(PSSAACT(0)))
- DO REST^PSSPOIDT(PSOIEN)
- +32 SET DIK="^PS(50.7,"
- SET DA=PSOIEN
- SET DIK(1)=.04
- DO EN^DIK
- KILL DIK
- +33 KILL PSBEFORE,PSAFTER,PSINORDE,PSSDTENT,PSSDACT,PSSDACTI,PSSSACT,PSSSACTI,PSSAACT,PSSAACTI
- IMMUN ;PSS*1*141 FOR 'IMMUNIZATIONS DOCUMENTATION BY BCMA'
- +1 ;ASK WHEN APPROPRIATE
- IF $ORDER(^PSDRUG("AOC",PSOIEN,"IM000"))'["IM"
- GOTO SYN
- +2 ;W ! S DIE="^PS(50.7,",DA=PSOIEN,DR=9 D ^DIE K DIE ;IHS/MSC/PLS - 06/05/13 - Commented out per IHS
- SYN WRITE !
- KILL DIC
- IF '$DATA(^PS(50.7,PSOIEN,2,0))
- SET ^PS(50.7,PSOIEN,2,0)="^50.72^0^0"
- SET DIC="^PS(50.7,"_PSOIEN_",2,"
- SET DA(1)=PSOIEN
- SET DIC(0)="QEAMZL"
- SET DIC("A")="Select SYNONYM: "
- SET DLAYGO=50.72
- DO ^DIC
- KILL DIC
- +1 IF Y<0!($DATA(DUOUT))!($DATA(DTOUT))
- IF '$ORDER(^PS(50.7,PSOIEN,2,0))
- KILL ^PS(50.7,PSOIEN,2,0)
- DO EN^PSSPOIDT(PSOIEN)
- DO EN2^PSSHL1(PSOIEN,"MUP")
- GOTO EN
- +2 WRITE !
- SET DA=+Y
- SET DIE="^PS(50.7,"_PSOIEN_",2,"
- SET DA(1)=PSOIEN
- SET DR=.01
- DO ^DIE
- KILL DIE
- GOTO SYN
- +3 DO EN^PSSPOIDT(PSOIEN)
- DO EN2^PSSHL1(PSOIEN,"MUP")
- +4 GOTO EN
- END KILL ZZFLAG,DIC,DIR,DIE,DTOUT,DUOUT,FLAG,PSOINAME,PSOUT,PSDOSE,PSONEW,UPFLAG,VV,ZZ,AA,BB,Y,AAA,SSS,PSOARR,PSOARRAD,PLINE
- IF $DATA(PSOIEN)
- LOCK -^PS(50.7,PSOIEN)
- KILL PSOIEN
- +1 QUIT
- DISP NEW PSSLFLAG,PSSLDATE
- SET FLAG=1
- DO HEAD
- FOR ZZ=0:0
- SET ZZ=$ORDER(^PSDRUG("ASP",PSOIEN,ZZ))
- IF 'ZZ!($GET(PSOUT))
- QUIT
- SET FLAG=0
- IF ($Y+5)>IOSL
- DO HEAD
- IF $GET(PSOUT)
- QUIT
- IF ZZ
- WRITE !,$PIECE($GET(^PSDRUG(ZZ,0)),"^")
- IF $PIECE($GET(^PSDRUG(ZZ,0)),"^",9)
- WRITE " N/F"
- DO DTE
- +1 IF $GET(PSOUT)
- QUIT
- +2 SET (FLAG,PSSLFLAG)=0
- +3 FOR ZZ=0:0
- SET ZZ=$ORDER(^PS(52.6,"AOI",PSOIEN,ZZ))
- IF 'ZZ!($GET(PSOUT))
- QUIT
- IF ($Y+5)>IOSL
- DO HEAD
- IF $GET(PSOUT)
- QUIT
- IF ZZ
- Begin DoDot:1
- +4 SET PSSLFLAG=1
- +5 WRITE !,$PIECE($GET(^PS(52.6,ZZ,0)),"^"),?42,"(A)"
- +6 SET PSSLDATE=$PIECE($GET(^PS(52.6,ZZ,"I")),"^")
- IF PSSLDATE
- DO DTEX
- End DoDot:1
- +7 IF $GET(PSOUT)
- QUIT
- +8 ;I $G(PSSLFLAG) W !
- +9 FOR ZZ=0:0
- SET ZZ=$ORDER(^PS(52.7,"AOI",PSOIEN,ZZ))
- IF 'ZZ!($GET(PSOUT))
- QUIT
- IF ($Y+5)>IOSL
- DO HEAD
- IF $GET(PSOUT)
- QUIT
- IF ZZ
- Begin DoDot:1
- +10 WRITE !,$PIECE($GET(^PS(52.7,ZZ,0)),"^"),?31,$PIECE($GET(^(0)),"^",3),?42,"(S)"
- +11 SET PSSLDATE=$PIECE($GET(^PS(52.7,ZZ,"I")),"^")
- IF PSSLDATE
- DO DTEX
- End DoDot:1
- +12 QUIT
- HEAD IF 'FLAG
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSOUT=1
- QUIT
- +1 WRITE @IOF
- WRITE !,?6,"Orderable Item -> ",PSOINAME,!?6,"Dosage Form -> ",$PIECE($GET(^PS(50.606,+$PIECE($GET(^PS(50.7,PSOIEN,0)),"^",2),0)),"^"),!!,"Dispense Drugs:"_$SELECT('FLAG:" (continued)",1:""),!,"---------------"
- +2 QUIT
- ADDIT ;If orderable item is flagged for IV
- +1 SET AA=$ORDER(^PS(52.6,"AOI",PSOIEN,0))
- +2 SET BB=$ORDER(^PS(52.7,"AOI",PSOIEN,0))
- +3 IF 'AA
- IF 'BB
- WRITE $CHAR(7),!,"This Orderable Item is flagged for IV use, but currently there are no IV",!,"Additives or IV Solutions matched to this Orderable Item!"
- GOTO EDIT
- +4 GOTO SOL
- CHECK ;
- +1 SET ZZFLAG=0
- FOR VV=0:0
- SET VV=$ORDER(^PS(50.7,"ADF",X,PSDOSE,VV))
- IF 'VV
- QUIT
- IF VV
- IF '$PIECE($GET(^PS(50.7,VV,0)),"^",3)
- SET ZZFLAG=1
- +2 IF ZZFLAG
- WRITE $CHAR(7),!!?5,"There is already an Orderable Item with this same name and Dosage Form",!?5,"that is not flagged as 'IV'. Use the 'DISPENSE DRUG/ORDERABLE ITEM",!?5,"MAINTENANCE' option if you want to re-match to this Orderable Item!",
- !
- +3 QUIT
- ZCHECK ;
- +1 SET ZZFLAG=0
- FOR VV=0:0
- SET VV=$ORDER(^PS(50.7,"ADF",X,PSDOSE,VV))
- IF 'VV
- QUIT
- IF VV
- IF $PIECE($GET(^PS(50.7,VV,0)),"^",3)
- SET ZZFLAG=1
- +2 IF ZZFLAG
- WRITE $CHAR(7),!!?5,"There is already an Orderable Item with the same name and Dosage Form,",!?5,"that is flagged for 'IV' use.",!
- +3 QUIT
- SOL ;
- +1 KILL DIR
- SET DIR(0)="Y"
- SET DIR("B")="YES"
- SET DIR("A")="List all Additives and Solutions tied to this Orderable Item"
- DO ^DIR
- KILL DIR
- IF Y["^"!($DATA(DTOUT))
- GOTO EN
- IF Y=0
- GOTO EDIT
- +2 HANG 1
- KILL PSOARR,PSOARRAD
- SET AAA=$ORDER(^PS(52.6,"AOI",PSOIEN,0))
- IF AAA
- IF $DATA(^PS(52.6,AAA,0))
- SET PSOARRAD=AAA
- +3 FOR SSS=0:0
- SET SSS=$ORDER(^PS(52.7,"AOI",PSOIEN,SSS))
- IF 'SSS
- QUIT
- IF $DATA(^PS(52.7,SSS,0))
- SET PSOARR(SSS)=""
- +4 SET FLAG=1
- SET UPFLAG=0
- DO SHEAD
- FOR ZZ=0:0
- SET ZZ=$ORDER(PSOARR(ZZ))
- IF 'ZZ!($GET(PSOUT))!($GET(UPFLAG))
- QUIT
- SET FLAG=0
- IF ($Y+7)>IOSL
- DO SHEAD
- IF $GET(PSOUT)!($GET(UPFLAG))
- QUIT
- IF ZZ
- WRITE !,$PIECE($GET(^PS(52.7,ZZ,0)),"^")," ",$PIECE($GET(^(0)),"^",3)
- +5 IF $GET(PSOUT)
- GOTO EN
- +6 GOTO EDIT
- SHEAD IF 'FLAG
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue"
- DO ^DIR
- KILL DIR
- IF 'Y
- IF Y=""
- SET PSOUT=1
- IF Y=0
- SET UPFLAG=1
- QUIT
- +1 WRITE @IOF
- WRITE !?6,"Orderable Item -> ",PSOINAME,?68,"(IV)",!?6,"Dosage Form -> ",$PIECE($GET(^PS(50.606,+$PIECE($GET(^PS(50.7,PSOIEN,0)),"^",2),0)),"^"),!,PLINE
- IF FLAG
- IF '$GET(PSOARRAD)
- WRITE !?5,"IV Solutions:",!
- +2 IF 'FLAG
- WRITE !?5,"IV Solutions:",!
- +3 IF FLAG
- IF $GET(PSOARRAD)
- WRITE !,$PIECE($GET(^PS(52.6,PSOARRAD,0)),"^")," ","(IV Additive)",!
- IF $DATA(PSOARR)
- WRITE !?5,"IV Solutions:",!
- +4 QUIT
- DTE IF $DATA(^PSDRUG(ZZ,"I"))
- SET Y=$PIECE(^PSDRUG(ZZ,"I"),"^")
- DO DD^%DT
- WRITE ?50,Y
- KILL Y
- +1 QUIT
- DTEX SET Y=$GET(PSSLDATE)
- DO DD^%DT
- WRITE ?50,$GET(Y)
- KILL Y
- +1 QUIT
- IVMSG ; display a message if the CORRESPONDING IV field is entered
- +1 ;
- +2 SET PSSIVMSG=$PIECE(^PS(50.7,PSOIEN,0),"^",11)
- IF PSSIVMSG=""
- QUIT
- +3 SET PSSIVFRM=$PIECE(^PS(50.7,PSSIVMSG,0),"^",2)
- IF PSSIVFRM
- SET PSSIVFRM=$PIECE(^PS(50.606,PSSIVFRM,0),"^")
- +4 SET PSSIVMSG=$PIECE(^PS(50.7,PSSIVMSG,0),"^")_" "_PSSIVFRM
- +5 WRITE !!,"The Corresponding IV Item is currently identified as: "_PSSIVMSG,!
- +6 KILL PSSIVFRM,PSSIVMSG
- +7 QUIT
- UDMSG ; display a message if the CORRESPONDING UD field is entered
- +1 ;
- +2 SET PSSUDMSG=$PIECE(^PS(50.7,PSOIEN,0),"^",10)
- IF PSSUDMSG=""
- QUIT
- +3 SET PSSUDFRM=$PIECE(^PS(50.7,PSSUDMSG,0),"^",2)
- IF PSSUDFRM
- SET PSSUDFRM=$PIECE(^PS(50.606,PSSUDFRM,0),"^")
- +4 SET PSSUDMSG=$PIECE(^PS(50.7,PSSUDMSG,0),"^")_" "_PSSUDFRM
- +5 WRITE !!,"The Corresponding UD Item is currently identified as: "_PSSUDMSG,!
- +6 KILL PSSUDMSG,PSSUDFRM
- +7 QUIT
