source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSRVR.m@ 1300

Last change on this file since 1300 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 4.4 KB
RevLine 
[613]1LRSRVR ;DALOI/RLM/JMC - LAB DATA SERVER ; Aug 17, 2006
2 ;;5.2;LAB SERVICE;**232,303,346**;Sep 27, 1994;Build 10
3 ; Reference to ^%ZOSF supported by IA #10096
4 ; Reference to $$SITE^VASITE supported by IA #10112
5 ;
6START ;
7 N LRSITE,LRST,LRSUB,LRXMZ
8 ;
9 ; Save incoming server message id for cleanup
10 S LRXMZ=XMZ
11 ;
12 K ^TMP($J,"LRDATA"),^TMP($J,"LRDTERR")
13 ; Determine station name and number
14 S LRSITE=$$SITE^VASITE,LRSTN=$P(LRSITE,"^",2),LRST=$P(LRSITE,"^",3)
15 I LRST="" S LRST="???"
16 ;
17 S LRSUB=$$UP^XLFSTR(XQSUB)
18 ;
19 ; The first line of the message tells who requested the action and when
20 ; The second line tells when the server is activated and no data can be
21 ; gathered from the MailMan message. This line gets replaced if the
22 ; server finds something to do.
23 S ^TMP($J,"LRDATA",1)=LRSUB_" triggered at "_LRSTN_" by "_XMFROM_" on "_XQDATE
24 S LRACTION=$S(LRSUB["CHECKSUM":"Checksums Generated",1:LRSUB)
25 S ^TMP($J,"LRDATA",2)="I don't know how to "_LRACTION_" at "_LRSTN
26 ;
27 ;
28 ; If the subject contains "CHECKSUM" send a report of the current checksums to the LABTEAM group on RDMAIL
29 I LRSUB["CHECKSUM" D CSUM Q
30 ;
31 ; 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.
32 I LRSUB["LIST" D SUMLST Q
33 ;
34 ; If the subject equals "LOINC" send the local LOINC data to the national list.
35 I LRSUB="LOINC" D LOINC^LRSRVR1 Q
36 ;
37 ; If the subject contains "LOCAL REPORT" send the local LOINC data to the sender.
38 I LRSUB="LOCAL REPORT" D LOINCL^LRSRVR1 Q
39 I LRSUB="LOCAL REPORT DELIMIT" D LOINCLD^LRSRVR3 Q
40 ;
41 ; Send RELMA mapper formatted message
42 I LRSUB="RELMA" D SERVER^LRSRVR2 Q
43 ; Process RELMA mapper Packman global message
44 ;I LRSUB="RELMA MAPPING" D RMAP^LRSRVR5 Q
45 ;
46 ; Send SNOMED mapping formatted message
47 I LRSUB="SNOMED" D SERVER^LRSRVR6 Q
48 ;
49 ; Send NLT/CPT mapping formatted message
50 I LRSUB="NLT/CPT" D SERVER^LRSRVR7 Q
51 ;
52 ; If subject not understood by server, send a message to the sender
53 ; that the server can't understand their instructions.
54 K XMY
55 S XMY(XQSND)=""
56 ;
57EXIT ; If all went well, report that too.
58 ; Mail the errors and successes back to the Roll-Up group at Forum.
59 N LRNOW
60 S LRNOW=$$NOW^XLFDT
61 S XMDUN="Lab Server",XMDUZ=".5",XMSUB=LRSTN_" LAB SERVER ("_LRNOW_")"
62 S XMTEXT="^TMP($J,""LRDATA"","
63 I '$D(XMY) S XMY("G.LABTEAM@ISC-DALLAS.VA.GOV")=""
64 D ^XMD
65 ;
66CLEAN ; Cleanup and exit
67 I $D(^TMP($J,"LRDTERR")) D
68 . S XMDUN="Lab Server",XMDUZ=".5"
69 . S XMSUB=LRSTN_" LAB SERVER ERROR ("_LRNOW_")"
70 . S XMTEXT="^TMP($J,""LRDTERR"","
71 . S XMY("G.LABTEAM@ISC-DALLAS.VA.GOV")="",XMY(XQSND)=""
72 . D ^XMD
73 ;
74 ; Clean up server message in MailMan
75 I $G(LRXMZ)>0 D ZAPSERV^XMXAPI("S.LRLABSERVER",LRXMZ)
76 ;
77 K %,%DT,%H,D,DD,DIC,DIERR,ERROR,FILL,LINE,LOINCDTA,LOINCDTB,LOINCTAS
78 K LRA,LRAA,LRACTION,LRB,LRCLST,LRDA,LRERR,LRFOUND,LRFOUND1,LRI,LRLINE
79 K LRNDE,LROUT,LRPNT,LRPNTA,LRPNTB,LRRDT,LRRN,LRROOT,LRST,LRSTN,LRSUB
80 K X,XMDUN,XMDUZ,XMER,XMFROM,XMREC,XMRG,XMSUB,XMTEXT,XMY,XMZ,XQDATE
81 K XQSND,XQSUB,Y,ZTQUEUED,ZTSK
82 ;
83 K ^TMP($J,"LRDATA"),^TMP($J,"LRDTERR")
84 S:$D(ZTQUEUED) ZTREQ="@"
85 Q
86 ;
87 ;
88CSUM ;Calculate checksum for routines and transmit errors to LABTEAM group
89 S X=$T(+0) X ^%ZOSF("RSUM") S ^TMP($J,"LRDATA",2)=X_" at "_LRSTN_" = "_Y
90 S LRI=0
91 F S LRI=$O(^LAB(69.91,1,"ROU",LRI)) Q:'LRI D
92 . S X=$P(^LAB(69.91,1,"ROU",LRI,0),"^")
93 . S LRA=$P(^LAB(69.91,1,"ROU",LRI,0),"^",4)
94 . X ^%ZOSF("TEST") I '$T S ^TMP($J,"LRDATA",LRI+3)=X_" is missing." Q
95 . X ^%ZOSF("RSUM") I +$G(Y)'=LRA S ^TMP($J,"LRDATA",LRI+3)=X_" should be "_LRA_" is "_+$G(Y)
96 S XMSUB="Lab Checksum data at "_LRSTN_" run on "_XQDATE
97 D EXIT
98 Q
99 ;
100 ;
101SUMLST ;Calculate checksum for routines and transmit to requestor
102 K ^TMP($J,"LRDATA"),^TMP($J,"LRDTERR")
103 S LRCLST=$P($$SITE^VASITE,"^",2),LINE=2,LINR=1,$P(FILL," ",8)=""
104 S ^TMP($J,"LRDATA",1)="Lab Server triggered at "_LRCLST_" by "_XMFROM_" on "_XQDATE
105 ;
106 ; Check for a plus sign in front of the routine name. Bypass the
107 ; Test to see if the routine exists if it's there.
108 ; DSM won't check %routines to make sure they exist, Cache will.
109 F X XMREC Q:XMER<0 S X=XMRG D
110 . 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
111 . ;Strip off the plus sign so that the checksum routine can find it.
112 . S X=$TR(X,"+","")
113 . X ^%ZOSF("RSUM") S ^TMP($J,"LRDATA",LINE)=X_$E(FILL,$L(X),8)_" is "_Y,LINE=LINE+1
114 S XMSUB="Checksum data at "_LRCLST_" run on "_XQDATE
115 S XMY(XQSND)=""
116 D EXIT
117 Q
Note: See TracBrowser for help on using the repository browser.