PSOREF2.m

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 ---PSOREF2   1560     printed  Apr 09, 2024@21:31                                                                                                                                                                                                        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