| 1 | PSOREF2 ;ISC-BIRM/SAB - asks all questions for barcode refill rx order entry ; 09/30/96
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
|
|---|
| 3 | ;
|
|---|
| 4 | START ;
|
|---|
| 5 | S (PSOREF("DFLG"),PSOREF("FIELD"),PSOREF1)=0
|
|---|
| 6 | S X1=DT,X2=-180 D C^%DTC S PSOREF("ISSUE DATE")=X
|
|---|
| 7 | S:$G(PSORX("BAR CODE"))&($G(PSOBBC1("FROM"))="NEW") PSOREF("ISSUE DATE")=DT
|
|---|
| 8 | K X,X1,X2
|
|---|
| 9 | ;
|
|---|
| 10 | ;
|
|---|
| 11 | 1 S PSOREF("FLD")=1 D FILLDT^PSODIR3(.PSOREF) ; Get Fill date
|
|---|
| 12 | G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
|
|---|
| 13 | ;
|
|---|
| 14 | 2 S PSOREF("FLD")=2,PSORX("MAIL/WINDOW")="MAIL" D MW^PSODIR3(.PSOREF)
|
|---|
| 15 | G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
|
|---|
| 16 | ;
|
|---|
| 17 | 3 I $G(DUZ("AG"))="I" S PSOREF("FLD")=3 D CLERK^PSODIR3(.PSOREF) ; Get Clerk Code
|
|---|
| 18 | G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
|
|---|
| 19 | ;
|
|---|
| 20 | 4 I $G(DUZ("AG"))="I" S PSOREF("FLD")=4 D EXP^PSODIR3(.PSOREF) ; Get Expiration Date - Indian Health Service ONLY
|
|---|
| 21 | G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
|
|---|
| 22 | ;
|
|---|
| 23 | END ;
|
|---|
| 24 | K PSOREF1
|
|---|
| 25 | Q
|
|---|
| 26 | JUMP ;
|
|---|
| 27 | S PSOREF("FIELD")=$S(+Y=22:1,+Y=11:2,+Y=16:3,+Y=29:4,1:PSOREF("FLD"))
|
|---|
| 28 | I PSOREF("FIELD")>PSOREF("FLD") W !,$C(7),"Cannot jump ahead ..",! S PSOREF("FIELD")=PSOREF("FLD")
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | EN(PSOREF) ;
|
|---|
| 32 | D START
|
|---|
| 33 | Q
|
|---|
| 34 | LOOK ;this entry is used to try and find current med order
|
|---|
| 35 | S (PSOY,STA,PSOX)="",DRUG=$P(^PSDRUG($P(^PSRX(PSOREF("IRXN"),0),"^",6),0),"^")
|
|---|
| 36 | I $G(PSOSD) W "Looking..." F S STA=$O(PSOSD(STA)) Q:STA="" F S PSOX=$O(PSOSD(STA,PSOX)) Q:PSOX']"" W "." I DRUG=PSOX,+PSOSD(STA,PSOX) S PSOY=PSOSD(STA,PSOX),PSOREF("IRXN")=+PSOSD(STA,PSOX),PSODF=1,PSOBBC("DONE")=PSOREF("IRXN")_"," Q
|
|---|
| 37 | W ! K DRUG Q
|
|---|
