APSQMAN.m

APSQMAN ; IHS/DSD/ENM/POC - PROCESS RX MANUFACT DATA 12-94 ;  

 ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001

EP ;EP

 S APSPRXX=$P(PSOY,U,1)

 ;CK PARAM AND SET MAN VARIABLE(S)

EP1 ;EP

 I APSPMAN=""!(APSPMAN=3) D NOMAN Q  ;NO MFG DATA REQUIRED

 ;I APSPMAN=2 D MAN2 ;DATE ONLY PATH

 ;I APSPMAN=1 D ASK ;ALL MFG DATA REQUIRED

 Q

ASK ;EP - ASK FOR MFG NAME,LOT #, MFG EXP DT

 S DA=APSPRXX,DR="9999999.24:9999999.26",DIE="^PSDRUG("

 D ^DIE,MANS

 Q

MAN2 ;EP - ASK/DSPL MFG EXP DATE ONLY

 S DA=APSPRXX,DR="9999999.26",DIE="^PSDRUG("

 D ^DIE

MANS S APSPM0=$G(^PSDRUG(APSPRXX,999999924))

 S PSONEW("LOT #")=$P($G(APSPM0),U,2),APSP1=$P($G(APSPM0),U),PSONEW("EXPIRATION DATE")=$P($G(APSPM0),U,3),P(99)=$P($G(APSPM0),U,3)

 I APSP1']"" S APSP2="" G BP

 S APSP2=$P($G(^PS(55.95,APSP1,0)),U)

BP S PSONEW("MANUFACTURER")=APSP2

 S APSPPMF=APSP2,APSPPLOT=PSONEW("LOT #"),APSPPDY=PSONEW("EXPIRATION DATE")

 Q

NOMAN ;EP

 S PSONEW("LOT #")="",PSONEW("EXPIRATION DATE")="",P(99)=""

 S PSONEW("MANUFACTURER")=""

 S APSPPMF="",APSPPLOT="",APSPPDY=""

 Q

LBL ;EP - Called by APSPLBL for label man data

 I APSPMAN=""!(APSPMAN=3) D NMFG Q

 I APSPMAN=2 D LBDT Q

 I $G(APSPLTYP)="R" S APSPLOT=$E(APSPPLOT,1,8),APSPMF=$E(APSPPMF,1,7),APSPDY=$E(APSPPDY,4,5)_"/"_$E(APSPPDY,2,3) Q

 S APSPM0=$G(^PSRX(RX,2)),APSP("LOT")=$P(APSPM0,U,4),APSP("MANF")=$P(APSPM0,U,8),APSP("MANXDT")=$P(APSPM0,U,11)

 S APSPLOT=$E(APSP("LOT"),1,8),APSPMF=$E(APSP("MANF"),1,5),APSPDY=$E(APSP("MANXDT"),4,5)_"/"_$E(APSP("MANXDT"),2,3)

 Q

LBDT ;Called by APSPLBL for Ex Date only

 I $G(APSPLTYP)="R",$G(APSPPDY)']"" S (APSPLOT,APSPMF,APSPDY)="" Q

 I $G(APSPLTYP)="R" S (APSPLOT,APSPMF)="",APSPDY=$E($G(APSPPDY),4,5)_"/"_$E($G(APSPPDY),2,3) Q

 S APSP("MANXDT")=$P($G(^PSRX(RX,2)),U,11)

 S APSPLOT="",APSPMF="",APSPDY=$E(APSP("MANXDT"),4,5)_"/"_$E(APSP("MANXDT"),2,3)

 Q

NMFG S (APSPLOT,APSPMF,APSPDY)="" Q

 Q

APSQMAN   ; IHS/DSD/ENM/POC - PROCESS RX MANUFACT DATA 12-94 ;  

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001

EP        ;EP

 +1        SET APSPRXX=$PIECE(PSOY,U,1)

 +2       ;CK PARAM AND SET MAN VARIABLE(S)

EP1       ;EP

 +1       ;NO MFG DATA REQUIRED

           IF APSPMAN=""!(APSPMAN=3)

               DO NOMAN

               QUIT 

 +2       ;I APSPMAN=2 D MAN2 ;DATE ONLY PATH

 +3       ;I APSPMAN=1 D ASK ;ALL MFG DATA REQUIRED

 +4        QUIT 

ASK       ;EP - ASK FOR MFG NAME,LOT #, MFG EXP DT

 +1        SET DA=APSPRXX

           SET DR="9999999.24:9999999.26"

           SET DIE="^PSDRUG("

 +2        DO ^DIE

           DO MANS

 +3        QUIT 

MAN2      ;EP - ASK/DSPL MFG EXP DATE ONLY

 +1        SET DA=APSPRXX

           SET DR="9999999.26"

           SET DIE="^PSDRUG("

 +2        DO ^DIE

MANS       SET APSPM0=$GET(^PSDRUG(APSPRXX,999999924))

 +1        SET PSONEW("LOT #")=$PIECE($GET(APSPM0),U,2)

           SET APSP1=$PIECE($GET(APSPM0),U)

           SET PSONEW("EXPIRATION DATE")=$PIECE($GET(APSPM0),U,3)

           SET P(99)=$PIECE($GET(APSPM0),U,3)

 +2        IF APSP1']""

               SET APSP2=""

               GOTO BP

 +3        SET APSP2=$PIECE($GET(^PS(55.95,APSP1,0)),U)

BP         SET PSONEW("MANUFACTURER")=APSP2

 +1        SET APSPPMF=APSP2

           SET APSPPLOT=PSONEW("LOT #")

           SET APSPPDY=PSONEW("EXPIRATION DATE")

 +2        QUIT 

NOMAN     ;EP

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

           SET PSONEW("EXPIRATION DATE")=""

           SET P(99)=""

 +2        SET PSONEW("MANUFACTURER")=""

 +3        SET APSPPMF=""

           SET APSPPLOT=""

           SET APSPPDY=""

 +4        QUIT 

LBL       ;EP - Called by APSPLBL for label man data

 +1        IF APSPMAN=""!(APSPMAN=3)

               DO NMFG

               QUIT 

 +2        IF APSPMAN=2

               DO LBDT

               QUIT 

 +3        IF $GET(APSPLTYP)="R"

               SET APSPLOT=$EXTRACT(APSPPLOT,1,8)

               SET APSPMF=$EXTRACT(APSPPMF,1,7)

               SET APSPDY=$EXTRACT(APSPPDY,4,5)_"/"_$EXTRACT(APSPPDY,2,3)

               QUIT 

 +4        SET APSPM0=$GET(^PSRX(RX,2))

           SET APSP("LOT")=$PIECE(APSPM0,U,4)

           SET APSP("MANF")=$PIECE(APSPM0,U,8)

           SET APSP("MANXDT")=$PIECE(APSPM0,U,11)

 +5        SET APSPLOT=$EXTRACT(APSP("LOT"),1,8)

           SET APSPMF=$EXTRACT(APSP("MANF"),1,5)

           SET APSPDY=$EXTRACT(APSP("MANXDT"),4,5)_"/"_$EXTRACT(APSP("MANXDT"),2,3)

 +6        QUIT 

LBDT      ;Called by APSPLBL for Ex Date only

 +1        IF $GET(APSPLTYP)="R"

               IF $GET(APSPPDY)']""

                   SET (APSPLOT,APSPMF,APSPDY)=""

                   QUIT 

 +2        IF $GET(APSPLTYP)="R"

               SET (APSPLOT,APSPMF)=""

               SET APSPDY=$EXTRACT($GET(APSPPDY),4,5)_"/"_$EXTRACT($GET(APSPPDY),2,3)

               QUIT 

 +3        SET APSP("MANXDT")=$PIECE($GET(^PSRX(RX,2)),U,11)

 +4        SET APSPLOT=""

           SET APSPMF=""

           SET APSPDY=$EXTRACT(APSP("MANXDT"),4,5)_"/"_$EXTRACT(APSP("MANXDT"),2,3)

 +5        QUIT 

NMFG       SET (APSPLOT,APSPMF,APSPDY)=""

           QUIT 

 +1        QUIT