PSORENW2.m

PSORENW2 ;IHS/DSD/JCM - displays renew rx information for edit ;05-Apr-2004 19:33;PLS

 ;;7.0;OUTPATIENT PHARMACY;**46,103**;DEC 1997

 ; This routine displays the entered new rx information and

 ; asks if correct, if not allows editing of the data.

 ;------------------------------------------------------------

 ; Modified - IHS/CIA/PLS - 01/06/04 - Line DISPLAY+4

START ;

 S (PSORENW("DFLG"),PSORENW2("QFLG"))=0

 D DISPLAY ; Displays information

 D ASK G:PSORENW2("QFLG")!PSORENW("DFLG") END

EN D EDIT

 G:'$G(PSORX("FN")) START

END D EOJ

 Q

 ;------------------------------------------------------------

DISPLAY ;

 W !!,"Rx # ",PSORENW("NRX #")

 W ?23,$E(PSORENW("FILL DATE"),4,5),"/",$E(PSORENW("FILL DATE"),6,7),"/",$E(PSORENW("FILL DATE"),2,3)

 W !,$G(PSORX("NAME")),?30,"#",PSORENW("QTY")

 ; IHS/CIA/PLS - 01/06/04 - Added NDC, AWP and COST

 W ?45,"NDC ",PSORENW("NDC")

 W " ("_PSORENW("AWP")_")"

 W " ("_PSORENW("COST")_")"

 S X=PSORENW("SIG") D SIGONE^PSOHELP W !,$E($G(INS1),2,250),!!,$S($G(PSODRUG("TRADE NAME"))]"":PSODRUG("TRADE NAME"),1:PSODRUG("NAME"))

 W !,PSORENW("PROVIDER NAME"),?25,PSORX("CLERK CODE")

 W !,"# of Refills: ",PSORENW("# OF REFILLS"),!

 Q

 ;

ASK ;

 K DIR,X,Y

 S DIR("A")="Is this correct",DIR(0)="Y",DIR("B")=$S(+$G(PSEXDT):"NO",1:"YES") D ^DIR K DIR

 I $D(DIRUT) S PSORENW("DFLG")=1 G ASKX

 I Y,+$G(PSEXDT) D  K PSOELSE G ASKX

 .K PSOELSE I $G(POERR) S PSOELSE=1 D

 ..S Y=PSORENW("FILL DATE") X ^DD("DD") S VALMSG=Y_" fill date is greater than possible expiration date of "

 ..S Y=$P(PSEXDT,"^",2) X ^DD("DD") S VALMSG=VALMSG_Y_"."

 .I '$G(PSOELSE) D

 ..S Y=PSORENW("FILL DATE") X ^DD("DD") W !!,$C(7),Y_" fill date is greater than possible expiration date of "

 ..S Y=$P(PSEXDT,"^",2) X ^DD("DD") W Y_".",!

 I Y S PSORENW2("QFLG")=1

ASKX K X,Y,DIRUT,DTOUT,DUOUT,SIG

 Q

 ;

EDIT ;

 S PSORX("EDIT")=1

 D INIT^PSORENW3,EN^PSOORNE4(.PSORENW),STOP^PSORENW1 ;D EN^PSORENW2

 ;D ^PSORENW3

 S PSORENW("DFLG")=0

 Q

 ;

EOJ ;

 K PSORENW2,PSORX("EDIT"),PSORENW("EDIT"),PSOQUIT

 Q

PSORENW2  ;IHS/DSD/JCM - displays renew rx information for edit ;05-Apr-2004 19:33;PLS

 +1       ;;7.0;OUTPATIENT PHARMACY;**46,103**;DEC 1997

 +2       ; This routine displays the entered new rx information and

 +3       ; asks if correct, if not allows editing of the data.

 +4       ;------------------------------------------------------------

 +5       ; Modified - IHS/CIA/PLS - 01/06/04 - Line DISPLAY+4

START     ;

 +1        SET (PSORENW("DFLG"),PSORENW2("QFLG"))=0

 +2       ; Displays information

           DO DISPLAY

 +3        DO ASK

           IF PSORENW2("QFLG")!PSORENW("DFLG")

               GOTO END

EN         DO EDIT

 +1        IF '$GET(PSORX("FN"))

               GOTO START

END        DO EOJ

 +1        QUIT 

 +2       ;------------------------------------------------------------

DISPLAY   ;

 +1        WRITE !!,"Rx # ",PSORENW("NRX #")

 +2        WRITE ?23,$EXTRACT(PSORENW("FILL DATE"),4,5),"/",$EXTRACT(PSORENW("FILL DATE"),6,7),"/",$EXTRACT(PSORENW("FILL DATE"),2,3)

 +3        WRITE !,$GET(PSORX("NAME")),?30,"#",PSORENW("QTY")

 +4       ; IHS/CIA/PLS - 01/06/04 - Added NDC, AWP and COST

 +5        WRITE ?45,"NDC ",PSORENW("NDC")

 +6        WRITE " ("_PSORENW("AWP")_")"

 +7        WRITE " ("_PSORENW("COST")_")"

 +8        SET X=PSORENW("SIG")

           DO SIGONE^PSOHELP

           WRITE !,$EXTRACT($GET(INS1),2,250),!!,$SELECT($GET(PSODRUG("TRADE NAME"))]"":PSODRUG("TRADE NAME"),1:PSODRUG("NAME"))

 +9        WRITE !,PSORENW("PROVIDER NAME"),?25,PSORX("CLERK CODE")

 +10       WRITE !,"# of Refills: ",PSORENW("# OF REFILLS"),!

 +11       QUIT 

 +12      ;

ASK       ;

 +1        KILL DIR,X,Y

 +2        SET DIR("A")="Is this correct"

           SET DIR(0)="Y"

           SET DIR("B")=$SELECT(+$GET(PSEXDT):"NO",1:"YES")

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               SET PSORENW("DFLG")=1

               GOTO ASKX

 +4        IF Y

               IF +$GET(PSEXDT)

                   Begin DoDot:1

 +5                    KILL PSOELSE

                       IF $GET(POERR)

                           SET PSOELSE=1

                           Begin DoDot:2

 +6                            SET Y=PSORENW("FILL DATE")

                               XECUTE ^DD("DD")

                               SET VALMSG=Y_" fill date is greater than possible expiration date of "

 +7                            SET Y=$PIECE(PSEXDT,"^",2)

                               XECUTE ^DD("DD")

                               SET VALMSG=VALMSG_Y_"."

                           End DoDot:2

 +8                    IF '$GET(PSOELSE)

                           Begin DoDot:2

 +9                            SET Y=PSORENW("FILL DATE")

                               XECUTE ^DD("DD")

                               WRITE !!,$CHAR(7),Y_" fill date is greater than possible expiration date of "

 +10                           SET Y=$PIECE(PSEXDT,"^",2)

                               XECUTE ^DD("DD")

                               WRITE Y_".",!

                           End DoDot:2

                   End DoDot:1

                   KILL PSOELSE

                   GOTO ASKX

 +11       IF Y

               SET PSORENW2("QFLG")=1

ASKX       KILL X,Y,DIRUT,DTOUT,DUOUT,SIG

 +1        QUIT 

 +2       ;

EDIT      ;

 +1        SET PSORX("EDIT")=1

 +2       ;D EN^PSORENW2

           DO INIT^PSORENW3

           DO EN^PSOORNE4(.PSORENW)

           DO STOP^PSORENW1

 +3       ;D ^PSORENW3

 +4        SET PSORENW("DFLG")=0

 +5        QUIT 

 +6       ;

EOJ       ;

 +1        KILL PSORENW2,PSORX("EDIT"),PSORENW("EDIT"),PSOQUIT

 +2        QUIT