Routine: PSOREF1

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

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")

EN(PSOREF)         ;

 D START

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

PSOREF1.m