APSQDRG ;IHS/ASDS/JCM/ENM/POC - ORDER ENTRY DRUG SELECTION
;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
;;6.0;OUTPATIENT PHARMACY;**40,131**;09/03/97
;----------------------------------------------------------
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
D POST ;I PSORX("DFLG") S PSONEW("DFLG")=1 K:'$G(PSORX("EDIT")) PSORX("DFLG") ; Do any post selection action DONT WANT TO GET RID OF DELETE FLAG YET IHS/OKCAO/POC
END D EOJ
Q
;------------------------------------------------------------
;
SELECT ;
K DIC,X,Y
S DIC="^PSDRUG(",DIC(0)="ZM",X="`"_APSPDIEN
D ^DIC
I Y<0 S STOP=1 Q
K PSOY S PSOY=Y,PSOY(0)=Y(0)
S X="APSQMAN" X ^%ZOSF("TEST") D:$T ^APSQMAN ;IHS/OKCAO/POC 3/30/98
S X="APSQMAN" X ^%ZOSF("TEST") D:'$T ^APSPMAN ;IHS/OKCAO/POC 3/30/98
;D ^APSPMAN ;IHS/DSD/ENM MANUFACTURER CALL 1-6-95
;D ^APSQMAN
;I $P(PSOY(0),"^")="OTHER DRUG"!($P(PSOY(0),"^")="OUTSIDE DRUG") D TRADE ;IHS/OKCAO/POC DELETE THIS FOR NOW
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)
SETX K PSOX1,PSOY
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
;D ^AZODRDUP ;ADDED FOR OUTSIDE DUPS IHS/OKCAO/POC
S X="APSQDRDU" X ^%ZOSF("TEST") D:$T ^APSQDRDU ;IHS/OKCAO/POC 3/30/98
Q:$G(PSORX("DFLG"))
;D ^PSODGDGI D:$G(PSORX("INTERVENE"))]"" ^PSORXI G:PSORX("DFLG") POSTX
D ^PSODGDGI G:PSORX("DFLG") POSTX ;IHS/OKCAO/POC 12/3/97 MULTIPLE INTERVENS
;D ^AZODGDGI G:PSORX("DFLG") POSTX ;ADDED FOR OUTSIDE RXS IHS/OKCAO/POC
S X="APSQDGDG" X ^%ZOSF("TEST") D:$T ^APSQDGDG ;IHS/OKCAO/POC 3/30/98
K PSORX("INTERVENE") ;ADDED TO NOT CAUSE A PROBLEM BELOW IHS/OKCAO/POC
S X="APSQALLE" X ^%ZOSF("TEST") D:$T EN^APSQALLE D:$G(PSORX("INTERVENE"))]"" ^PSORXI G:PSORX("DFLG") POSTX ;ADDED FOR ALLERGY CHECK IHS/OKCAO/POC 11/17/97
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
APSQDRG ;IHS/ASDS/JCM/ENM/POC - ORDER ENTRY DRUG SELECTION
+1 ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
+2 ;;6.0;OUTPATIENT PHARMACY;**40,131**;09/03/97
+3 ;----------------------------------------------------------
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 ;D POST I PSORX("DFLG") S PSONEW("DFLG")=1 K:'$G(PSORX("EDIT")) PSORX("DFLG") ; Do any post selection action
+7 ;I PSORX("DFLG") S PSONEW("DFLG")=1 K:'$G(PSORX("EDIT")) PSORX("DFLG") ; Do any post selection action DONT WANT TO GET RID OF DELETE FLAG YET IHS/OKCAO/POC
DO POST
END DO EOJ
+1 QUIT
+2 ;------------------------------------------------------------
+3 ;
SELECT ;
+1 KILL DIC,X,Y
+2 SET DIC="^PSDRUG("
SET DIC(0)="ZM"
SET X="`"_APSPDIEN
+3 DO ^DIC
+4 IF Y<0
SET STOP=1
QUIT
+5 KILL PSOY
SET PSOY=Y
SET PSOY(0)=Y(0)
+6 ;IHS/OKCAO/POC 3/30/98
SET X="APSQMAN"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO ^APSQMAN
+7 ;IHS/OKCAO/POC 3/30/98
SET X="APSQMAN"
XECUTE ^%ZOSF("TEST")
IF '$TEST
DO ^APSPMAN
+8 ;D ^APSPMAN ;IHS/DSD/ENM MANUFACTURER CALL 1-6-95
+9 ;D ^APSQMAN
+10 ;I $P(PSOY(0),"^")="OTHER DRUG"!($P(PSOY(0),"^")="OUTSIDE DRUG") D TRADE ;IHS/OKCAO/POC DELETE THIS FOR NOW
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)
SETX KILL PSOX1,PSOY
+1 QUIT
+2 ;
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 ;D ^AZODRDUP ;ADDED FOR OUTSIDE DUPS IHS/OKCAO/POC
+5 ;IHS/OKCAO/POC 3/30/98
SET X="APSQDRDU"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO ^APSQDRDU
+6 IF $GET(PSORX("DFLG"))
QUIT
+7 ;D ^PSODGDGI D:$G(PSORX("INTERVENE"))]"" ^PSORXI G:PSORX("DFLG") POSTX
+8 ;IHS/OKCAO/POC 12/3/97 MULTIPLE INTERVENS
DO ^PSODGDGI
IF PSORX("DFLG")
GOTO POSTX
+9 ;D ^AZODGDGI G:PSORX("DFLG") POSTX ;ADDED FOR OUTSIDE RXS IHS/OKCAO/POC
+10 ;IHS/OKCAO/POC 3/30/98
SET X="APSQDGDG"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO ^APSQDGDG
+11 ;ADDED TO NOT CAUSE A PROBLEM BELOW IHS/OKCAO/POC
KILL PSORX("INTERVENE")
+12 ;ADDED FOR ALLERGY CHECK IHS/OKCAO/POC 11/17/97
SET X="APSQALLE"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO EN^APSQALLE
IF $GET(PSORX("INTERVENE"))]""
DO ^PSORXI
IF PSORX("DFLG")
GOTO POSTX
+13 IF $PIECE($GET(^PSDRUG(PSODRUG("IEN"),"CLOZ1")),"^")]""
DO CLOZ
IF PSORX("DFLG")
GOTO POSTX
+14 ; Do ^allergy check
+15 ;D ^PSODRDUP ; Set PSORX("DFLG")=1 if process to stop
+16 ; ^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
