- 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
