APSPRXV.m

APSPRXV ; IHS/DSD/ENM - BHAM ISC/SAB/ENM - VIEW OF A PRESCRIPTION ;  [ 09/03/97   1:30 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 S PS="VIEW"

A1 ;W ! S APSPQ="",DIC("S")="I $P(^PSRX(X,0),""^"",15)'=13",DIC=52,DIC(0)="QEAM",DIC("A")="Enter PRESCRIPTION #: " D ^DIC K DIC,DIC("A")  ;G KILL:X=""!(X="^") G A1:Y<0 S DA=+Y,APSPX=+Y ;IHS/DSD/ENM 05/24/96

 ;I X=""!(X="^") S APSPQ=1 G KILL ;IHS/DSD/ENM 05/24/96

 S APSPQ="",DA=PSORXED("IRXN"),APSPX=PSORXED("IRXN"),X=PSORXED("IRXN")

 ;G A1:Y<0 S DA=+Y,APSPX=+Y ;IHS/DSD/ENM 05/24/96

 I $G(PSODIV),PS'="VIEW",$P($G(^PSRX(DA,2)),"^",9)'=PSOSITE S PSPOP=0,PSPRXN=DA D CHK1^PSOUTLA G:PSPOP A1

 K PSPOP,PSPRXN ;D OUT Q

OUT ;

 S APSPLTYP="P" D ^PSORXPR Q  ;IHS/DSD/ENM 1.20.95

ASK W !!,PS D YN^DICN S X=% I %Y["?" W !!,"Enter 'Y' for 'Yes' or Press Return for 'No'",! S %=2 G ASK

 S:%=2 X="^"

 Q

A11 I PSODIV,$D(^PSRX(DA,2)),+$P(^(2),"^",9),+$P(^(2),"^",9)'=PSOSITE S PSPOP=0,PSPRXN=DA D CHK^PSOUTLA Q:PSPOP

 K PSPOP,PSPRXN S %=1 D OUT1 S:PS="REINSTATE" PS="CANCEL" Q

OUT1 D ^PSORXPR S %=2 Q

 ;

KILL I PS="VIEW" K %,DA,DIC,I,II,J,N,PHYS,PS,RFDATE,RFL,RFL1,ST,ST0,X,Y,Z,RFLL

 Q

APSPRXV   ; IHS/DSD/ENM - BHAM ISC/SAB/ENM - VIEW OF A PRESCRIPTION ;  [ 09/03/97   1:30 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 +2        SET PS="VIEW"

A1        ;W ! S APSPQ="",DIC("S")="I $P(^PSRX(X,0),""^"",15)'=13",DIC=52,DIC(0)="QEAM",DIC("A")="Enter PRESCRIPTION #: " D ^DIC K DIC,DIC("A")  ;G KILL:X=""!(X="^") G A1:Y<0 S DA=+Y,APSPX=+Y ;IHS/DSD/ENM 05/24/96

 +1       ;I X=""!(X="^") S APSPQ=1 G KILL ;IHS/DSD/ENM 05/24/96

 +2        SET APSPQ=""

           SET DA=PSORXED("IRXN")

           SET APSPX=PSORXED("IRXN")

           SET X=PSORXED("IRXN")

 +3       ;G A1:Y<0 S DA=+Y,APSPX=+Y ;IHS/DSD/ENM 05/24/96

 +4        IF $GET(PSODIV)

               IF PS'="VIEW"

                   IF $PIECE($GET(^PSRX(DA,2)),"^",9)'=PSOSITE

                       SET PSPOP=0

                       SET PSPRXN=DA

                       DO CHK1^PSOUTLA

                       IF PSPOP

                           GOTO A1

 +5       ;D OUT Q

           KILL PSPOP,PSPRXN

OUT       ;

 +1       ;IHS/DSD/ENM 1.20.95

           SET APSPLTYP="P"

           DO ^PSORXPR

           QUIT 

ASK        WRITE !!,PS

           DO YN^DICN

           SET X=%

           IF %Y["?"

               WRITE !!,"Enter 'Y' for 'Yes' or Press Return for 'No'",!

               SET %=2

               GOTO ASK

 +1        IF %=2

               SET X="^"

 +2        QUIT 

A11        IF PSODIV

               IF $DATA(^PSRX(DA,2))

                   IF +$PIECE(^(2),"^",9)

                       IF +$PIECE(^(2),"^",9)'=PSOSITE

                           SET PSPOP=0

                           SET PSPRXN=DA

                           DO CHK^PSOUTLA

                           IF PSPOP

                               QUIT 

 +1        KILL PSPOP,PSPRXN

           SET %=1

           DO OUT1

           IF PS="REINSTATE"

               SET PS="CANCEL"

           QUIT 

OUT1       DO ^PSORXPR

           SET %=2

           QUIT 

 +1       ;

KILL       IF PS="VIEW"

               KILL %,DA,DIC,I,II,J,N,PHYS,PS,RFDATE,RFL,RFL1,ST,ST0,X,Y,Z,RFLL

 +1        QUIT