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

LRSRVR.m

Go to the documentation of this file. 
  1. LRSRVR ;DALOI/RLM/JMC - LAB DATA SERVER ;JUL 06, 2010 3:14 PM
  1.  ;;5.2;LAB SERVICE;**232,303,346,1027**;NOV 01, 1997;Build 10
  1.  ; Reference to ^%ZOSF supported by IA #10096
  1.  ; Reference to $$SITE^VASITE supported by IA #10112
  1.  ;
  1.  ; LR*5.2*1027 - IHS/OIT/MKK
  1.  ;
  1. START ;
  1.  N LRSITE,LRST,LRSUB,LRXMZ
  1.  ;
  1.  ; Save incoming server message id for cleanup
  1.  S LRXMZ=XMZ
  1.  ;
  1.  K ^TMP($J,"LRDATA"),^TMP($J,"LRDTERR")
  1.  ; Determine station name and number
  1.  S LRSITE=$$SITE^VASITE,LRSTN=$P(LRSITE,"^",2),LRST=$P(LRSITE,"^",3)
  1.  I LRST="" S LRST="???"
  1.  ;
  1.  S LRSUB=$$UP^XLFSTR(XQSUB)
  1.  ;
  1.  ; The first line of the message tells who requested the action and when
  1.  ; The second line tells when the server is activated and no data can be
  1.  ; gathered from the MailMan message.  This line gets replaced if the
  1.  ; server finds something to do.
  1.  S ^TMP($J,"LRDATA",1)=LRSUB_" triggered at "_LRSTN_" by "_XMFROM_" on "_XQDATE
  1.  S LRACTION=$S(LRSUB["CHECKSUM":"Checksums Generated",1:LRSUB)
  1.  S ^TMP($J,"LRDATA",2)="I don't know how to "_LRACTION_" at "_LRSTN
  1.  ;
  1.  ;
  1.  ; If the subject contains "CHECKSUM" send a report of the current checksums to the LABTEAM group on RDMAIL
  1.  I LRSUB["CHECKSUM" D CSUM Q
  1.  ;
  1.  ; If the subject contains "LIST" send a report based on the list of routines in the body of the message back to the original sender.
  1.  I LRSUB["LIST" D SUMLST Q
  1.  ;
  1.  ; If the subject equals "LOINC" send the local LOINC data to the national list.
  1.  I LRSUB="LOINC" D LOINC^LRSRVR1 Q
  1.  ;
  1.  ; If the subject contains "LOCAL REPORT" send the local LOINC data to the sender.
  1.  I LRSUB="LOCAL REPORT" D LOINCL^LRSRVR1 Q
  1.  I LRSUB="LOCAL REPORT DELIMIT" D LOINCLD^LRSRVR3 Q
  1.  ;
  1.  ; Send RELMA mapper formatted message
  1.  I LRSUB="RELMA" D SERVER^LRSRVR2 Q
  1.  ; Process RELMA mapper Packman global message
  1.  ; I LRSUB="RELMA MAPPING" D RMAP^LRSRVR5 Q
  1.  ;
  1.  ; Send SNOMED mapping formatted message
  1.  I LRSUB="SNOMED" D SERVER^LRSRVR6 Q
  1.  ;
  1.  ; Send NLT/CPT mapping formatted message
  1.  I LRSUB="NLT/CPT" D SERVER^LRSRVR7 Q
  1.  ;
  1.  ; If subject not understood by server, send a message to the sender
  1.  ;  that the server can't understand their instructions.
  1.  K XMY
  1.  S XMY(XQSND)=""
  1.  ;
  1. EXIT ; If all went well, report that too.
  1.  ; Mail the errors and successes back to the Roll-Up group at Forum.
  1.  N LRNOW
  1.  S LRNOW=$$NOW^XLFDT
  1.  S XMDUN="Lab Server",XMDUZ=".5",XMSUB=LRSTN_" LAB SERVER ("_LRNOW_")"
  1.  S XMTEXT="^TMP($J,""LRDATA"","
  1.  ; I '$D(XMY) S XMY("G.LABTEAM@ISC-DALLAS.VA.GOV")=""      ; LR*5.2*1027 - Don't send to VA
  1.  D ^XMD
  1.  ;
  1. CLEAN ; Cleanup and exit
  1.  I $D(^TMP($J,"LRDTERR")) D
  1.  . S XMDUN="Lab Server",XMDUZ=".5"
  1.  . S XMSUB=LRSTN_" LAB SERVER ERROR ("_LRNOW_")"
  1.  . S XMTEXT="^TMP($J,""LRDTERR"","
  1.  . ; S XMY("G.LABTEAM@ISC-DALLAS.VA.GOV")="",XMY(XQSND)=""      ; LR*5.2*1027 - Don't send to VA
  1.  . S XMY(XQSND)=""           ; LR*5.2*1027 - Can send to self
  1.  . D ^XMD
  1.  ;
  1.  ; Clean up server message in MailMan
  1.  I $G(LRXMZ)>0 D ZAPSERV^XMXAPI("S.LRLABSERVER",LRXMZ)
  1.  ;
  1.  K %,%DT,%H,D,DD,DIC,DIERR,ERROR,FILL,LINE,LOINCDTA,LOINCDTB,LOINCTAS
  1.  K LRA,LRAA,LRACTION,LRB,LRCLST,LRDA,LRERR,LRFOUND,LRFOUND1,LRI,LRLINE
  1.  K LRNDE,LROUT,LRPNT,LRPNTA,LRPNTB,LRRDT,LRRN,LRROOT,LRST,LRSTN,LRSUB
  1.  K X,XMDUN,XMDUZ,XMER,XMFROM,XMREC,XMRG,XMSUB,XMTEXT,XMY,XMZ,XQDATE
  1.  K XQSND,XQSUB,Y,ZTQUEUED,ZTSK
  1.  ;
  1.  K ^TMP($J,"LRDATA"),^TMP($J,"LRDTERR")
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1.  ;
  1. CSUM ;Calculate checksum for routines and transmit errors to LABTEAM group
  1.  S X=$T(+0) X ^%ZOSF("RSUM") S ^TMP($J,"LRDATA",2)=X_" at "_LRSTN_" = "_Y
  1.  S LRI=0
  1.  F  S LRI=$O(^LAB(69.91,1,"ROU",LRI)) Q:'LRI  D
  1.  . S X=$P(^LAB(69.91,1,"ROU",LRI,0),"^")
  1.  . S LRA=$P(^LAB(69.91,1,"ROU",LRI,0),"^",4)
  1.  . X ^%ZOSF("TEST") I '$T S ^TMP($J,"LRDATA",LRI+3)=X_" is missing." Q
  1.  . X ^%ZOSF("RSUM") I +$G(Y)'=LRA S ^TMP($J,"LRDATA",LRI+3)=X_" should be "_LRA_" is "_+$G(Y)
  1.  S XMSUB="Lab Checksum data at "_LRSTN_" run on "_XQDATE
  1.  D EXIT
  1.  Q
  1.  ;
  1.  ;
  1. SUMLST ;Calculate checksum for routines and transmit to requestor
  1.  K ^TMP($J,"LRDATA"),^TMP($J,"LRDTERR")
  1.  S LRCLST=$P($$SITE^VASITE,"^",2),LINE=2,LINR=1,$P(FILL," ",8)=""
  1.  S ^TMP($J,"LRDATA",1)="Lab Server triggered at "_LRCLST_" by "_XMFROM_" on "_XQDATE
  1.  ;
  1.  ; Check for a plus sign in front of the routine name.  Bypass the
  1.  ; Test to see if the routine exists if it's there.
  1.  ; DSM won't check %routines to make sure they exist, Cache will.
  1.  F  X XMREC Q:XMER<0  S X=XMRG D
  1.   . I X'?1"+".E X ^%ZOSF("TEST") I '$T S ^TMP($J,"LRDATA",LINE)=X_$E(FILL,$L(X),8)_" is missing.",LINE=LINE+1 Q
  1.   . ;Strip off the plus sign so that the checksum routine can find it.
  1.   . S X=$TR(X,"+","")
  1.   . X ^%ZOSF("RSUM") S ^TMP($J,"LRDATA",LINE)=X_$E(FILL,$L(X),8)_" is "_Y,LINE=LINE+1
  1.  S XMSUB="Checksum data at "_LRCLST_" run on "_XQDATE
  1.  S XMY(XQSND)=""
  1.  D EXIT
  1.  Q