PSOREF2 ;ISC-BIRM/SAB - asks all questions for barcode refill rx order entry ; 09/30/96
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
;
START ;
S (PSOREF("DFLG"),PSOREF("FIELD"),PSOREF1)=0
S X1=DT,X2=-180 D C^%DTC S PSOREF("ISSUE DATE")=X
S:$G(PSORX("BAR CODE"))&($G(PSOBBC1("FROM"))="NEW") PSOREF("ISSUE DATE")=DT
K X,X1,X2
;
;
1 S PSOREF("FLD")=1 D FILLDT^PSODIR3(.PSOREF) ; Get Fill date
G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
;
2 S PSOREF("FLD")=2,PSORX("MAIL/WINDOW")="MAIL" D MW^PSODIR3(.PSOREF)
G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
;
3 I $G(DUZ("AG"))="I" S PSOREF("FLD")=3 D CLERK^PSODIR3(.PSOREF) ; Get Clerk Code
G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
;
4 I $G(DUZ("AG"))="I" S PSOREF("FLD")=4 D EXP^PSODIR3(.PSOREF) ; Get Expiration Date - Indian Health Service ONLY
G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
;
END ;
K PSOREF1
Q
JUMP ;
S PSOREF("FIELD")=$S(+Y=22:1,+Y=11:2,+Y=16:3,+Y=29:4,1:PSOREF("FLD"))
I PSOREF("FIELD")>PSOREF("FLD") W !,$C(7),"Cannot jump ahead ..",! S PSOREF("FIELD")=PSOREF("FLD")
Q
;
EN(PSOREF) ;
D START
Q
LOOK ;this entry is used to try and find current med order
S (PSOY,STA,PSOX)="",DRUG=$P(^PSDRUG($P(^PSRX(PSOREF("IRXN"),0),"^",6),0),"^")
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
W ! K DRUG Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOREF2 1560 printed Oct 16, 2024@18:34:08 Page 2
PSOREF2 ;ISC-BIRM/SAB - asks all questions for barcode refill rx order entry ; 09/30/96
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
+2 ;
START ;
+1 SET (PSOREF("DFLG"),PSOREF("FIELD"),PSOREF1)=0
+2 SET X1=DT
SET X2=-180
DO C^%DTC
SET PSOREF("ISSUE DATE")=X
+3 if $GET(PSORX("BAR CODE"))&($GET(PSOBBC1("FROM"))="NEW")
SET PSOREF("ISSUE DATE")=DT
+4 KILL X,X1,X2
+5 ;
+6 ;
1 ; Get Fill date
SET PSOREF("FLD")=1
DO FILLDT^PSODIR3(.PSOREF)
+1 if PSOREF("DFLG")
GOTO END
if PSOREF("FIELD")
GOTO @PSOREF("FIELD")
+2 ;
2 SET PSOREF("FLD")=2
SET PSORX("MAIL/WINDOW")="MAIL"
DO MW^PSODIR3(.PSOREF)
+1 if PSOREF("DFLG")
GOTO END
if PSOREF("FIELD")
GOTO @PSOREF("FIELD")
+2 ;
3 ; Get Clerk Code
IF $GET(DUZ("AG"))="I"
SET PSOREF("FLD")=3
DO CLERK^PSODIR3(.PSOREF)
+1 if PSOREF("DFLG")
GOTO END
if PSOREF("FIELD")
GOTO @PSOREF("FIELD")
+2 ;
4 ; Get Expiration Date - Indian Health Service ONLY
IF $GET(DUZ("AG"))="I"
SET PSOREF("FLD")=4
DO EXP^PSODIR3(.PSOREF)
+1 if PSOREF("DFLG")
GOTO END
if PSOREF("FIELD")
GOTO @PSOREF("FIELD")
+2 ;
END ;
+1 KILL PSOREF1
+2 QUIT
JUMP ;
+1 SET PSOREF("FIELD")=$SELECT(+Y=22:1,+Y=11:2,+Y=16:3,+Y=29:4,1:PSOREF("FLD"))
+2 IF PSOREF("FIELD")>PSOREF("FLD")
WRITE !,$CHAR(7),"Cannot jump ahead ..",!
SET PSOREF("FIELD")=PSOREF("FLD")
+3 QUIT
+4 ;
EN(PSOREF) ;
+1 DO START
+2 QUIT
LOOK ;this entry is used to try and find current med order
+1 SET (PSOY,STA,PSOX)=""
SET DRUG=$PIECE(^PSDRUG($PIECE(^PSRX(PSOREF("IRXN"),0),"^",6),0),"^")
+2 IF $GET(PSOSD)
WRITE "Looking..."
FOR
SET STA=$ORDER(PSOSD(STA))
if STA=""
QUIT
FOR
SET PSOX=$ORDER(PSOSD(STA,PSOX))
if PSOX']""
QUIT
WRITE "."
IF DRUG=PSOX
IF +PSOSD(STA,PSOX)
SET PSOY=PSOSD(STA,PSOX)
SET PSOREF("IRXN")=+PSOSD(STA,PSOX)
SET PSODF=1
SET PSOBBC("DONE")=PSOREF("IRXN")_","
QUIT
+3 WRITE !
KILL DRUG
QUIT
