APSPMAN1 ; IHS/DSD/ENM - MANUFACTURER DATA FOR REFILL RX'S ; [ 02/20/2001 1:48 PM ]
;;6.0;IHS PHARMACY MODIFICATIONS;**1,3**;09/03/97
EP ;ENTRY POINT - FOR REFILL RX (W/edit 'all' mfg data set to 'yes')
I APSPMAN'=1 Q
S (APSPMM,APSPL,APSPD)=""
;I $D(^PSRX(PSOREF("IRXN"),1,0)) S LASTRF=$P(^(0),"^",3) D LAST
I $P($G(^PSRX(PSOREF("IRXN"),1,0)),"^",3)]"" S LASTRF=$P(^(0),"^",3) D LAST ;IHS/DSD/ENM/POC 01/20/98 PREVENTS ERR WHEN REF DELETED
I APSPMM]""!(APSPL]"")!(APSPD]"") G WR
S APSPLTYP="R"
I $G(PSOREF("RX2"))']"" G ACT
S APSPMM=$P($G(PSOREF("RX2")),"^",8),APSPL=$P($G(PSOREF("RX2")),"^",4),APSPD=$P($G(PSOREF("RX2")),"^",11) G WR
LAST ;CK MAN DATA IN LAST REFILL
S APSPLRF=^PSRX(PSOREF("IRXN"),1,LASTRF,0)
S APSPMM=$P(APSPLRF,"^",14),APSPL=$P(APSPLRF,"^",6),APSPD=$P(APSPLRF,"^",15)
Q
DTO ;EP FOR REFILL RX (W/mfg 'date only' set) IHS/DSD/ENM 01/29/96
S APSPRXX=$P($G(^PSRX(PSOREF("IRXN"),0)),"^",6) Q:APSPRXX']"" ;
S DA=APSPRXX,DR="9999999.26",DIE="^PSDRUG(" D ^DIE
;SET VARIABLES FOR PSOR52 GLOBAL SET
S PSOREF("LOT #")="",PSOREF("MANUFACTURER")="",PSOREF("EXPIRATION DATE")=$P($G(^PSDRUG(APSPRXX,999999924)),"^",3)
;GET LABEL VARIABLE DATA
S APSPMF="",APSPLOT=""
I PSOREF("EXPIRATION DATE")']"" S APSPDY="" Q
S APSPDY=$E(PSOREF("EXPIRATION DATE"),4,5)_"/"_$E(PSOREF("EXPIRATION DATE"),2,3)
Q
NMFG ;EP FOR REFILL RX (W/no mfg set) IHS/DSD/ENM 02/15/96
;SET VARIABLES FOR PSOR52 GLOBAL SET
S PSOREF("LOT #")="",PSOREF("MANUFACTURER")="",PSOREF("EXPIRATION DATE")=""
;GET LABEL VARIABLE DATA
S APSPMF="",APSPLOT=""
S APSPDY=""
Q
WR W !,"Manufacturer: ",APSPMM,?30,"Lot #: ",APSPL,?50,"Mfg Expiration Date: "_$E(APSPD,4,5)_"/"_$E(APSPD,2,3)
ACT I APSPMAN=1 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(PSOREF("RX0"),U,6) D ASK^APSPMAN G OUT
S APSPRXX=$P(PSOREF("RX0"),U,6) D MAN2^APSPMAN
OUT ;SET VARIABLES FOR PSOR52 GLOBAL SET
S PSOREF("LOT #")=PSONEW("LOT #"),PSOREF("MANUFACTURER")=PSONEW("MANUFACTURER"),PSOREF("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)
D EXIT Q
EP1 ;ENTRY POINT FOR EDIT RX OPT
Q:APSPMAN'=1
I $G(APSPLTYP)="V",$G(RX2)']"" S (APSPL,APSPMM,APSPD)="" Q ;IHS/DSD/ENM 09/02/96
I $G(APSPLTYP)="V" S APSPMM=$P($G(RX2),"^",8),APSPL=$P($G(RX2),"^",4),APSPD=$P($G(RX2),"^",11) Q
I $G(PSORXED("RX2"))']"" S (APSPL,APSPMM,APSPD)="" Q
S APSPMM=$P($G(PSORXED("RX2")),"^",8),APSPL=$P($G(PSORXED("RX2")),"^",4),APSPD=$P($G(PSORXED("RX2")),"^",11)
;I APSPLTYP="V" D WR1
I $G(APSPLTYP)="E" D WR1,ACT1 ;IHS/DSD/ENM 09/02/96
Q
;
WR1 W !,"Manufacturer: ",APSPMM,?30,"Lot #: ",APSPL,?50,"Mfg Expiration Date: "_$E(APSPD,4,5)_"/"_$E(APSPD,2,3)
Q
ACT1 ;EP
I APSPMAN=1 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 S APSPYN=Y I Y=1 D ASK^APSPMAN G OUT1
I PS="PARTIAL",$G(APSPYN)'=1 S PSONEW("LOT #")=$G(APSP("PL")),PSONEW("MANUFACTURER")=$G(APSP("PM")),PSONEW("EXPIRATION DATE")=$G(APSP("PD")) ;IHS/DSD/ENM 09/05/96
;W !,"Mfg Expiration Date is required!",!
I APSPMAN=""!(APSPMAN=3) D NOMAN^APSPMAN ;IHS/DSD/ENM 02/15/96
I APSPMAN=2 D MAN2^APSPMAN ;IHS/DSD/ENM 02/15/96
OUT1 ;SET VARIABLES FOR GLOBAL SET
S PSOREF("LOT #")=PSONEW("LOT #"),PSOREF("MANUFACTURER")=PSONEW("MANUFACTURER"),PSOREF("EXPIRATION DATE")=PSONEW("EXPIRATION DATE")
;GET LABEL VARIABLE DATA
I APSPMAN=""!(APSPMAN=3) S (APSPMF,APSPLOT,APSPDY)="" G EXIT ;IHS/DSD/ENM 02/15/96
I APSPMAN=2 S APSPMF="",APSPLOT="",APSPDY=$E(PSONEW("EXPIRATION DATE"),4,5)_"/"_$E(PSONEW("EXPIRATION DATE"),2,3) G EXIT ;IHS/DSD/ENM 02/15/96
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)
G EXIT
DCQ ;CHECK FOR CHNG'ed DATA AFTER EDITING AN RX
Q:APSPMAN<1
S (APSPXED,APSPXMF,APSPXLT)=""
I APSPMAN=1 D ALLCK G DCQX
I APSPMAN=""!(APSPMAN=2) D DTCK
DCQX Q
ALLCK I PSONEW("EXPIRATION DATE")'=$P($G(PSORXED("RX2")),"^",11) S APSPXED=PSONEW("EXPIRATION DATE")
I PSONEW("LOT #")'=$P($G(PSORXED("RX2")),"^",4) S APSPXLT=PSONEW("LOT #")
I PSONEW("MANUFACTURER")'=$P($G(PSORXED("RX2")),"^",8) S APSPXMF=PSONEW("MANUFACTURER")
I APSPXED]"" S DR="29///^S X=APSPXED",COM=COM_$P(^DD(52,29,0),"^")_" ("_APSPXED_"),"
I APSPXLT]"" S DR=DR_";24///^S X=APSPXLT",COM=COM_$P(^DD(52,24,0),"^")_" ("_APSPXLT_"),"
I APSPXMF]"" S DR=DR_";28///^S X=APSPXMF",COM=COM_$P(^DD(52,28,0),"^")_" ("_APSPXMF_"),"
I DR]"" S DIE="^PSRX(",DA=PSORXED("IRXN") D ^DIE K DIE,DR,DA,X,Y
Q
DTCK ;MFG DATE CHECK FOR CHANGE
I PSOREF("EXPIRATION DATE")'=$P($G(PSORXED("RX2")),"^",11) S APSPXED=PSOREF("EXPIRATION DATE")
I APSPXED]"" S DR="29///^S X=APSPXED",COM=COM_$P(^DD(52,29,0),"^")_" ("_APSPXED_"),",DIE="^PSRX(",DA=PSORXED("IRXN") D ^DIE K DIE,DR,DA,X,Y
Q
EXIT ;K APSPN,APSPL,APSPM,APSPMM,APSPD,PSONEW("LOT #"),PSONEW("MANUFACTURER"),PSONEW("EXPIRATION DATE")
;K APSPN,APSPL,APSPM,APSPMM,APSPD
Q
ZPAR ;GET MFG DATA FOR PARTIAL RX OPT
;S APSPN=$G(^PSRX(RX0,"P")) I APSPN']"" S (APSPL,APSPM,APSPD)="" Q
;S APSPM=$P($G(APSPN),"^",1),APSPL=$P($G(APSPN),"^",2),APSPD=$P($G(APSPN),"^",3)
Q
APSPMAN1 ; IHS/DSD/ENM - MANUFACTURER DATA FOR REFILL RX'S ; [ 02/20/2001 1:48 PM ]
+1 ;;6.0;IHS PHARMACY MODIFICATIONS;**1,3**;09/03/97
EP ;ENTRY POINT - FOR REFILL RX (W/edit 'all' mfg data set to 'yes')
+1 IF APSPMAN'=1
QUIT
+2 SET (APSPMM,APSPL,APSPD)=""
+3 ;I $D(^PSRX(PSOREF("IRXN"),1,0)) S LASTRF=$P(^(0),"^",3) D LAST
+4 ;IHS/DSD/ENM/POC 01/20/98 PREVENTS ERR WHEN REF DELETED
IF $PIECE($GET(^PSRX(PSOREF("IRXN"),1,0)),"^",3)]""
SET LASTRF=$PIECE(^(0),"^",3)
DO LAST
+5 IF APSPMM]""!(APSPL]"")!(APSPD]"")
GOTO WR
+6 SET APSPLTYP="R"
+7 IF $GET(PSOREF("RX2"))']""
GOTO ACT
+8 SET APSPMM=$PIECE($GET(PSOREF("RX2")),"^",8)
SET APSPL=$PIECE($GET(PSOREF("RX2")),"^",4)
SET APSPD=$PIECE($GET(PSOREF("RX2")),"^",11)
GOTO WR
LAST ;CK MAN DATA IN LAST REFILL
+1 SET APSPLRF=^PSRX(PSOREF("IRXN"),1,LASTRF,0)
+2 SET APSPMM=$PIECE(APSPLRF,"^",14)
SET APSPL=$PIECE(APSPLRF,"^",6)
SET APSPD=$PIECE(APSPLRF,"^",15)
+3 QUIT
DTO ;EP FOR REFILL RX (W/mfg 'date only' set) IHS/DSD/ENM 01/29/96
+1 ;
SET APSPRXX=$PIECE($GET(^PSRX(PSOREF("IRXN"),0)),"^",6)
IF APSPRXX']""
QUIT
+2 SET DA=APSPRXX
SET DR="9999999.26"
SET DIE="^PSDRUG("
DO ^DIE
+3 ;SET VARIABLES FOR PSOR52 GLOBAL SET
+4 SET PSOREF("LOT #")=""
SET PSOREF("MANUFACTURER")=""
SET PSOREF("EXPIRATION DATE")=$PIECE($GET(^PSDRUG(APSPRXX,999999924)),"^",3)
+5 ;GET LABEL VARIABLE DATA
+6 SET APSPMF=""
SET APSPLOT=""
+7 IF PSOREF("EXPIRATION DATE")']""
SET APSPDY=""
QUIT
+8 SET APSPDY=$EXTRACT(PSOREF("EXPIRATION DATE"),4,5)_"/"_$EXTRACT(PSOREF("EXPIRATION DATE"),2,3)
+9 QUIT
NMFG ;EP FOR REFILL RX (W/no mfg set) IHS/DSD/ENM 02/15/96
+1 ;SET VARIABLES FOR PSOR52 GLOBAL SET
+2 SET PSOREF("LOT #")=""
SET PSOREF("MANUFACTURER")=""
SET PSOREF("EXPIRATION DATE")=""
+3 ;GET LABEL VARIABLE DATA
+4 SET APSPMF=""
SET APSPLOT=""
+5 SET APSPDY=""
+6 QUIT
WR WRITE !,"Manufacturer: ",APSPMM,?30,"Lot #: ",APSPL,?50,"Mfg Expiration Date: "_$EXTRACT(APSPD,4,5)_"/"_$EXTRACT(APSPD,2,3)
ACT IF APSPMAN=1
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(PSOREF("RX0"),U,6)
DO ASK^APSPMAN
GOTO OUT
+1 SET APSPRXX=$PIECE(PSOREF("RX0"),U,6)
DO MAN2^APSPMAN
OUT ;SET VARIABLES FOR PSOR52 GLOBAL SET
+1 SET PSOREF("LOT #")=PSONEW("LOT #")
SET PSOREF("MANUFACTURER")=PSONEW("MANUFACTURER")
SET PSOREF("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 DO EXIT
QUIT
EP1 ;ENTRY POINT FOR EDIT RX OPT
+1 IF APSPMAN'=1
QUIT
+2 ;IHS/DSD/ENM 09/02/96
IF $GET(APSPLTYP)="V"
IF $GET(RX2)']""
SET (APSPL,APSPMM,APSPD)=""
QUIT
+3 IF $GET(APSPLTYP)="V"
SET APSPMM=$PIECE($GET(RX2),"^",8)
SET APSPL=$PIECE($GET(RX2),"^",4)
SET APSPD=$PIECE($GET(RX2),"^",11)
QUIT
+4 IF $GET(PSORXED("RX2"))']""
SET (APSPL,APSPMM,APSPD)=""
QUIT
+5 SET APSPMM=$PIECE($GET(PSORXED("RX2")),"^",8)
SET APSPL=$PIECE($GET(PSORXED("RX2")),"^",4)
SET APSPD=$PIECE($GET(PSORXED("RX2")),"^",11)
+6 ;I APSPLTYP="V" D WR1
+7 ;IHS/DSD/ENM 09/02/96
IF $GET(APSPLTYP)="E"
DO WR1
DO ACT1
+8 QUIT
+9 ;
WR1 WRITE !,"Manufacturer: ",APSPMM,?30,"Lot #: ",APSPL,?50,"Mfg Expiration Date: "_$EXTRACT(APSPD,4,5)_"/"_$EXTRACT(APSPD,2,3)
+1 QUIT
ACT1 ;EP
+1 IF APSPMAN=1
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
SET APSPYN=Y
IF Y=1
DO ASK^APSPMAN
GOTO OUT1
+2 ;IHS/DSD/ENM 09/05/96
IF PS="PARTIAL"
IF $GET(APSPYN)'=1
SET PSONEW("LOT #")=$GET(APSP("PL"))
SET PSONEW("MANUFACTURER")=$GET(APSP("PM"))
SET PSONEW("EXPIRATION DATE")=$GET(APSP("PD"))
+3 ;W !,"Mfg Expiration Date is required!",!
+4 ;IHS/DSD/ENM 02/15/96
IF APSPMAN=""!(APSPMAN=3)
DO NOMAN^APSPMAN
+5 ;IHS/DSD/ENM 02/15/96
IF APSPMAN=2
DO MAN2^APSPMAN
OUT1 ;SET VARIABLES FOR GLOBAL SET
+1 SET PSOREF("LOT #")=PSONEW("LOT #")
SET PSOREF("MANUFACTURER")=PSONEW("MANUFACTURER")
SET PSOREF("EXPIRATION DATE")=PSONEW("EXPIRATION DATE")
+2 ;GET LABEL VARIABLE DATA
+3 ;IHS/DSD/ENM 02/15/96
IF APSPMAN=""!(APSPMAN=3)
SET (APSPMF,APSPLOT,APSPDY)=""
GOTO EXIT
+4 ;IHS/DSD/ENM 02/15/96
IF APSPMAN=2
SET APSPMF=""
SET APSPLOT=""
SET APSPDY=$EXTRACT(PSONEW("EXPIRATION DATE"),4,5)_"/"_$EXTRACT(PSONEW("EXPIRATION DATE"),2,3)
GOTO EXIT
+5 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)
+6 GOTO EXIT
DCQ ;CHECK FOR CHNG'ed DATA AFTER EDITING AN RX
+1 IF APSPMAN<1
QUIT
+2 SET (APSPXED,APSPXMF,APSPXLT)=""
+3 IF APSPMAN=1
DO ALLCK
GOTO DCQX
+4 IF APSPMAN=""!(APSPMAN=2)
DO DTCK
DCQX QUIT
ALLCK IF PSONEW("EXPIRATION DATE")'=$PIECE($GET(PSORXED("RX2")),"^",11)
SET APSPXED=PSONEW("EXPIRATION DATE")
+1 IF PSONEW("LOT #")'=$PIECE($GET(PSORXED("RX2")),"^",4)
SET APSPXLT=PSONEW("LOT #")
+2 IF PSONEW("MANUFACTURER")'=$PIECE($GET(PSORXED("RX2")),"^",8)
SET APSPXMF=PSONEW("MANUFACTURER")
+3 IF APSPXED]""
SET DR="29///^S X=APSPXED"
SET COM=COM_$PIECE(^DD(52,29,0),"^")_" ("_APSPXED_"),"
+4 IF APSPXLT]""
SET DR=DR_";24///^S X=APSPXLT"
SET COM=COM_$PIECE(^DD(52,24,0),"^")_" ("_APSPXLT_"),"
+5 IF APSPXMF]""
SET DR=DR_";28///^S X=APSPXMF"
SET COM=COM_$PIECE(^DD(52,28,0),"^")_" ("_APSPXMF_"),"
+6 IF DR]""
SET DIE="^PSRX("
SET DA=PSORXED("IRXN")
DO ^DIE
KILL DIE,DR,DA,X,Y
+7 QUIT
DTCK ;MFG DATE CHECK FOR CHANGE
+1 IF PSOREF("EXPIRATION DATE")'=$PIECE($GET(PSORXED("RX2")),"^",11)
SET APSPXED=PSOREF("EXPIRATION DATE")
+2 IF APSPXED]""
SET DR="29///^S X=APSPXED"
SET COM=COM_$PIECE(^DD(52,29,0),"^")_" ("_APSPXED_"),"
SET DIE="^PSRX("
SET DA=PSORXED("IRXN")
DO ^DIE
KILL DIE,DR,DA,X,Y
+3 QUIT
EXIT ;K APSPN,APSPL,APSPM,APSPMM,APSPD,PSONEW("LOT #"),PSONEW("MANUFACTURER"),PSONEW("EXPIRATION DATE")
+1 ;K APSPN,APSPL,APSPM,APSPMM,APSPD
+2 QUIT
ZPAR ;GET MFG DATA FOR PARTIAL RX OPT
+1 ;S APSPN=$G(^PSRX(RX0,"P")) I APSPN']"" S (APSPL,APSPM,APSPD)="" Q
+2 ;S APSPM=$P($G(APSPN),"^",1),APSPL=$P($G(APSPN),"^",2),APSPD=$P($G(APSPN),"^",3)
+3 QUIT
