APSPMAN2.m

APSPMAN2 ; IHS/DSD/ENM - MANUFACTURER DATA FOR RENEWED RX'S ;  [ 05/26/98  11:43 AM ]

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

EP ;ENTRY POINT FOR RENEWING RX

 I APSPMAN'=1 Q

 S (APSPMM,APSPL,APSPD)=""

 I $D(^PSRX(PSORENW("OIRXN"),1,0)) S LASTRF=$P(^(0),"^",3) D LAST

 I APSPMM]""!(APSPL]"")!(APSPD]"") G WR

 I $G(PSORENW("RX2"))']"" G ACT

 S APSPMM=$P($G(PSORENW("RX2")),"^",8),APSPL=$P($G(PSORENW("RX2")),"^",4),APSPD=$P($G(PSORENW("RX2")),"^",11) G WR

 ;************************************************************

LAST ;CK MAN DATA IN LAST REFILL

 S APSPLRF=^PSRX(PSORENW("OIRXN"),1,LASTRF,0)

 S APSPMM=$P(APSPLRF,"^",14),APSPL=$P(APSPLRF,"^",6),APSPD=$P(APSPLRF,"^",15)

 Q

 ;************************************************************

WR W !,"Manufacturer: ",APSPMM,?30,"Lot #: ",APSPL,?50,"Mfg Expiration Date: "_$E(APSPD,4,5)_"/"_$E(APSPD,2,3)

ACT S DIR(0)="Y",DIR("A")="Edit Manufacturer Data? :",DIR("B")="N",DIR("?")="Answer 'Yes' if the Manufacturer, Lot # or Expiration date has changed" D ^DIR K DIR I Y=1 S APSPRXX=$P(PSORENW("RX0"),U,6) D ASK^APSPMAN G OUT

DTO ;S APSPRXX=$P(PSORENW("RX0"),U,6) D MAN2^APSPMAN ;IHS/DSD/ENM 10/29/97

 S APSPRXX=$P(PSORENW("RX0"),U,6) D EP1^APSPMAN ;IHS/DSD/ENM 10/29/97 ;IHS/OKCAO/POC 5/26/98

OUT ;SET VARIABLES FOR PSOR52 GLOBAL SET

 S PSORENW("LOT #")=PSONEW("LOT #"),PSORENW("MANUFACTURER")=PSONEW("MANUFACTURER"),PSORENW("EXPIRATION DATE")=PSONEW("EXPIRATION DATE")

 ;GET LABEL VARIABLE DATA

 S APSPMF=$E(PSONEW("MANUFACTURER"),1,5),APSPLOT=$E(PSONEW("LOT #"),1,8),APSPDY=$E(PSONEW("EXPIRATION DATE"),4,5)_"/"_$E(PSONEW("EXPIRATION DATE"),2,3)

 Q

APSPMAN2  ; IHS/DSD/ENM - MANUFACTURER DATA FOR RENEWED RX'S ;  [ 05/26/98  11:43 AM ]

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

EP        ;ENTRY POINT FOR RENEWING RX

 +1        IF APSPMAN'=1

               QUIT 

 +2        SET (APSPMM,APSPL,APSPD)=""

 +3        IF $DATA(^PSRX(PSORENW("OIRXN"),1,0))

               SET LASTRF=$PIECE(^(0),"^",3)

               DO LAST

 +4        IF APSPMM]""!(APSPL]"")!(APSPD]"")

               GOTO WR

 +5        IF $GET(PSORENW("RX2"))']""

               GOTO ACT

 +6        SET APSPMM=$PIECE($GET(PSORENW("RX2")),"^",8)

           SET APSPL=$PIECE($GET(PSORENW("RX2")),"^",4)

           SET APSPD=$PIECE($GET(PSORENW("RX2")),"^",11)

           GOTO WR

 +7       ;************************************************************

LAST      ;CK MAN DATA IN LAST REFILL

 +1        SET APSPLRF=^PSRX(PSORENW("OIRXN"),1,LASTRF,0)

 +2        SET APSPMM=$PIECE(APSPLRF,"^",14)

           SET APSPL=$PIECE(APSPLRF,"^",6)

           SET APSPD=$PIECE(APSPLRF,"^",15)

 +3        QUIT 

 +4       ;************************************************************

WR         WRITE !,"Manufacturer: ",APSPMM,?30,"Lot #: ",APSPL,?50,"Mfg Expiration Date: "_$EXTRACT(APSPD,4,5)_"/"_$EXTRACT(APSPD,2,3)

ACT        SET DIR(0)="Y"

           SET DIR("A")="Edit Manufacturer Data? :"

           SET DIR("B")="N"

           SET DIR("?")="Answer 'Yes' if the Manufacturer, Lot # or Expiration date has changed"

           DO ^DIR

           KILL DIR

           IF Y=1

               SET APSPRXX=$PIECE(PSORENW("RX0"),U,6)

               DO ASK^APSPMAN

               GOTO OUT

DTO       ;S APSPRXX=$P(PSORENW("RX0"),U,6) D MAN2^APSPMAN ;IHS/DSD/ENM 10/29/97

 +1       ;IHS/DSD/ENM 10/29/97 ;IHS/OKCAO/POC 5/26/98

           SET APSPRXX=$PIECE(PSORENW("RX0"),U,6)

           DO EP1^APSPMAN

OUT       ;SET VARIABLES FOR PSOR52 GLOBAL SET

 +1        SET PSORENW("LOT #")=PSONEW("LOT #")

           SET PSORENW("MANUFACTURER")=PSONEW("MANUFACTURER")

           SET PSORENW("EXPIRATION DATE")=PSONEW("EXPIRATION DATE")

 +2       ;GET LABEL VARIABLE DATA

 +3        SET APSPMF=$EXTRACT(PSONEW("MANUFACTURER"),1,5)

           SET APSPLOT=$EXTRACT(PSONEW("LOT #"),1,8)

           SET APSPDY=$EXTRACT(PSONEW("EXPIRATION DATE"),4,5)_"/"_$EXTRACT(PSONEW("EXPIRATION DATE"),2,3)

 +4        QUIT