Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APSQMAN

APSQMAN.m

Go to the documentation of this file.
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