PSOREF1 ;IHS/DSD/JCM-ASKS ALL QUESTIONS FOR REFILL RX ORDER ENTRY ;12/08/92 7:54 PM
;;7.0;OUTPATIENT PHARMACY;**26**;DEC 1997
;External reference ^PSDRUG( supported by DBIA 221
START ;
S (PSOREF("DFLG"),PSOREF("FIELD"),PSOREF1)=0
S X="T-6M",%DT="X" D ^%DT
S (PSOID,PSOREF("ISSUE DATE"))=$S($P(^PSRX(PSOREF("IRXN"),0),"^",13)<Y:Y,1:$P(^PSRX(PSOREF("IRXN"),0),"^",13))
S:$G(PSORX("BAR CODE"))&($G(PSOBBC1("FROM"))="NEW") PSOREF("ISSUE DATE")=DT
K X,X1,X2
S PSOREF("CS")=0,PSODRUG("DEA")=$P(^PSDRUG($P(^PSRX(PSOREF("IRXN"),0),"^",6),0),"^",3)
F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S $P(PSOREF("CS"),"^")=1 S:$E(+PSODRUG("DEA"),DEA)=2 $P(PSOREF("CS"),"^",2)=1
;
;
1 S PSONEW("DAYS SUPPLY")=$P(^PSRX(PSOREF("IRXN"),0),"^",8),PSONEW("# OF REFILLS")=$P(^(0),"^",9)
S PSOREF("FLD")=1 D FILLDT^PSODIR2(.PSOREF) ; Get Fill date
G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
;
2 S PSOREF("FLD")=2,PSORX("MAIL/WINDOW")="MAIL" D MW^PSODIR2(.PSOREF)
G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
;
3 I $G(DUZ("AG"))="I" S PSOREF("FLD")=3 D CLERK^PSODIR2(.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^PSODIR2(.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
PROFILE ;
S (PSORX("REFILL"),PSORX("RENEW"))=0,PSOX=""
D ^PSOBUILD
I '$G(PSOSD) W !,"This patient has no prescriptions" S:'$D(DFN) DFN=PSODFN D GMRA^PSODEM G PROFILEX
S (PSODRG,PSOX)="" F S PSODRG=$O(PSOSD(PSODRG)) Q:PSODRG="" F S PSOX=$O(PSOSD(PSODRG,PSOX)) Q:PSOX="" S:$P(PSOSD(PSODRG,PSOX),"^",3)="" PSORX("RENEW")=1 S:$P(PSOSD(PSODRG,PSOX),"^",4)="" PSORX("REFILL")=1
K PSOX
PROFILEX Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOREF1 2072 printed Oct 16, 2024@18:34:07 Page 2
PSOREF1 ;IHS/DSD/JCM-ASKS ALL QUESTIONS FOR REFILL RX ORDER ENTRY ;12/08/92 7:54 PM
+1 ;;7.0;OUTPATIENT PHARMACY;**26**;DEC 1997
+2 ;External reference ^PSDRUG( supported by DBIA 221
START ;
+1 SET (PSOREF("DFLG"),PSOREF("FIELD"),PSOREF1)=0
+2 SET X="T-6M"
SET %DT="X"
DO ^%DT
+3 SET (PSOID,PSOREF("ISSUE DATE"))=$SELECT($PIECE(^PSRX(PSOREF("IRXN"),0),"^",13)<Y:Y,1:$PIECE(^PSRX(PSOREF("IRXN"),0),"^",13))
+4 if $GET(PSORX("BAR CODE"))&($GET(PSOBBC1("FROM"))="NEW")
SET PSOREF("ISSUE DATE")=DT
+5 KILL X,X1,X2
+6 SET PSOREF("CS")=0
SET PSODRUG("DEA")=$PIECE(^PSDRUG($PIECE(^PSRX(PSOREF("IRXN"),0),"^",6),0),"^",3)
+7 FOR DEA=1:1
if $EXTRACT(PSODRUG("DEA"),DEA)=""
QUIT
IF $EXTRACT(+PSODRUG("DEA"),DEA)>1
IF $EXTRACT(+PSODRUG("DEA"),DEA)<6
SET $PIECE(PSOREF("CS"),"^")=1
if $EXTRACT(+PSODRUG("DEA"),DEA)=2
SET $PIECE(PSOREF("CS"),"^",2)=1
+8 ;
+9 ;
1 SET PSONEW("DAYS SUPPLY")=$PIECE(^PSRX(PSOREF("IRXN"),0),"^",8)
SET PSONEW("# OF REFILLS")=$PIECE(^(0),"^",9)
+1 ; Get Fill date
SET PSOREF("FLD")=1
DO FILLDT^PSODIR2(.PSOREF)
+2 if PSOREF("DFLG")
GOTO END
if PSOREF("FIELD")
GOTO @PSOREF("FIELD")
+3 ;
2 SET PSOREF("FLD")=2
SET PSORX("MAIL/WINDOW")="MAIL"
DO MW^PSODIR2(.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^PSODIR2(.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^PSODIR2(.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
PROFILE ;
+1 SET (PSORX("REFILL"),PSORX("RENEW"))=0
SET PSOX=""
+2 DO ^PSOBUILD
+3 IF '$GET(PSOSD)
WRITE !,"This patient has no prescriptions"
if '$DATA(DFN)
SET DFN=PSODFN
DO GMRA^PSODEM
GOTO PROFILEX
+4 SET (PSODRG,PSOX)=""
FOR
SET PSODRG=$ORDER(PSOSD(PSODRG))
if PSODRG=""
QUIT
FOR
SET PSOX=$ORDER(PSOSD(PSODRG,PSOX))
if PSOX=""
QUIT
if $PIECE(PSOSD(PSODRG,PSOX),"^",3)=""
SET PSORX("RENEW")=1
if $PIECE(PSOSD(PSODRG,PSOX),"^",4)=""
SET PSORX("REFILL")=1
+5 KILL PSOX
PROFILEX QUIT
