- 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 Feb 18, 2025@23:59:55 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
