APSPMULT ;IHS/MSC/JDS - Multidivisional drug lookup support;07-Mar-2011 15:06;SM
;;7.0;IHS PHARMACY MODIFICATION;**1009,1010**;DEC 11, 2003
;
PRINT ;EP
N PDIV
S DIC="^PS(59,",DIC(0)="MEQA" D ^DIC Q:Y'>0 S PDIV=+Y
S DIS(1)="I $$PRTSCRN^APSPMULT(D0,PDIV)"
S DIC="^PSDRUG(",FLDS="[APSPMULTI]",BY=".01",DIPA("NUM")=1 D EN1^DIP
Q
SCREEN(IEN,NEWSITE,ALWAYS) ;EP
N DICR,DIVAL,PAT
I '$G(ALWAYS) I $P($G(XQY0),U)="" Q 1 ;only for OR and PS options.
;S DFN=$G(DFN,$S($T(GETVAR^CIAVMEVT)]"":$$GETVAR^CIAVMEVT("PATIENT.ID.MRN",,"CONTEXT.PATIENT"),1:""))
S PAT=$S($G(PSODFN):PSODFN,$G(DFN):DFN,$G(CIA("UID"))&($T(GETVAR^CIAVMEVT)]""):$$GETVAR^CIAVMEVT("PATIENT.ID.MRN",,"CONTEXT.PATIENT"),1:0)
I $G(APSPMULT) Q 1 ;dont screen.
I '$G(ALWAYS) I '$$GET^XPAR("ALL","APSP MULTI DRUG SCREEN OPTION",$P(XQY0,U)) Q 1
N SITE I $G(PSOSITE) S SITE=PSOSITE
I $G(NEWSITE) S SITE=NEWSITE
I '$G(SITE) S SITE=$O(^PS(59,"D",+$G(DUZ(2)),"")) Q:'SITE 1
I PAT,$P($G(^APSPCTRL(+$G(SITE,1),3)),U,21) I '$$ELIG(PAT,$P($G(^PSDRUG(IEN,9999999)),U,7)) Q 0 ;not on cost plan
I '$$GET^XPAR("ALL","APSP RESTRICT DRUG BY OPT SITE") Q 1
I '$O(^PSDRUG(IEN,9999999.41,0)) Q 1
I $D(^PSDRUG(IEN,9999999.41,SITE)) Q 1
Q 0
; Screen used for Division Report
PRTSCRN(DRUG,PDIV) ;EP
Q ''$D(^PSDRUG(DRUG,9999999.41,PDIV))
ELIG(DFN,DRUGELIG) ;
;is this patient eligible for alternate cost plan.
N ELIG
I DRUGELIG="" Q 1
S ELIG=$P($G(^AUPNPAT(+$G(DFN),11)),U,12) I ELIG="" Q 0
I "I"=ELIG,DRUGELIG=1 Q 1
I (DRUGELIG=0)&("DCP"[ELIG) Q 1
Q 0
ALL ;postinit make all drugs alternate care plan
K ^TMP("MSCPS",$J)
F I=0:0 S I=$O(^PSDRUG(I)) Q:'I S ^TMP("MSCPS",$J,50,I_",",9999999.07)=1
D FILE^DIE("","^TMP(""MSCPS"",$J)")
K ^TMP("MSCPS",$J)
Q
TRANSFER ;Transfer from one division to other
N DIC,TO,FROM,I,DINUM,%,CNT
S DIC="^PS(59,",DIC(0)="MEQA",DIC("A")="Select FROM-> Site: " D ^DIC Q:Y'>0 S FROM=+Y
S DIC="^PS(59,",DIC(0)="MEQA",DIC("A")="Select ->TO Site: ",DIC("S")="I FROM'=+Y" D ^DIC Q:Y'>0
S TO=+Y,CNT=0
W !,"Ok to continue" D YN^DICN Q:%'=1
F I=0:0 S I=$O(^PSDRUG(I)) Q:'I D
.I '$D(^PSDRUG(I,9999999.41,FROM)) Q
.I $D(^PSDRUG(I,9999999.41,TO)) Q
.S DIC="^PSDRUG("_I_",9999999.41,",DIC(0)="LMN",X=TO,DA(1)=I,DINUM=TO N I D FILE^DICN S CNT=CNT+1
W !,CNT," Drugs put in outpatient site"
Q
PRATL(TRUE) ;ALTERNATE LIST
N DHD
S DIS(1)="I $P($G(^PSDRUG(+Y,9999999)),U,7)"_$S(TRUE:"=0",1:"=1")
S DHD="Drugs Designated for Patients with "_$S(TRUE:"",1:"In")_"Eligible Status"
S DIC="^PSDRUG(",FLDS="[APSPALT]",BY=".01",DIPA("NUM")=1,L=0 D EN1^DIP
Q
REPT ;
N DHD
S %DT="AE",%DT("A")="Enter Report Month: " D ^%DT Q:Y'>0 S STDT=$E(Y,1,5)_"00",ENDT=$E(Y,1,5)_32
S X=STDT X ^DD("DD") S MONTH=Y
S DIR(0)="S^0:Eligible;1:InEligible",DIR("A")="Select Eligible/Ineligible" D ^DIR Q:X[U S ELIG=+$G(Y)
S DIC="^PSDRUG(",BY="@NUMBER",(FR,TO)=$O(^PSDRUG(0)),FLDS="D DEQUE^APSPMULT",DHD="[APSPMULTI HDR]" D EN1^DIP
Q
DEQUE D PRINTM
D PRINT1
Q
PRINTM ;
;go through log for date range
K ^TMP("PSMULTI",$J)
F I=STDT:0 S I=$O(^PS(55,"AUDS",I)) Q:('I)!(I>ENDT) F J=0:0 S J=$O(^PS(55,"AUDS",I,J)) Q:'J F K=0:0 S K=$O(^PS(55,"AUDS",I,J,K)) Q:'K D
.S ZERO=$G(^PS(55,I,5,J,0)),OI=+$G(^(.2)),END=$P($G(^(2)),U,4),DATE=$P(ZERO,U,14) I END<ENDT D
..N T F L=0:0 S L=$O(^PS(55,J,5,K,11,L)) Q:'L S ZERO=$G(^(L,0)) D
...I (ZERO<STDT)!(ZERO>ENDT) Q
...S DRIEN=+$P(ZERO,U,2) Q:($P($G(^PSDRUG(+DRIEN,9999999)),U,7)'=ELIG) S DRUG=$P($G(^PSDRUG(DRIEN,0)),U),^TMP("PSMULTI",$J,"B",DRUG,DRIEN)=""
...S T=$G(^TMP("PSMULTI",$J,DRIEN))
...I '$G(T(DRIEN,K)) S $P(^(DRIEN),U,1)=T+1,T(DRIEN,K)=1
...S $P(^(DRIEN),U,2)=$P(T,U,2)+$P(ZERO,U,3)
;now go through prescriptions
F I=STDT:0 S I=$O(^PSRX("AC",I)) Q:(('I)!(I>ENDT)) F J=0:0 S J=$O(^PSRX("AC",I,J)) Q:'J D
.S ZERO=$G(^PSRX(J,0)),TWO=$G(^(2)) Q:ZERO=""
.S DRIEN=$P(ZERO,U,6) Q:($P($G(^PSDRUG(+DRIEN,9999999)),U,7)'=ELIG)
.S D=$P(TWO,U,5) Q:'D I D<STDT!(D>ENDT) Q
.S DRUG=$P($G(^PSDRUG(DRIEN,0)),U),^TMP("PSMULTI",$J,"B",DRUG,DRIEN)=""
.S T=$G(^TMP("PSMULTI",$J,DRIEN)),^(DRIEN)=(1+T)_U_($P(T,U,2)+$P(ZERO,U,7))
Q
PRINT1 ;
S A=""
F S A=$O(^TMP("PSMULTI",$J,"B",A)) Q:A="" F I=0:0 S I=$O(^TMP("PSMULTI",$J,"B",A,I)) Q:'I D
.D N^DIO2 W:$X ! W A,?42,$J($P($G(^TMP("PSMULTI",$J,I)),U),6),?58,$J($P($G(^(I)),U,2),6)
.;D N^DIO2
I '$L($O(^TMP("PSMULTI",$J,"B",""))) D N^DIO2 W !,"No Activity During this Period",!
Q
ADDIV ;Add/Remove from Division
N DIC S DIC="^PS(59,",DIC(0)="MEQA" D ^DIC Q:Y'>0 S DIV=+Y
N DIC S DIC="^PSDRUG(",DIC(0)="MEQA",DIC("W")="D W^APSPMULT" D ^DIC Q:Y'>0
I $D(^PSDRUG(+Y,9999999.41,DIV)) W !,"This Drug is already in this division",!,"Do you wish to Delete"
E W !,"Add this Drug to the Divsion"
D YN^DICN Q:%=-1 G ADDIV:%'=1
S (DIC,DIK)="^PSDRUG("_(+Y)_",9999999.41,",DA=DIV,DA(1)=+Y
I '$D(^PSDRUG(+Y,9999999.41,DIV)) D G ADDIV
.I '$D(^PSDRUG(+Y,9999999.41,0)) S ^(0)="50.999999941PA^^"
.S (DINUM,X)=DIV S DIC(0)="L" D FILE^DICN
D ^DIK
G ADDIV
W ;
N I F I=0:0 S I=$O(^PSDRUG(+Y,9999999.41,I)) Q:'I W:$X>45 ! W ?45," ",$P($G(^PS(59,+I,0)),U)
Q
EDITP ;Edit the parameter
N MSC,DICR,DIVAL,DIR,X,Y
S MSC=$$GET^XPAR("ALL","APSP RESTRICT DRUG BY OPT SITE"),MSC=$S(MSC:"Yes",1:"No")
S DIR="Restrict Drug Selection Based on Outpatient Site"
S DIR(0)="Y^",DIR("B")=MSC
S DIR("A")="Restrict Drug Selection Based on Outpatient Site"
D ^DIR Q:$G(DIRUT)
D PUT^XPAR("SYS","APSP RESTRICT DRUG BY OPT SITE",1,Y)
Q
SITE() ; return outpatient site
N SITE
I $G(PSOSITE) Q PSOSITE
S SITE=$O(^PS(59,"D",+$G(DUZ(2)),"")) Q $S(SITE:SITE,1:+$O(^APSPCTRL(0)))
Q
OI(OI,DFN) ;screen orderable item
N DRUG,POI
S POI=$P($G(^ORD(101.43,+OI,0)),U,2)
I POI'[";99PSP" Q 1
;check if order has specific drug
I $G(^OR(100,+$G(IFN),0)) D I DRUG Q $$SCREEN(DRUG,,1)
.S DRUG=0 N I F I=0:0 S I=$O(^OR(100,+$G(IFN),4.5,I)) Q:'I I $P($G(^(I,0)),U,4)="DRUG" S DRUG=$G(^(1)) Q
F DRUG=0:0 S DRUG=$O(^PSDRUG("ASP",+$G(POI),DRUG)) Q:'DRUG I $$SCREEN(DRUG,,1) Q
I 'DRUG Q 0
Q 1
QUICK(IEN) ;EP-validate quick order
N OI,DRUG
S DRUG=+$O(^ORD(101.41,"B","OR GTX DISPENSE DRUG",0))
S OI=+$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
S DRUG=+$O(^ORD(101.41,IEN,6,"D",DRUG,0)) I DRUG D I DRUG Q $$SCREEN(DRUG,,1)
.S DRUG=+$G(^ORD(101.41,IEN,6,DRUG,1))
S OI=+$O(^ORD(101.41,IEN,6,"D",OI,0)),OI=+$G(^ORD(101.41,IEN,6,+OI,1))
Q $$OI(OI,$G(DFN))
APSPMULT ;IHS/MSC/JDS - Multidivisional drug lookup support;07-Mar-2011 15:06;SM
+1 ;;7.0;IHS PHARMACY MODIFICATION;**1009,1010**;DEC 11, 2003
+2 ;
PRINT ;EP
+1 NEW PDIV
+2 SET DIC="^PS(59,"
SET DIC(0)="MEQA"
DO ^DIC
IF Y'>0
QUIT
SET PDIV=+Y
+3 SET DIS(1)="I $$PRTSCRN^APSPMULT(D0,PDIV)"
+4 SET DIC="^PSDRUG("
SET FLDS="[APSPMULTI]"
SET BY=".01"
SET DIPA("NUM")=1
DO EN1^DIP
+5 QUIT
SCREEN(IEN,NEWSITE,ALWAYS) ;EP
+1 NEW DICR,DIVAL,PAT
+2 ;only for OR and PS options.
IF '$GET(ALWAYS)
IF $PIECE($GET(XQY0),U)=""
QUIT 1
+3 ;S DFN=$G(DFN,$S($T(GETVAR^CIAVMEVT)]"":$$GETVAR^CIAVMEVT("PATIENT.ID.MRN",,"CONTEXT.PATIENT"),1:""))
+4 SET PAT=$SELECT($GET(PSODFN):PSODFN,$GET(DFN):DFN,$GET(CIA("UID"))&($TEXT(GETVAR^CIAVMEVT)]""):$$GETVAR^CIAVMEVT("PATIENT.ID.MRN",,"CONTEXT.PATIENT"),1:0)
+5 ;dont screen.
IF $GET(APSPMULT)
QUIT 1
+6 IF '$GET(ALWAYS)
IF '$$GET^XPAR("ALL","APSP MULTI DRUG SCREEN OPTION",$PIECE(XQY0,U))
QUIT 1
+7 NEW SITE
IF $GET(PSOSITE)
SET SITE=PSOSITE
+8 IF $GET(NEWSITE)
SET SITE=NEWSITE
+9 IF '$GET(SITE)
SET SITE=$ORDER(^PS(59,"D",+$GET(DUZ(2)),""))
IF 'SITE
QUIT 1
+10 ;not on cost plan
IF PAT
IF $PIECE($GET(^APSPCTRL(+$GET(SITE,1),3)),U,21)
IF '$$ELIG(PAT,$PIECE($GET(^PSDRUG(IEN,9999999)),U,7))
QUIT 0
+11 IF '$$GET^XPAR("ALL","APSP RESTRICT DRUG BY OPT SITE")
QUIT 1
+12 IF '$ORDER(^PSDRUG(IEN,9999999.41,0))
QUIT 1
+13 IF $DATA(^PSDRUG(IEN,9999999.41,SITE))
QUIT 1
+14 QUIT 0
+15 ; Screen used for Division Report
PRTSCRN(DRUG,PDIV) ;EP
+1 QUIT ''$DATA(^PSDRUG(DRUG,9999999.41,PDIV))
ELIG(DFN,DRUGELIG) ;
+1 ;is this patient eligible for alternate cost plan.
+2 NEW ELIG
+3 IF DRUGELIG=""
QUIT 1
+4 SET ELIG=$PIECE($GET(^AUPNPAT(+$GET(DFN),11)),U,12)
IF ELIG=""
QUIT 0
+5 IF "I"=ELIG
IF DRUGELIG=1
QUIT 1
+6 IF (DRUGELIG=0)&("DCP"[ELIG)
QUIT 1
+7 QUIT 0
ALL ;postinit make all drugs alternate care plan
+1 KILL ^TMP("MSCPS",$JOB)
+2 FOR I=0:0
SET I=$ORDER(^PSDRUG(I))
IF 'I
QUIT
SET ^TMP("MSCPS",$JOB,50,I_",",9999999.07)=1
+3 DO FILE^DIE("","^TMP(""MSCPS"",$J)")
+4 KILL ^TMP("MSCPS",$JOB)
+5 QUIT
TRANSFER ;Transfer from one division to other
+1 NEW DIC,TO,FROM,I,DINUM,%,CNT
+2 SET DIC="^PS(59,"
SET DIC(0)="MEQA"
SET DIC("A")="Select FROM-> Site: "
DO ^DIC
IF Y'>0
QUIT
SET FROM=+Y
+3 SET DIC="^PS(59,"
SET DIC(0)="MEQA"
SET DIC("A")="Select ->TO Site: "
SET DIC("S")="I FROM'=+Y"
DO ^DIC
IF Y'>0
QUIT
+4 SET TO=+Y
SET CNT=0
+5 WRITE !,"Ok to continue"
DO YN^DICN
IF %'=1
QUIT
+6 FOR I=0:0
SET I=$ORDER(^PSDRUG(I))
IF 'I
QUIT
Begin DoDot:1
+7 IF '$DATA(^PSDRUG(I,9999999.41,FROM))
QUIT
+8 IF $DATA(^PSDRUG(I,9999999.41,TO))
QUIT
+9 SET DIC="^PSDRUG("_I_",9999999.41,"
SET DIC(0)="LMN"
SET X=TO
SET DA(1)=I
SET DINUM=TO
NEW I
DO FILE^DICN
SET CNT=CNT+1
End DoDot:1
+10 WRITE !,CNT," Drugs put in outpatient site"
+11 QUIT
PRATL(TRUE) ;ALTERNATE LIST
+1 NEW DHD
+2 SET DIS(1)="I $P($G(^PSDRUG(+Y,9999999)),U,7)"_$SELECT(TRUE:"=0",1:"=1")
+3 SET DHD="Drugs Designated for Patients with "_$SELECT(TRUE:"",1:"In")_"Eligible Status"
+4 SET DIC="^PSDRUG("
SET FLDS="[APSPALT]"
SET BY=".01"
SET DIPA("NUM")=1
SET L=0
DO EN1^DIP
+5 QUIT
REPT ;
+1 NEW DHD
+2 SET %DT="AE"
SET %DT("A")="Enter Report Month: "
DO ^%DT
IF Y'>0
QUIT
SET STDT=$EXTRACT(Y,1,5)_"00"
SET ENDT=$EXTRACT(Y,1,5)_32
+3 SET X=STDT
XECUTE ^DD("DD")
SET MONTH=Y
+4 SET DIR(0)="S^0:Eligible;1:InEligible"
SET DIR("A")="Select Eligible/Ineligible"
DO ^DIR
IF X[U
QUIT
SET ELIG=+$GET(Y)
+5 SET DIC="^PSDRUG("
SET BY="@NUMBER"
SET (FR,TO)=$ORDER(^PSDRUG(0))
SET FLDS="D DEQUE^APSPMULT"
SET DHD="[APSPMULTI HDR]"
DO EN1^DIP
+6 QUIT
DEQUE DO PRINTM
+1 DO PRINT1
+2 QUIT
PRINTM ;
+1 ;go through log for date range
+2 KILL ^TMP("PSMULTI",$JOB)
+3 FOR I=STDT:0
SET I=$ORDER(^PS(55,"AUDS",I))
IF ('I)!(I>ENDT)
QUIT
FOR J=0:0
SET J=$ORDER(^PS(55,"AUDS",I,J))
IF 'J
QUIT
FOR K=0:0
SET K=$ORDER(^PS(55,"AUDS",I,J,K))
IF 'K
QUIT
Begin DoDot:1
+4 SET ZERO=$GET(^PS(55,I,5,J,0))
SET OI=+$GET(^(.2))
SET END=$PIECE($GET(^(2)),U,4)
SET DATE=$PIECE(ZERO,U,14)
IF END<ENDT
Begin DoDot:2
+5 NEW T
FOR L=0:0
SET L=$ORDER(^PS(55,J,5,K,11,L))
IF 'L
QUIT
SET ZERO=$GET(^(L,0))
Begin DoDot:3
+6 IF (ZERO<STDT)!(ZERO>ENDT)
QUIT
+7 SET DRIEN=+$PIECE(ZERO,U,2)
IF ($PIECE($GET(^PSDRUG(+DRIEN,9999999)),U,7)'=ELIG)
QUIT
SET DRUG=$PIECE($GET(^PSDRUG(DRIEN,0)),U)
SET ^TMP("PSMULTI",$JOB,"B",DRUG,DRIEN)=""
+8 SET T=$GET(^TMP("PSMULTI",$JOB,DRIEN))
+9 IF '$GET(T(DRIEN,K))
SET $PIECE(^(DRIEN),U,1)=T+1
SET T(DRIEN,K)=1
+10 SET $PIECE(^(DRIEN),U,2)=$PIECE(T,U,2)+$PIECE(ZERO,U,3)
End DoDot:3
End DoDot:2
End DoDot:1
+11 ;now go through prescriptions
+12 FOR I=STDT:0
SET I=$ORDER(^PSRX("AC",I))
IF (('I)!(I>ENDT))
QUIT
FOR J=0:0
SET J=$ORDER(^PSRX("AC",I,J))
IF 'J
QUIT
Begin DoDot:1
+13 SET ZERO=$GET(^PSRX(J,0))
SET TWO=$GET(^(2))
IF ZERO=""
QUIT
+14 SET DRIEN=$PIECE(ZERO,U,6)
IF ($PIECE($GET(^PSDRUG(+DRIEN,9999999)),U,7)'=ELIG)
QUIT
+15 SET D=$PIECE(TWO,U,5)
IF 'D
QUIT
IF D<STDT!(D>ENDT)
QUIT
+16 SET DRUG=$PIECE($GET(^PSDRUG(DRIEN,0)),U)
SET ^TMP("PSMULTI",$JOB,"B",DRUG,DRIEN)=""
+17 SET T=$GET(^TMP("PSMULTI",$JOB,DRIEN))
SET ^(DRIEN)=(1+T)_U_($PIECE(T,U,2)+$PIECE(ZERO,U,7))
End DoDot:1
+18 QUIT
PRINT1 ;
+1 SET A=""
+2 FOR
SET A=$ORDER(^TMP("PSMULTI",$JOB,"B",A))
IF A=""
QUIT
FOR I=0:0
SET I=$ORDER(^TMP("PSMULTI",$JOB,"B",A,I))
IF 'I
QUIT
Begin DoDot:1
+3 DO N^DIO2
IF $X
WRITE !
WRITE A,?42,$JUSTIFY($PIECE($GET(^TMP("PSMULTI",$JOB,I)),U),6),?58,$JUSTIFY($PIECE($GET(^(I)),U,2),6)
+4 ;D N^DIO2
End DoDot:1
+5 IF '$LENGTH($ORDER(^TMP("PSMULTI",$JOB,"B","")))
DO N^DIO2
WRITE !,"No Activity During this Period",!
+6 QUIT
ADDIV ;Add/Remove from Division
+1 NEW DIC
SET DIC="^PS(59,"
SET DIC(0)="MEQA"
DO ^DIC
IF Y'>0
QUIT
SET DIV=+Y
+2 NEW DIC
SET DIC="^PSDRUG("
SET DIC(0)="MEQA"
SET DIC("W")="D W^APSPMULT"
DO ^DIC
IF Y'>0
QUIT
+3 IF $DATA(^PSDRUG(+Y,9999999.41,DIV))
WRITE !,"This Drug is already in this division",!,"Do you wish to Delete"
+4 IF '$TEST
WRITE !,"Add this Drug to the Divsion"
+5 DO YN^DICN
IF %=-1
QUIT
IF %'=1
GOTO ADDIV
+6 SET (DIC,DIK)="^PSDRUG("_(+Y)_",9999999.41,"
SET DA=DIV
SET DA(1)=+Y
+7 IF '$DATA(^PSDRUG(+Y,9999999.41,DIV))
Begin DoDot:1
+8 IF '$DATA(^PSDRUG(+Y,9999999.41,0))
SET ^(0)="50.999999941PA^^"
+9 SET (DINUM,X)=DIV
SET DIC(0)="L"
DO FILE^DICN
End DoDot:1
GOTO ADDIV
+10 DO ^DIK
+11 GOTO ADDIV
W ;
+1 NEW I
FOR I=0:0
SET I=$ORDER(^PSDRUG(+Y,9999999.41,I))
IF 'I
QUIT
IF $X>45
WRITE !
WRITE ?45," ",$PIECE($GET(^PS(59,+I,0)),U)
+2 QUIT
EDITP ;Edit the parameter
+1 NEW MSC,DICR,DIVAL,DIR,X,Y
+2 SET MSC=$$GET^XPAR("ALL","APSP RESTRICT DRUG BY OPT SITE")
SET MSC=$SELECT(MSC:"Yes",1:"No")
+3 SET DIR="Restrict Drug Selection Based on Outpatient Site"
+4 SET DIR(0)="Y^"
SET DIR("B")=MSC
+5 SET DIR("A")="Restrict Drug Selection Based on Outpatient Site"
+6 DO ^DIR
IF $GET(DIRUT)
QUIT
+7 DO PUT^XPAR("SYS","APSP RESTRICT DRUG BY OPT SITE",1,Y)
+8 QUIT
SITE() ; return outpatient site
+1 NEW SITE
+2 IF $GET(PSOSITE)
QUIT PSOSITE
+3 SET SITE=$ORDER(^PS(59,"D",+$GET(DUZ(2)),""))
QUIT $SELECT(SITE:SITE,1:+$ORDER(^APSPCTRL(0)))
+4 QUIT
OI(OI,DFN) ;screen orderable item
+1 NEW DRUG,POI
+2 SET POI=$PIECE($GET(^ORD(101.43,+OI,0)),U,2)
+3 IF POI'[";99PSP"
QUIT 1
+4 ;check if order has specific drug
+5 IF $GET(^OR(100,+$GET(IFN),0))
Begin DoDot:1
+6 SET DRUG=0
NEW I
FOR I=0:0
SET I=$ORDER(^OR(100,+$GET(IFN),4.5,I))
IF 'I
QUIT
IF $PIECE($GET(^(I,0)),U,4)="DRUG"
SET DRUG=$GET(^(1))
QUIT
End DoDot:1
IF DRUG
QUIT $$SCREEN(DRUG,,1)
+7 FOR DRUG=0:0
SET DRUG=$ORDER(^PSDRUG("ASP",+$GET(POI),DRUG))
IF 'DRUG
QUIT
IF $$SCREEN(DRUG,,1)
QUIT
+8 IF 'DRUG
QUIT 0
+9 QUIT 1
QUICK(IEN) ;EP-validate quick order
+1 NEW OI,DRUG
+2 SET DRUG=+$ORDER(^ORD(101.41,"B","OR GTX DISPENSE DRUG",0))
+3 SET OI=+$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
+4 SET DRUG=+$ORDER(^ORD(101.41,IEN,6,"D",DRUG,0))
IF DRUG
Begin DoDot:1
+5 SET DRUG=+$GET(^ORD(101.41,IEN,6,DRUG,1))
End DoDot:1
IF DRUG
QUIT $$SCREEN(DRUG,,1)
+6 SET OI=+$ORDER(^ORD(101.41,IEN,6,"D",OI,0))
SET OI=+$GET(^ORD(101.41,IEN,6,+OI,1))
+7 QUIT $$OI(OI,$GET(DFN))
