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

APSPMAN1.m

Go to the documentation of this file. 
  1. 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
  1. EP ;ENTRY POINT -  FOR REFILL RX (W/edit 'all' mfg data set to 'yes')
  1.  I APSPMAN'=1 Q
  1.  S (APSPMM,APSPL,APSPD)=""
  1.  ;I $D(^PSRX(PSOREF("IRXN"),1,0)) S LASTRF=$P(^(0),"^",3) D LAST
  1.  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
  1.  I APSPMM]""!(APSPL]"")!(APSPD]"") G WR
  1.  S APSPLTYP="R"
  1.  I $G(PSOREF("RX2"))']"" G ACT
  1.  S APSPMM=$P($G(PSOREF("RX2")),"^",8),APSPL=$P($G(PSOREF("RX2")),"^",4),APSPD=$P($G(PSOREF("RX2")),"^",11) G WR
  1. LAST ;CK MAN DATA IN LAST REFILL
  1.  S APSPLRF=^PSRX(PSOREF("IRXN"),1,LASTRF,0)
  1.  S APSPMM=$P(APSPLRF,"^",14),APSPL=$P(APSPLRF,"^",6),APSPD=$P(APSPLRF,"^",15)
  1.  Q
  1. DTO ;EP FOR REFILL RX (W/mfg 'date only' set) IHS/DSD/ENM 01/29/96
  1.  S APSPRXX=$P($G(^PSRX(PSOREF("IRXN"),0)),"^",6) Q:APSPRXX']""  ;
  1.  S DA=APSPRXX,DR="9999999.26",DIE="^PSDRUG(" D ^DIE
  1.  ;SET VARIABLES FOR PSOR52 GLOBAL SET
  1.  S PSOREF("LOT #")="",PSOREF("MANUFACTURER")="",PSOREF("EXPIRATION DATE")=$P($G(^PSDRUG(APSPRXX,999999924)),"^",3)
  1.  ;GET LABEL VARIABLE DATA
  1.  S APSPMF="",APSPLOT=""
  1.  I PSOREF("EXPIRATION DATE")']"" S APSPDY="" Q
  1.  S APSPDY=$E(PSOREF("EXPIRATION DATE"),4,5)_"/"_$E(PSOREF("EXPIRATION DATE"),2,3)
  1.  Q
  1. NMFG ;EP FOR REFILL RX (W/no mfg set) IHS/DSD/ENM 02/15/96
  1.  ;SET VARIABLES FOR PSOR52 GLOBAL SET
  1.  S PSOREF("LOT #")="",PSOREF("MANUFACTURER")="",PSOREF("EXPIRATION DATE")=""
  1.  ;GET LABEL VARIABLE DATA
  1.  S APSPMF="",APSPLOT=""
  1.  S APSPDY=""
  1.  Q
  1. WR W !,"Manufacturer: ",APSPMM,?30,"Lot #: ",APSPL,?50,"Mfg Expiration Date: "_$E(APSPD,4,5)_"/"_$E(APSPD,2,3)
  1. 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
  1.  S APSPRXX=$P(PSOREF("RX0"),U,6) D MAN2^APSPMAN
  1. OUT ;SET VARIABLES FOR PSOR52 GLOBAL SET
  1.  S PSOREF("LOT #")=PSONEW("LOT #"),PSOREF("MANUFACTURER")=PSONEW("MANUFACTURER"),PSOREF("EXPIRATION DATE")=PSONEW("EXPIRATION DATE")
  1.  ;GET LABEL VARIABLE DATA
  1.  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)
  1.  D EXIT Q
  1. EP1 ;ENTRY POINT FOR EDIT RX OPT
  1.  Q:APSPMAN'=1
  1.  I $G(APSPLTYP)="V",$G(RX2)']"" S (APSPL,APSPMM,APSPD)="" Q  ;IHS/DSD/ENM 09/02/96
  1.  I $G(APSPLTYP)="V" S APSPMM=$P($G(RX2),"^",8),APSPL=$P($G(RX2),"^",4),APSPD=$P($G(RX2),"^",11) Q
  1.  I $G(PSORXED("RX2"))']"" S (APSPL,APSPMM,APSPD)="" Q
  1.  S APSPMM=$P($G(PSORXED("RX2")),"^",8),APSPL=$P($G(PSORXED("RX2")),"^",4),APSPD=$P($G(PSORXED("RX2")),"^",11)
  1.  ;I APSPLTYP="V" D WR1
  1.  I $G(APSPLTYP)="E" D WR1,ACT1 ;IHS/DSD/ENM 09/02/96
  1.  Q
  1.  ;
  1. WR1 W !,"Manufacturer: ",APSPMM,?30,"Lot #: ",APSPL,?50,"Mfg Expiration Date: "_$E(APSPD,4,5)_"/"_$E(APSPD,2,3)
  1.  Q
  1. ACT1 ;EP
  1.  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
  1.  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
  1.  ;W !,"Mfg Expiration Date is required!",!
  1.  I APSPMAN=""!(APSPMAN=3) D NOMAN^APSPMAN ;IHS/DSD/ENM 02/15/96
  1.  I APSPMAN=2 D MAN2^APSPMAN ;IHS/DSD/ENM 02/15/96
  1. OUT1 ;SET VARIABLES FOR GLOBAL SET
  1.  S PSOREF("LOT #")=PSONEW("LOT #"),PSOREF("MANUFACTURER")=PSONEW("MANUFACTURER"),PSOREF("EXPIRATION DATE")=PSONEW("EXPIRATION DATE")
  1.  ;GET LABEL VARIABLE DATA
  1.  I APSPMAN=""!(APSPMAN=3) S (APSPMF,APSPLOT,APSPDY)="" G EXIT ;IHS/DSD/ENM 02/15/96
  1.  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
  1.  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)
  1.  G EXIT
  1. DCQ ;CHECK FOR CHNG'ed DATA AFTER EDITING AN RX
  1.  Q:APSPMAN<1
  1.  S (APSPXED,APSPXMF,APSPXLT)=""
  1.  I APSPMAN=1 D ALLCK G DCQX
  1.  I APSPMAN=""!(APSPMAN=2) D DTCK
  1. DCQX Q
  1. ALLCK I PSONEW("EXPIRATION DATE")'=$P($G(PSORXED("RX2")),"^",11) S APSPXED=PSONEW("EXPIRATION DATE")
  1.  I PSONEW("LOT #")'=$P($G(PSORXED("RX2")),"^",4) S APSPXLT=PSONEW("LOT #")
  1.  I PSONEW("MANUFACTURER")'=$P($G(PSORXED("RX2")),"^",8) S APSPXMF=PSONEW("MANUFACTURER")
  1.  I APSPXED]"" S DR="29///^S X=APSPXED",COM=COM_$P(^DD(52,29,0),"^")_" ("_APSPXED_"),"
  1.  I APSPXLT]"" S DR=DR_";24///^S X=APSPXLT",COM=COM_$P(^DD(52,24,0),"^")_" ("_APSPXLT_"),"
  1.  I APSPXMF]"" S DR=DR_";28///^S X=APSPXMF",COM=COM_$P(^DD(52,28,0),"^")_" ("_APSPXMF_"),"
  1.  I DR]"" S DIE="^PSRX(",DA=PSORXED("IRXN") D ^DIE K DIE,DR,DA,X,Y
  1.  Q
  1. DTCK ;MFG DATE CHECK FOR CHANGE
  1.  I PSOREF("EXPIRATION DATE")'=$P($G(PSORXED("RX2")),"^",11) S APSPXED=PSOREF("EXPIRATION DATE")
  1.  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
  1.  Q
  1. EXIT ;K APSPN,APSPL,APSPM,APSPMM,APSPD,PSONEW("LOT #"),PSONEW("MANUFACTURER"),PSONEW("EXPIRATION DATE")
  1.  ;K APSPN,APSPL,APSPM,APSPMM,APSPD
  1.  Q
  1. ZPAR ;GET MFG DATA FOR PARTIAL RX OPT
  1.  ;S APSPN=$G(^PSRX(RX0,"P")) I APSPN']"" S (APSPL,APSPM,APSPD)="" Q
  1.  ;S APSPM=$P($G(APSPN),"^",1),APSPL=$P($G(APSPN),"^",2),APSPD=$P($G(APSPN),"^",3)
  1.  Q