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