PSORREF1.m

PSORREF1 ;AITC/BWF - Remote RX refill API ;12/3/2013 2:51pm

 ;;7.0;OUTPATIENT PHARMACY;**454**;DEC 1997;Build 349

 ;

 Q

 ; This is a modified copy of PSOREF1, for processing remote prescription requests.

START(FDATE) ;

 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 PSODIR("FILL DATE")=FDATE

 ;

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

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSORREF1   1118     printed  Apr 09, 2024@21:38:18                                                                                                                                                                                                    Page 2

PSORREF1  ;AITC/BWF - Remote RX refill API ;12/3/2013 2:51pm

 +1       ;;7.0;OUTPATIENT PHARMACY;**454**;DEC 1997;Build 349

 +2       ;

 +3        QUIT 

 +4       ; This is a modified copy of PSOREF1, for processing remote prescription requests.

START(FDATE) ;

 +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        SET PSODIR("FILL DATE")=FDATE

 +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       ;