APSQFAS2 ;IHS/ASDS/ENM/POC - PROGRAM TO COMPUTE LATE RXS;
;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
I '$D(IOF) S %ZIS="N",IOP=0 D ^%ZIS
S U="^",DNUM=0
IF '$D(DUZ)!($G(DUZ)=0) W !,"NEED TO DEFINE DUZ" G EXIT
;IF '($D(DUZ(2))#10) D ^AUKVAR
IF '$D(DT) D NOW^%DTC S DT=X
;
;
GETEM K DIC I $D(DELETE) W !,"THE DRUG YOU SELECT WILL BE DELETED FROM YOUR LIST IF IT IS ON THE LIST"
F Q:U[$G(X,0)!($G(ALL)) S DNUM=DNUM+1 D ;U[""OR ^ AS TRUE
.S DIC="^APSQFAST(",DIC(0)="AEMQ"
.S DIC("W")="W "" ""_$S($P(^(0),U,2):$P(^PSDRUG($P(^(0),U,2),0),U,1),1:""EXPLODE"")"
.S DIC("S")="I $G(^(""I""),0)=0!($P($G(^(0)),U)>DT)"
.S DIC("A")="SELECT THE FAST CODE YOU WANT TO"_$S($D(DELETE):" DELETE",1:" ADD")_": "
.D ^DIC K DIC
.IF X="" K DELETE W @IOF Q
.I $D(DELETE) D Q
..S DRUGX=$P(^APSQFAST(+Y,0),U)
..W !,DRUGX," "
..I $D(DRUG(DRUGX)) W "DELETED" K DRUG(DRUGX)
..E W "IS NOT A MEMBER OF SELECTED FAST CODES!"
..Q
.;NEXT THREE LINES EDITED 11/24/98 IHS/OKCAO/POC
.IF +Y>0 D
..S DRUGNAM=$P(^APSQFAST(+Y,0),U),DRUG(DRUGNAM)=Y
..S DRUGNAM=$P(^APSQFAST(+Y,0),U)_" "_$S($P(^APSQFAST(+Y,0),U,2):$P(^PSDRUG($P(^APSQFAST(+Y,0),U,2),0),U,1),1:"")
.Q
;
LIST ;LIST OF DRUGS CHOOSEN
W !,"LISTED ARE THE FAST CODES SELECTED SO FAR:",!
I '$D(DRUG) W !,"NO FAST CODES HAVE BEEN SELECTED",!
S DRUGNAM=0 F S DRUGNAM=$O(DRUG(DRUGNAM)) Q:DRUGNAM="" W !,DRUGNAM
;
K DIR
S DIR(0)="S^A:ADD MORE FAST CODES;D:DELETE A DRUG;C:CONTINUE"
S DIR("B")="C"
S DIR("A")="ANSWER WITH THE RESPONSE TO ADD, DELETE, CONTINUE, OR '^' TO EXIT"
D ^DIR K DIR,X
I Y="A" G GETEM
I Y="D" S DELETE=1 G GETEM
I $D(DIRUT) G EXIT ;ADD SOME HERE XXX
D EXPAND
G:'$D(DRUG) EXIT
Q
DIQ S APSQHIT=0 F S APSQHIT=$O(DRUG(APSQHIT)) Q:APSQHIT="" D D ^APSQFAS3
.S APSQDG=+DRUG(APSQHIT)
.Q:'APSQDG
.D GETS^DIQ(9009035.3,APSQDG_",","*","I","APSQ","ERR")
.M APSQF=APSQ(9009035.3,APSQDG_",") K APSQ ;EASIER TO WORK WITH
;
Q
EXPAND ;EXPAND ANY EXPLODING ENTRIES
S DRUGNAM="" F S DRUGNAM=$O(DRUG(DRUGNAM)) Q:DRUGNAM="" D
.S DRUGNAMI=+DRUG(DRUGNAM)
.Q:'$O(^APSQFAST(DRUGNAMI,2,0))
.S APSQEXP=0 F S APSQEXP=$O(^APSQFAST(DRUGNAMI,2,APSQEXP)) Q:APSQEXP'=+APSQEXP D
..S APSQEXPI=^APSQFAST(DRUGNAMI,2,APSQEXP,0)
..S DRUGALSO($P(^APSQFAST(APSQEXPI,0),U,1))=APSQEXPI
.K DRUG(DRUGNAM)
M DRUG=DRUGALSO
K DRUGALSO
Q
EXIT ;KILL AND EXIT
K PSONEW,PSONEW1
S PSONEW("QFLG")=1
K DRUGALSO,DRUG
Q
APSQFAS2 ;IHS/ASDS/ENM/POC - PROGRAM TO COMPUTE LATE RXS;
+1 ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
+2 IF '$DATA(IOF)
SET %ZIS="N"
SET IOP=0
DO ^%ZIS
+3 SET U="^"
SET DNUM=0
+4 IF '$DATA(DUZ)!($GET(DUZ)=0)
WRITE !,"NEED TO DEFINE DUZ"
GOTO EXIT
+5 ;IF '($D(DUZ(2))#10) D ^AUKVAR
+6 IF '$DATA(DT)
DO NOW^%DTC
SET DT=X
+7 ;
+8 ;
GETEM KILL DIC
IF $DATA(DELETE)
WRITE !,"THE DRUG YOU SELECT WILL BE DELETED FROM YOUR LIST IF IT IS ON THE LIST"
+1 ;U[""OR ^ AS TRUE
FOR
IF U[$GET(X,0)!($GET(ALL))
QUIT
SET DNUM=DNUM+1
Begin DoDot:1
+2 SET DIC="^APSQFAST("
SET DIC(0)="AEMQ"
+3 SET DIC("W")="W "" ""_$S($P(^(0),U,2):$P(^PSDRUG($P(^(0),U,2),0),U,1),1:""EXPLODE"")"
+4 SET DIC("S")="I $G(^(""I""),0)=0!($P($G(^(0)),U)>DT)"
+5 SET DIC("A")="SELECT THE FAST CODE YOU WANT TO"_$SELECT($DATA(DELETE):" DELETE",1:" ADD")_": "
+6 DO ^DIC
KILL DIC
+7 IF X=""
KILL DELETE
WRITE @IOF
QUIT
+8 IF $DATA(DELETE)
Begin DoDot:2
+9 SET DRUGX=$PIECE(^APSQFAST(+Y,0),U)
+10 WRITE !,DRUGX," "
+11 IF $DATA(DRUG(DRUGX))
WRITE "DELETED"
KILL DRUG(DRUGX)
+12 IF '$TEST
WRITE "IS NOT A MEMBER OF SELECTED FAST CODES!"
+13 QUIT
End DoDot:2
QUIT
+14 ;NEXT THREE LINES EDITED 11/24/98 IHS/OKCAO/POC
+15 IF +Y>0
Begin DoDot:2
+16 SET DRUGNAM=$PIECE(^APSQFAST(+Y,0),U)
SET DRUG(DRUGNAM)=Y
+17 SET DRUGNAM=$PIECE(^APSQFAST(+Y,0),U)_" "_$SELECT($PIECE(^APSQFAST(+Y,0),U,2):$PIECE(^PSDRUG($PIECE(^APSQFAST(+Y,0),U,2),0),U,1),1:"")
End DoDot:2
+18 QUIT
End DoDot:1
+19 ;
LIST ;LIST OF DRUGS CHOOSEN
+1 WRITE !,"LISTED ARE THE FAST CODES SELECTED SO FAR:",!
+2 IF '$DATA(DRUG)
WRITE !,"NO FAST CODES HAVE BEEN SELECTED",!
+3 SET DRUGNAM=0
FOR
SET DRUGNAM=$ORDER(DRUG(DRUGNAM))
IF DRUGNAM=""
QUIT
WRITE !,DRUGNAM
+4 ;
+5 KILL DIR
+6 SET DIR(0)="S^A:ADD MORE FAST CODES;D:DELETE A DRUG;C:CONTINUE"
+7 SET DIR("B")="C"
+8 SET DIR("A")="ANSWER WITH THE RESPONSE TO ADD, DELETE, CONTINUE, OR '^' TO EXIT"
+9 DO ^DIR
KILL DIR,X
+10 IF Y="A"
GOTO GETEM
+11 IF Y="D"
SET DELETE=1
GOTO GETEM
+12 ;ADD SOME HERE XXX
IF $DATA(DIRUT)
GOTO EXIT
+13 DO EXPAND
+14 IF '$DATA(DRUG)
GOTO EXIT
+15 QUIT
DIQ SET APSQHIT=0
FOR
SET APSQHIT=$ORDER(DRUG(APSQHIT))
IF APSQHIT=""
QUIT
Begin DoDot:1
+1 SET APSQDG=+DRUG(APSQHIT)
+2 IF 'APSQDG
QUIT
+3 DO GETS^DIQ(9009035.3,APSQDG_",","*","I","APSQ","ERR")
+4 ;EASIER TO WORK WITH
MERGE APSQF=APSQ(9009035.3,APSQDG_",")
KILL APSQ
End DoDot:1
DO ^APSQFAS3
+5 ;
+6 QUIT
EXPAND ;EXPAND ANY EXPLODING ENTRIES
+1 SET DRUGNAM=""
FOR
SET DRUGNAM=$ORDER(DRUG(DRUGNAM))
IF DRUGNAM=""
QUIT
Begin DoDot:1
+2 SET DRUGNAMI=+DRUG(DRUGNAM)
+3 IF '$ORDER(^APSQFAST(DRUGNAMI,2,0))
QUIT
+4 SET APSQEXP=0
FOR
SET APSQEXP=$ORDER(^APSQFAST(DRUGNAMI,2,APSQEXP))
IF APSQEXP'=+APSQEXP
QUIT
Begin DoDot:2
+5 SET APSQEXPI=^APSQFAST(DRUGNAMI,2,APSQEXP,0)
+6 SET DRUGALSO($PIECE(^APSQFAST(APSQEXPI,0),U,1))=APSQEXPI
End DoDot:2
+7 KILL DRUG(DRUGNAM)
End DoDot:1
+8 MERGE DRUG=DRUGALSO
+9 KILL DRUGALSO
+10 QUIT
EXIT ;KILL AND EXIT
+1 KILL PSONEW,PSONEW1
+2 SET PSONEW("QFLG")=1
+3 KILL DRUGALSO,DRUG
+4 QUIT
