APSQFAS4 ;IHS/DSD/JCM - ORDER ENTRY FAST DRUG SELECTION
;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
;----------------------------------------------------------
START ;
S (PSONEW("DFLG"),PSONEW("FIELD"),PSODRG("QFLG"))=0
D SELECT ; Select Drug
I $G(PSORX("EDIT"))]"",'PSONEW("FIELD") D TRADE
G:PSONEW("DFLG")!(PSODRG("QFLG")) END
D SET ; Set various drug information
D POST I PSORX("DFLG") S PSONEW("DFLG")=1 K:'$G(PSORX("EDIT")) PSORX("DFLG") ; Do any post selection action
END D EOJ
Q
;------------------------------------------------------------
;
SELECT ;
K DIC,X,Y,PSODRUG("TRADE NAME")
I $G(PSODRUG("IEN"))]"" S DIC("B")=PSODRUG("NAME"),PSONEW("OLD VAL")=PSODRUG("IEN")
;S DIC="^PSDRUG(",DIC(0)="MQEAZO",DIC("A")="DRUG: ",DIC("S")="I $S('$D(^PSDRUG(+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),$S($P($G(^PSDRUG(+Y,2)),""^"",3)'[""O"":0,1:1)" D ^DIC K DIC
S Y=$G(APSQF(2,"I")),Y(0)=^PSDRUG(Y,0) ;IHS/OKCAO/POC FAST OPTION
S:Y>0 X=$P(^PSDRUG(Y,0),U,1) ;IHS/OKCAO/POC FAST OPTION
W !,X ;FAST OPTION
;IHS/DSD/ENM 01/31/97 NEXT LI COPIED MODIFIED/DISABLED
;S DIC="^PSDRUG(",DIC(0)="MQEAZ",DIC("A")="DRUG: ",DIC("S")="I $S('$D(^PSDRUG(+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),$S($P($G(^PSDRUG(+Y,2)),""^"",3)'[""O"":0,1:1)" D ^DIC K DIC
I X[U,$L(X)>1 S PSODIR("FLD")=PSONEW("FLD") D JUMP^PSODIR1 S:$G(PSODIR("FIELD")) PSONEW("FIELD")=PSODIR("FIELD") K PSODIR S PSODRG("QFLG")=1 G SELECTX
I $D(DTOUT)!($D(DUOUT)) S PSONEW("DFLG")=1 G SELECTX
;I Y<0 G SELECT
S:Y<1 PSODRG("QFLG")=1 ;IHS/OKCAO/POC FAST OPTION
S:$G(PSONEW("OLD VAL"))=+Y PSODRG("QFLG")=1
K PSOY S PSOY=Y,PSOY(0)=Y(0)
;D ^APSPMAN ;IHS/DSD/ENM MANUFACTURER CALL 1-6-95 8/18/2000 IHS/OKCAO/POC
I $P(PSOY(0),"^")="OTHER DRUG"!($P(PSOY(0),"^")="OUTSIDE DRUG") D TRADE
SELECTX K X,Y,DTOUT,DUOUT
Q
;
TRADE ;
K DIR,DIC,DA,X,Y
S DIR(0)="52,6.5" D ^DIR K DIR,DIC
I $D(DIRUT) S:$D(DUOUT)!$D(DTOUT)&('$D(PSORX("EDIT"))) PSONEW("DFLG")=1 G TRADEX
S PSODRUG("TRADE NAME")=Y
TRADEX K DIRUT,DTOUT,DUOUT,X,Y
Q
;
SET ;
S PSODRUG("IEN")=+PSOY,PSODRUG("VA CLASS")=$P(PSOY(0),"^",2)
S PSODRUG("NAME")=$P(PSOY(0),"^")
S PSODRUG("NDF")=$S($G(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
S PSODRUG("MAXDOSE")=$P(PSOY(0),"^",4),PSODRUG("DEA")=$P(PSOY(0),"^",3)
S PSODRUG("CLN")=$S($D(^PSDRUG(+PSOY,"ND")):+$P(^("ND"),"^",6),1:0)
S PSODRUG("SIG")=$P(PSOY(0),"^",5)
S PSODRUG("NDC")=$P($G(^PSDRUG(+PSOY,2)),"^",4)
S PSODRUG("STKLVL")=$G(^PSDRUG(+PSOY,660.1))
G:$G(^PSDRUG(+PSOY,660))']"" SETX
S PSOX1=$G(^PSDRUG(+PSOY,660))
S PSODRUG("COST")=$P($G(PSOX1),"^",6)
S PSODRUG("UNIT")=$P($G(PSOX1),"^",8)
;S PSODRUG("EXPIRATION DATE")=$P($G(PSOX1),"^",9)
S PSODRUG("AWP")=$P($G(^PSDRUG(+PSOY,999999931)),"^",2) ;AWP PRICE IHS/OKCAO/POC 8/18/2000
;MORE CHANGES IHS/OKCAO/POC 8/18/2000
;S DIC="^PSDRUG(",DR="9999999.24:9999999.26",DA=PSODRUG("IEN"),DIQ="APSQ(""DIQ1"",",DIQ(0)="I"
S DIC="^PSDRUG(",DR="9999999.25:9999999.26",DA=PSODRUG("IEN"),DIQ="APSQ(""DIQ1"",",DIQ(0)="I"
D EN^DIQ1
;S PSONEW("MANUFACTURER")=@("APSQ(""DIQ1"",50,"_PSODRUG("IEN")_",9999999.24,""I"")")
S PSONEW("LOT #")=@("APSQ(""DIQ1"",50,"_PSODRUG("IEN")_",9999999.25,""I"")")
S PSONEW("EXPIRATION DATE")=@("APSQ(""DIQ1"",50,"_PSODRUG("IEN")_",9999999.26,""I"")")
I $G(PSONEW("EXPIRATION DATE"))["T+" S X=PSONEW("EXPIRATION DATE"),%DT="" D ^%DT S:Y'=-1 PSONEW("EXPIRATION DATE")=Y ;IHS/OKCAO/POC 1/9/2001 IN CASE FIELD HAS T+ CHANGE TO A FILEMAN DATE
;CRAP I NEED THE EXTERNAL FOR THE FAST OPTION
S DIC="^PSDRUG(",DR="9999999.24",DA=PSODRUG("IEN"),DIQ="APSQ(""DIQ1"",",DIQ(0)="E"
D EN^DIQ1
S PSONEW("MANUFACTURER")=@("APSQ(""DIQ1"",50,"_PSODRUG("IEN")_",9999999.24,""E"")")
;END OF CHANGES IHS/OKCAO/POC 8/18/2000
SETX K PSOX1,PSOY
K APSQ("DIQ1") ;8/18/2000 IHS/OKCAO/POC
Q
;
POST ;
S PSORX("DFLG")=0
;I $G(DUZ("AG"))="I" D ^PSODRG99 ; IHS specific call
D ^PSODRDUP ; Set PSORX("DFLG")=1 if process to stop
S X="APSQDRDU" X ^%ZOSF("TEST") I $T D ^APSQDRDU ;IHS/DSD/ENM/POC 05/11/98 DUP OUTSIDE RX CK
Q:$G(PSORX("DFLG"))
;D ^PSODGDGI D:$G(PSORX("INTERVENE"))]"" ^PSORXI G:PSORX("DFLG") POSTX
D ^PSODGDGI G:PSORX("DFLG") POSTX ;IHS/DSD/ENM/POC 05/11/98 MULTI-INTERVENS
S X="APSQDGDG" X ^%ZOSF("TEST") I $T D ^APSQDGDG G:PSORX("DFLG") POSTX ;IHS/DSD/ENM/POC 05/11/98 OUTSIDE RX CK CHANGED DGLG TO DFLG IHS/OKCAO/POC 5/26/98
S X="APSQALLE" X ^%ZOSF("TEST") I $T K PSORX("INTERVENE") ;IHS/DSD/ENM/POC 05/11/98 OUTSIDE RX CK
S X="APSQALLE" X ^%ZOSF("TEST") I $T D EN^APSQALLE D:$G(PSORX("INTERVENE"))]"" ^PSORXI G:PSORX("DFLG") POSTX ;IHS/DSD/ENM/POC 05/11/98 OUTSIDE RX CK CHANGED DGLG TO DFLG IHS/OKCAO/POC 5/26/98
;
;IHS/DSD/ENM NEXT LINE ROUTINE IS UNDER DEVELOPMENT
;D EN^APSPALG D:$G(PSORX("INTERVENE"))]"" ^PSORXI G:PSORX("DFLG") POSTX ;IHS/DSD/POC/ENM ADDED FOR ALLERGY CHECK
D POSTX ;IHS/OKCAO/POC 9/28/98
S X="APSQCK" X ^%ZOSF("TEST") I $T D RX^APSQCK D:$G(PSORX("INTERVENE"))]"" ^PSORXI G:PSORX("DFLG") POSTX ;IHS/OKCAO/POC 9/28/98
D POSTX ;IHS/OKCAO/POC 9/28/98
D:$P($G(^PSDRUG(PSODRUG("IEN"),"CLOZ1")),"^")]"" CLOZ G:PSORX("DFLG") POSTX
; Do ^allergy check
;D ^PSODRDUP ; Set PSORX("DFLG")=1 if process to stop
; ^Do any other action revolving around the drug selection
POSTX ;
K PSORX("INTERVENE")
Q
;
EOJ ;
K PSODRG
Q
;
CLOZ ;
S ANQRTN=$P(^PSDRUG(PSODRUG("IEN"),"CLOZ1"),"^"),ANQX=0
S P(5)=PSODRUG("IEN"),DFN=PSODFN,X=ANQRTN
X ^%ZOSF("TEST") I D @("^"_ANQRTN) S:$G(ANQX) PSORX("DFLG")=1
K P(5),ANQRTN,ANQX,X
Q
APSQFAS4 ;IHS/DSD/JCM - ORDER ENTRY FAST DRUG SELECTION
+1 ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
+2 ;----------------------------------------------------------
START ;
+1 SET (PSONEW("DFLG"),PSONEW("FIELD"),PSODRG("QFLG"))=0
+2 ; Select Drug
DO SELECT
+3 IF $GET(PSORX("EDIT"))]""
IF 'PSONEW("FIELD")
DO TRADE
+4 IF PSONEW("DFLG")!(PSODRG("QFLG"))
GOTO END
+5 ; Set various drug information
DO SET
+6 ; Do any post selection action
DO POST
IF PSORX("DFLG")
SET PSONEW("DFLG")=1
IF '$GET(PSORX("EDIT"))
KILL PSORX("DFLG")
END DO EOJ
+1 QUIT
+2 ;------------------------------------------------------------
+3 ;
SELECT ;
+1 KILL DIC,X,Y,PSODRUG("TRADE NAME")
+2 IF $GET(PSODRUG("IEN"))]""
SET DIC("B")=PSODRUG("NAME")
SET PSONEW("OLD VAL")=PSODRUG("IEN")
+3 ;S DIC="^PSDRUG(",DIC(0)="MQEAZO",DIC("A")="DRUG: ",DIC("S")="I $S('$D(^PSDRUG(+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),$S($P($G(^PSDRUG(+Y,2)),""^"",3)'[""O"":0,1:1)" D ^DIC K DIC
+4 ;IHS/OKCAO/POC FAST OPTION
SET Y=$GET(APSQF(2,"I"))
SET Y(0)=^PSDRUG(Y,0)
+5 ;IHS/OKCAO/POC FAST OPTION
IF Y>0
SET X=$PIECE(^PSDRUG(Y,0),U,1)
+6 ;FAST OPTION
WRITE !,X
+7 ;IHS/DSD/ENM 01/31/97 NEXT LI COPIED MODIFIED/DISABLED
+8 ;S DIC="^PSDRUG(",DIC(0)="MQEAZ",DIC("A")="DRUG: ",DIC("S")="I $S('$D(^PSDRUG(+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),$S($P($G(^PSDRUG(+Y,2)),""^"",3)'[""O"":0,1:1)" D ^DIC K DIC
+9 IF X[U
IF $LENGTH(X)>1
SET PSODIR("FLD")=PSONEW("FLD")
DO JUMP^PSODIR1
IF $GET(PSODIR("FIELD"))
SET PSONEW("FIELD")=PSODIR("FIELD")
KILL PSODIR
SET PSODRG("QFLG")=1
GOTO SELECTX
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
SET PSONEW("DFLG")=1
GOTO SELECTX
+11 ;I Y<0 G SELECT
+12 ;IHS/OKCAO/POC FAST OPTION
IF Y<1
SET PSODRG("QFLG")=1
+13 IF $GET(PSONEW("OLD VAL"))=+Y
SET PSODRG("QFLG")=1
+14 KILL PSOY
SET PSOY=Y
SET PSOY(0)=Y(0)
+15 ;D ^APSPMAN ;IHS/DSD/ENM MANUFACTURER CALL 1-6-95 8/18/2000 IHS/OKCAO/POC
+16 IF $PIECE(PSOY(0),"^")="OTHER DRUG"!($PIECE(PSOY(0),"^")="OUTSIDE DRUG")
DO TRADE
SELECTX KILL X,Y,DTOUT,DUOUT
+1 QUIT
+2 ;
TRADE ;
+1 KILL DIR,DIC,DA,X,Y
+2 SET DIR(0)="52,6.5"
DO ^DIR
KILL DIR,DIC
+3 IF $DATA(DIRUT)
IF $DATA(DUOUT)!$DATA(DTOUT)&('$DATA(PSORX("EDIT")))
SET PSONEW("DFLG")=1
GOTO TRADEX
+4 SET PSODRUG("TRADE NAME")=Y
TRADEX KILL DIRUT,DTOUT,DUOUT,X,Y
+1 QUIT
+2 ;
SET ;
+1 SET PSODRUG("IEN")=+PSOY
SET PSODRUG("VA CLASS")=$PIECE(PSOY(0),"^",2)
+2 SET PSODRUG("NAME")=$PIECE(PSOY(0),"^")
+3 SET PSODRUG("NDF")=$SELECT($GET(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
+4 SET PSODRUG("MAXDOSE")=$PIECE(PSOY(0),"^",4)
SET PSODRUG("DEA")=$PIECE(PSOY(0),"^",3)
+5 SET PSODRUG("CLN")=$SELECT($DATA(^PSDRUG(+PSOY,"ND")):+$PIECE(^("ND"),"^",6),1:0)
+6 SET PSODRUG("SIG")=$PIECE(PSOY(0),"^",5)
+7 SET PSODRUG("NDC")=$PIECE($GET(^PSDRUG(+PSOY,2)),"^",4)
+8 SET PSODRUG("STKLVL")=$GET(^PSDRUG(+PSOY,660.1))
+9 IF $GET(^PSDRUG(+PSOY,660))']""
GOTO SETX
+10 SET PSOX1=$GET(^PSDRUG(+PSOY,660))
+11 SET PSODRUG("COST")=$PIECE($GET(PSOX1),"^",6)
+12 SET PSODRUG("UNIT")=$PIECE($GET(PSOX1),"^",8)
+13 ;S PSODRUG("EXPIRATION DATE")=$P($G(PSOX1),"^",9)
+14 ;AWP PRICE IHS/OKCAO/POC 8/18/2000
SET PSODRUG("AWP")=$PIECE($GET(^PSDRUG(+PSOY,999999931)),"^",2)
+15 ;MORE CHANGES IHS/OKCAO/POC 8/18/2000
+16 ;S DIC="^PSDRUG(",DR="9999999.24:9999999.26",DA=PSODRUG("IEN"),DIQ="APSQ(""DIQ1"",",DIQ(0)="I"
+17 SET DIC="^PSDRUG("
SET DR="9999999.25:9999999.26"
SET DA=PSODRUG("IEN")
SET DIQ="APSQ(""DIQ1"","
SET DIQ(0)="I"
+18 DO EN^DIQ1
+19 ;S PSONEW("MANUFACTURER")=@("APSQ(""DIQ1"",50,"_PSODRUG("IEN")_",9999999.24,""I"")")
+20 SET PSONEW("LOT #")=@("APSQ(""DIQ1"",50,"_PSODRUG("IEN")_",9999999.25,""I"")")
+21 SET PSONEW("EXPIRATION DATE")=@("APSQ(""DIQ1"",50,"_PSODRUG("IEN")_",9999999.26,""I"")")
+22 ;IHS/OKCAO/POC 1/9/2001 IN CASE FIELD HAS T+ CHANGE TO A FILEMAN DATE
IF $GET(PSONEW("EXPIRATION DATE"))["T+"
SET X=PSONEW("EXPIRATION DATE")
SET %DT=""
DO ^%DT
IF Y'=-1
SET PSONEW("EXPIRATION DATE")=Y
+23 ;CRAP I NEED THE EXTERNAL FOR THE FAST OPTION
+24 SET DIC="^PSDRUG("
SET DR="9999999.24"
SET DA=PSODRUG("IEN")
SET DIQ="APSQ(""DIQ1"","
SET DIQ(0)="E"
+25 DO EN^DIQ1
+26 SET PSONEW("MANUFACTURER")=@("APSQ(""DIQ1"",50,"_PSODRUG("IEN")_",9999999.24,""E"")")
+27 ;END OF CHANGES IHS/OKCAO/POC 8/18/2000
SETX KILL PSOX1,PSOY
+1 ;8/18/2000 IHS/OKCAO/POC
KILL APSQ("DIQ1")
+2 QUIT
+3 ;
POST ;
+1 SET PSORX("DFLG")=0
+2 ;I $G(DUZ("AG"))="I" D ^PSODRG99 ; IHS specific call
+3 ; Set PSORX("DFLG")=1 if process to stop
DO ^PSODRDUP
+4 ;IHS/DSD/ENM/POC 05/11/98 DUP OUTSIDE RX CK
SET X="APSQDRDU"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO ^APSQDRDU
+5 IF $GET(PSORX("DFLG"))
QUIT
+6 ;D ^PSODGDGI D:$G(PSORX("INTERVENE"))]"" ^PSORXI G:PSORX("DFLG") POSTX
+7 ;IHS/DSD/ENM/POC 05/11/98 MULTI-INTERVENS
DO ^PSODGDGI
IF PSORX("DFLG")
GOTO POSTX
+8 ;IHS/DSD/ENM/POC 05/11/98 OUTSIDE RX CK CHANGED DGLG TO DFLG IHS/OKCAO/POC 5/26/98
SET X="APSQDGDG"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO ^APSQDGDG
IF PSORX("DFLG")
GOTO POSTX
+9 ;IHS/DSD/ENM/POC 05/11/98 OUTSIDE RX CK
SET X="APSQALLE"
XECUTE ^%ZOSF("TEST")
IF $TEST
KILL PSORX("INTERVENE")
+10 ;IHS/DSD/ENM/POC 05/11/98 OUTSIDE RX CK CHANGED DGLG TO DFLG IHS/OKCAO/POC 5/26/98
SET X="APSQALLE"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO EN^APSQALLE
IF $GET(PSORX("INTERVENE"))]""
DO ^PSORXI
IF PSORX("DFLG")
GOTO POSTX
+11 ;
+12 ;IHS/DSD/ENM NEXT LINE ROUTINE IS UNDER DEVELOPMENT
+13 ;D EN^APSPALG D:$G(PSORX("INTERVENE"))]"" ^PSORXI G:PSORX("DFLG") POSTX ;IHS/DSD/POC/ENM ADDED FOR ALLERGY CHECK
+14 ;IHS/OKCAO/POC 9/28/98
DO POSTX
+15 ;IHS/OKCAO/POC 9/28/98
SET X="APSQCK"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO RX^APSQCK
IF $GET(PSORX("INTERVENE"))]""
DO ^PSORXI
IF PSORX("DFLG")
GOTO POSTX
+16 ;IHS/OKCAO/POC 9/28/98
DO POSTX
+17 IF $PIECE($GET(^PSDRUG(PSODRUG("IEN"),"CLOZ1")),"^")]""
DO CLOZ
IF PSORX("DFLG")
GOTO POSTX
+18 ; Do ^allergy check
+19 ;D ^PSODRDUP ; Set PSORX("DFLG")=1 if process to stop
+20 ; ^Do any other action revolving around the drug selection
POSTX ;
+1 KILL PSORX("INTERVENE")
+2 QUIT
+3 ;
EOJ ;
+1 KILL PSODRG
+2 QUIT
+3 ;
CLOZ ;
+1 SET ANQRTN=$PIECE(^PSDRUG(PSODRUG("IEN"),"CLOZ1"),"^")
SET ANQX=0
+2 SET P(5)=PSODRUG("IEN")
SET DFN=PSODFN
SET X=ANQRTN
+3 XECUTE ^%ZOSF("TEST")
IF $TEST
DO @("^"_ANQRTN)
IF $GET(ANQX)
SET PSORX("DFLG")=1
+4 KILL P(5),ANQRTN,ANQX,X
+5 QUIT
