APSEWMSG ;IHS/DSD/LWJ - Patient Drug Education Database expiration message [ 11/13/2003 11:04 AM ]
;;6.1;IHS/PHARMACY MODIFICATIONS;**1,4**;04/17/01
;
; This program will be responsible for determining if a warning message
; needs to be issued to inform the pharmacist that the First
; DataBank database has either, or is about to, expire. This program
; can be called at the TEST subroutine to test the message, or at the
; main subroutine to process with the current date.
;
Q
TEST ; this routine is used to test the messages
N I
N TEST
S TEST=1
F I=78:7:93 S COUNT=I D EP
;
Q
;
EP ;EP -this subroutine will decipher if a warning message needs to be
; sent and if one does need to be sent, which message should display.
;
;
N APSEEDT,APSEWST,APSEWREC ;expiration date, warning last sent
N APSECDT,APSEWEX ;current date (VA format), exit value
N APSEDT15,APSEDT7,APSETDY ;15 days back, 7 days back, today
N X,APSEMTP ;date variable, message type indicator
;
S APSEWEX=""
S APSEWREC=$G(^APSAPPI("EXPWARN"))
Q:APSEWREC="" ;quit if blank - package not installed
S APSEEDT=$P(APSEWREC,"^") ;expiration date of current data
S APSEWST=$P(APSEWREC,"^",2) ;warning message was last sent on
;
D NOW^%DTC S APSETDY=X ;today's date in VA form
;
I $G(TEST) S APSETDY=$$CONVDAT(APSETDY,COUNT) ;only if testing
;
S APSEDT15=$$CONVDAT(APSEEDT,-15) ;15 days from expiration
S APSEDT7=$$CONVDAT(APSEEDT,-7) ;7 days from expiration
;
Q:APSETDY<APSEDT15 ;quit if we are more than 2 wks from exp
;
I ((APSETDY>APSEDT15)&(APSETDY<APSEDT7)) D
. I APSEWST="" S APSEMTP=2 D WARNMSG ;two week expiration message
;
I ((APSETDY'<APSEDT7)&(APSETDY<APSEEDT)) D
. I APSEWST<APSEDT7 S APSEMTP=1 D WARNMSG ;one week expiration message
;
;IHS/DSD/lwj nxt line changed to chk APSEWST as well
I (APSEEDT'>APSETDY)&(APSETDY'=APSEWST) S APSEMTP="D" D WARNMSG ;daily /IHS/DSD/lwj 5/11/01
;
Q
;
WARNMSG ; This subroutine will generate the message that is sent
; one and two weeks prior to the First DataBank Patient Education
; Database expiring, and daily once the database has expired.
; APSEMTP will indicate which message type should be sent (two
; weeks prior, one week prior, or daily message).
;
D MSGHED
I APSEMTP=2 D MSGMID2 ;2 weeks prior to expire
I APSEMTP=1 D MSGMID1 ;1 week prior to expire
I APSEMTP="D" D MSGMIDD ;expired - daily msg
S APSEWEX=$$MSGEND(20,APSETDY)
;
Q
;
MSGHED ; this is the header portion of all messages
;
W !!
W "*******************************************************************************",!
W "* WARNING WARNING ******** WARNING ******** WARNING WARNING *",!
W "* *",!
;
Q
;
MSGMIDD ; this is the middle portion of the daily message
;
W "* The First DataBank data used to print the Drug Medication Sheets has *",!
W "* expired. This information is used in the following options found on the *",!
W "* main RX menu: *",!
Q
;
MSGMID2 ; this is the middle portion of the message displayed 2 weeks out
;
W "* The First DataBank data used to print the Drug Medication Sheets will *",!
W "* expire in two weeks. This information is used in the following options *",!
W "* found on the main RX menu: *",!
;
Q
;
MSGMID1 ; this is the middle portion of the message displayed 1 week out
;
W "* The First DataBank data used to print the Drug Medication Sheets will *",!
W "* expire in one week. This information is used in the following options *",!
W "* found on the main RX menu: *",!
;
Q
;
MSGEND(APSETIM,APSEDATE) ; this is the final portion of the messages
N DIR,DUOUT,APSEREC
S DUOUT=0
;
;
;W "* *",!
W "* DPMI PRINT DRUG MEDICATION SHEETS *",!
W "* PMI PRINT PATIENT MEDICATION SHEETS *",!
W "* NERX New Prescription Entry *",!
W "* (Printing of the Med Sheet) *",!
W "* *",!
W "* Records indicate that your site is using this information to provide *",!
W "* patients with drug monographs. It is extremely important that your system *",!
W "* be updated with the most current version of the First DataBank Patient Drug *",!
W "* Education Database (PDED) as soon as possible. Failure to update your *",!
W "* system could result in incorrect or out dated informaton being distributed. *",!
W "* New versions of the First DataBank PDED are obtainable monthly and should *",!
W "* be loaded on your system as they are available. Please contact your site *",!
W "* manager to schedule an update of the First DataBank PDED as soon as *",!
W "* possible. (**** This message will display at frequent intervals until *",!
W "* a system update has been performed. ****) *",!
W "*******************************************************************************",!
S DIR("T")=APSETIM,DIR(0)="E" ;hold message for 20 seconds
D ^DIR
I '$D(DUOUT) S DUOUT=0
;
;
S APSEREC=$G(^APSAPPI("EXPWARN"))
S $P(APSEREC,"^",2)=APSEDATE ;set the last sent date to today
S ^APSAPPI("EXPWARN")=APSEREC
;
Q DUOUT
;
CONVDAT(VADATE,NUMDAYS) ;converts the expiration date to previous days
; This is done to calculate the week range for the 2 week and 1 week
; warning messages.
;
N X,X1,X2
S X1=VADATE,X2=NUMDAYS
D C^%DTC
;
Q X
APSEWMSG ;IHS/DSD/LWJ - Patient Drug Education Database expiration message [ 11/13/2003 11:04 AM ]
+1 ;;6.1;IHS/PHARMACY MODIFICATIONS;**1,4**;04/17/01
+2 ;
+3 ; This program will be responsible for determining if a warning message
+4 ; needs to be issued to inform the pharmacist that the First
+5 ; DataBank database has either, or is about to, expire. This program
+6 ; can be called at the TEST subroutine to test the message, or at the
+7 ; main subroutine to process with the current date.
+8 ;
+9 QUIT
TEST ; this routine is used to test the messages
+1 NEW I
+2 NEW TEST
+3 SET TEST=1
+4 FOR I=78:7:93
SET COUNT=I
DO EP
+5 ;
+6 QUIT
+7 ;
EP ;EP -this subroutine will decipher if a warning message needs to be
+1 ; sent and if one does need to be sent, which message should display.
+2 ;
+3 ;
+4 ;expiration date, warning last sent
NEW APSEEDT,APSEWST,APSEWREC
+5 ;current date (VA format), exit value
NEW APSECDT,APSEWEX
+6 ;15 days back, 7 days back, today
NEW APSEDT15,APSEDT7,APSETDY
+7 ;date variable, message type indicator
NEW X,APSEMTP
+8 ;
+9 SET APSEWEX=""
+10 SET APSEWREC=$GET(^APSAPPI("EXPWARN"))
+11 ;quit if blank - package not installed
IF APSEWREC=""
QUIT
+12 ;expiration date of current data
SET APSEEDT=$PIECE(APSEWREC,"^")
+13 ;warning message was last sent on
SET APSEWST=$PIECE(APSEWREC,"^",2)
+14 ;
+15 ;today's date in VA form
DO NOW^%DTC
SET APSETDY=X
+16 ;
+17 ;only if testing
IF $GET(TEST)
SET APSETDY=$$CONVDAT(APSETDY,COUNT)
+18 ;
+19 ;15 days from expiration
SET APSEDT15=$$CONVDAT(APSEEDT,-15)
+20 ;7 days from expiration
SET APSEDT7=$$CONVDAT(APSEEDT,-7)
+21 ;
+22 ;quit if we are more than 2 wks from exp
IF APSETDY<APSEDT15
QUIT
+23 ;
+24 IF ((APSETDY>APSEDT15)&(APSETDY<APSEDT7))
Begin DoDot:1
+25 ;two week expiration message
IF APSEWST=""
SET APSEMTP=2
DO WARNMSG
End DoDot:1
+26 ;
+27 IF ((APSETDY'<APSEDT7)&(APSETDY<APSEEDT))
Begin DoDot:1
+28 ;one week expiration message
IF APSEWST<APSEDT7
SET APSEMTP=1
DO WARNMSG
End DoDot:1
+29 ;
+30 ;IHS/DSD/lwj nxt line changed to chk APSEWST as well
+31 ;daily /IHS/DSD/lwj 5/11/01
IF (APSEEDT'>APSETDY)&(APSETDY'=APSEWST)
SET APSEMTP="D"
DO WARNMSG
+32 ;
+33 QUIT
+34 ;
WARNMSG ; This subroutine will generate the message that is sent
+1 ; one and two weeks prior to the First DataBank Patient Education
+2 ; Database expiring, and daily once the database has expired.
+3 ; APSEMTP will indicate which message type should be sent (two
+4 ; weeks prior, one week prior, or daily message).
+5 ;
+6 DO MSGHED
+7 ;2 weeks prior to expire
IF APSEMTP=2
DO MSGMID2
+8 ;1 week prior to expire
IF APSEMTP=1
DO MSGMID1
+9 ;expired - daily msg
IF APSEMTP="D"
DO MSGMIDD
+10 SET APSEWEX=$$MSGEND(20,APSETDY)
+11 ;
+12 QUIT
+13 ;
MSGHED ; this is the header portion of all messages
+1 ;
+2 WRITE !!
+3 WRITE "*******************************************************************************",!
+4 WRITE "* WARNING WARNING ******** WARNING ******** WARNING WARNING *",!
+5 WRITE "* *",!
+6 ;
+7 QUIT
+8 ;
MSGMIDD ; this is the middle portion of the daily message
+1 ;
+2 WRITE "* The First DataBank data used to print the Drug Medication Sheets has *",!
+3 WRITE "* expired. This information is used in the following options found on the *",!
+4 WRITE "* main RX menu: *",!
+5 QUIT
+6 ;
MSGMID2 ; this is the middle portion of the message displayed 2 weeks out
+1 ;
+2 WRITE "* The First DataBank data used to print the Drug Medication Sheets will *",!
+3 WRITE "* expire in two weeks. This information is used in the following options *",!
+4 WRITE "* found on the main RX menu: *",!
+5 ;
+6 QUIT
+7 ;
MSGMID1 ; this is the middle portion of the message displayed 1 week out
+1 ;
+2 WRITE "* The First DataBank data used to print the Drug Medication Sheets will *",!
+3 WRITE "* expire in one week. This information is used in the following options *",!
+4 WRITE "* found on the main RX menu: *",!
+5 ;
+6 QUIT
+7 ;
MSGEND(APSETIM,APSEDATE) ; this is the final portion of the messages
+1 NEW DIR,DUOUT,APSEREC
+2 SET DUOUT=0
+3 ;
+4 ;
+5 ;W "* *",!
+6 WRITE "* DPMI PRINT DRUG MEDICATION SHEETS *",!
+7 WRITE "* PMI PRINT PATIENT MEDICATION SHEETS *",!
+8 WRITE "* NERX New Prescription Entry *",!
+9 WRITE "* (Printing of the Med Sheet) *",!
+10 WRITE "* *",!
+11 WRITE "* Records indicate that your site is using this information to provide *",!
+12 WRITE "* patients with drug monographs. It is extremely important that your system *",!
+13 WRITE "* be updated with the most current version of the First DataBank Patient Drug *",!
+14 WRITE "* Education Database (PDED) as soon as possible. Failure to update your *",!
+15 WRITE "* system could result in incorrect or out dated informaton being distributed. *",!
+16 WRITE "* New versions of the First DataBank PDED are obtainable monthly and should *",!
+17 WRITE "* be loaded on your system as they are available. Please contact your site *",!
+18 WRITE "* manager to schedule an update of the First DataBank PDED as soon as *",!
+19 WRITE "* possible. (**** This message will display at frequent intervals until *",!
+20 WRITE "* a system update has been performed. ****) *",!
+21 WRITE "*******************************************************************************",!
+22 ;hold message for 20 seconds
SET DIR("T")=APSETIM
SET DIR(0)="E"
+23 DO ^DIR
+24 IF '$DATA(DUOUT)
SET DUOUT=0
+25 ;
+26 ;
+27 SET APSEREC=$GET(^APSAPPI("EXPWARN"))
+28 ;set the last sent date to today
SET $PIECE(APSEREC,"^",2)=APSEDATE
+29 SET ^APSAPPI("EXPWARN")=APSEREC
+30 ;
+31 QUIT DUOUT
+32 ;
CONVDAT(VADATE,NUMDAYS) ;converts the expiration date to previous days
+1 ; This is done to calculate the week range for the 2 week and 1 week
+2 ; warning messages.
+3 ;
+4 NEW X,X1,X2
+5 SET X1=VADATE
SET X2=NUMDAYS
+6 DO C^%DTC
+7 ;
+8 QUIT X
