| 1 | LRSRVR ;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 | ;
|
|---|
| 6 | START ;
|
|---|
| 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 | ;
|
|---|
| 57 | EXIT ; 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 | ;
|
|---|
| 66 | CLEAN ; 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 | ;
|
|---|
| 88 | CSUM ;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 | ;
|
|---|
| 101 | SUMLST ;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
|
|---|
