- 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
