| [613] | 1 | LRBLSRV ;DALLAS CIOFO/RLM/CYM - BLOOD BANK SERVER ;10/25/99  17:52 ; | 
|---|
|  | 2 | ;;5.2;LAB SERVICE;**247**;Sep 27, 1994 | 
|---|
|  | 3 | ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021 | 
|---|
|  | 4 | START ; | 
|---|
|  | 5 | K ^TMP($J,"LRBLDATA") | 
|---|
|  | 6 | S LRBLSITE=$P($$SITE^VASITE,U,2) | 
|---|
|  | 7 | ;Determine station number | 
|---|
|  | 8 | S LRBLSUB=$TR(XQSUB,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") | 
|---|
|  | 9 | ;Translate the subject into upper case and place it into a locally | 
|---|
|  | 10 | ;namespaced variable. | 
|---|
|  | 11 | S ^TMP("LRBL",$J,1,0)=LRBLSUB_" triggered at "_LRBLSITE_" by "_XMFROM_" on "_XQDATE | 
|---|
|  | 12 | ;The first line of the message tells who requested the action and when. | 
|---|
|  | 13 | S %DT="T",X="NOW" D ^%DT,DD^LRX S LRBLNOW=Y | 
|---|
|  | 14 | I XQSUB["REPORT" D ^LRBLINTG G EXIT | 
|---|
|  | 15 | K XMTEXT,XMSUB,LRBLSITE,LRBLNOW,XMY | 
|---|
|  | 16 | ;Call a routine based on the "Subject" line of the message. | 
|---|
|  | 17 | ;Skip the rest of the routine (down to exit) if the subject | 
|---|
|  | 18 | ;is a valid call. | 
|---|
|  | 19 | S LRBLSITE=$P($$SITE^VASITE,U,2) | 
|---|
|  | 20 | S ^TMP($J,"LRBLDATA",1)="" | 
|---|
|  | 21 | S ^TMP($J,"LRBLDATA",2)="Sorry, but I don't know how to "_XQSUB | 
|---|
|  | 22 | S ^TMP($J,"LRBLDATA",3)="No action taken" | 
|---|
|  | 23 | S XMY("G.bloodbank@ISC-CHICAGO.VA.GOV")="" | 
|---|
|  | 24 | S %DT="T",X="NOW" D ^%DT,DD^LRX S LRBLNOW=Y | 
|---|
|  | 25 | S XMSUB="Invalid BB Server Request From "_LRBLSITE_" run on "_LRBLNOW | 
|---|
|  | 26 | S XMTEXT="^TMP($J,""LRBLDATA"",",XMDUZ="Blood Bank Monitor" D ^XMD | 
|---|
|  | 27 | ;Send a message to the designated mail group if the server is triggered with | 
|---|
|  | 28 | ;an invalid command.  This lets the users know that they either made | 
|---|
|  | 29 | ;a typo, or that someone is attempting to improperly invoke the server. | 
|---|
|  | 30 | EXIT K %DT,XMTEXT,XMSUB,LRBLSITE,LRBLNOW,XMY,^TMP($J,"LRBLDATA") | 
|---|
|  | 31 | Q | 
|---|