Changeset 623 for WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSRVR6.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSRVR6.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSRVR6.m
r613 r623 1 LRSRVR6 ;DALIO/JMC - LAB DATA SERVER CONT'D SNOMED EXTRACT ;Aug 17, 2006 2 ;;5.2;LAB SERVICE;**346,378**;Sep 27, 1994;Build 1 3 ; Produces SNOMED extract via LRLABSERVER option 4 ; 5 Q 6 ; 7 ; 8 SERVER ; Server entry Point 9 N I,LRCNT,LREND,LRL,LRMSUBJ,LRST,LRSTN,LRTXT,LRX,LRY 10 D BUILD 11 S LRMSUBJ=LRST_" "_LRSTN_" SNOMED EXTRACT "_$$HTE^XLFDT($H,"1M") 12 D MAILSEND(LRMSUBJ) 13 D CLEAN 14 Q 15 ; 16 ; 17 BUILD ; Build extract 18 N J,LRCNT,LRCRLF,LRETIME,LRFN,LRLEX,LRNAME,LRQUIT,LRROOT,LRSCT,LRSCTEC,LRSCTVER,LRSCTX,LRSPEC,LRSTIME,LRSTR,LRVAL,LRVUID,LRX,LRY,X,Y 19 ; 20 S LRSTIME=$$NOW^XLFDT,LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2),LRSCTVER="" 21 I LRST="" S LRST="???" 22 K ^TMP($J,"LRDATA") 23 S (LRCNT,LRCNT("SCT"))=0,LRCRLF=$C(13,10),LRSTR="" 24 F I=61,61.1,61.2,61.3,61.4,61.5,61.6,62 S LRCNT(I)=0,LRCNT(I,"SCT")=0 25 D HDR 26 ; 27 ; Flag to indicate if SNOMED CT is available from LEXICON. 28 S LRLEX=0 29 I $T(CODE^LEXTRAN)'="" S LRLEX=1 30 ; 31 F LRFN=61,61.1,61.2,61.3,61.4,61.5,61.6,62 D 32 . S LRROOT="^LAB("_LRFN_",""B"")" 33 . D FILE 34 ; 35 S LRETIME=$$NOW^XLFDT 36 ; Set the final info into the ^TMP message global 37 S LRNODE=$O(^TMP($J,"LRDATA",""),-1) 38 I LRSTR'="" S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR) 39 S ^TMP($J,"LRDATA",LRNODE+1)=" " 40 S ^TMP($J,"LRDATA",LRNODE+2)="end" 41 ; 42 S ^TMP($J,"LRDATA",1)=^TMP($J,"LRDATA",1)_" (Run time:"_$$FMDIFF^XLFDT(LRETIME,LRSTIME,3)_")" 43 S ^TMP($J,"LRDATA",3)="SNOMED CT version......: "_LRSCTVER 44 S J=6 45 S ^TMP($J,"LRDATA",J)="Number of records per file:" 46 F I=61,61.1,61.2,61.3,61.4,61.5,61.6,62 D 47 . S J=J+1 48 . S ^TMP($J,"LRDATA",J)=" "_$$LJ^XLFSTR($$GET1^DID(I,"","","NAME")_" File (#"_I_")",32,".")_": "_$J(LRCNT(I),5)_" ("_LRCNT(I,"SCT")_" mapped)" 49 S ^TMP($J,"LRDATA",J+1)=$$LJ^XLFSTR("Total number of records",33,".")_": "_$J(LRCNT,5)_" ("_LRCNT("SCT")_" mapped)" 50 ; 51 Q 52 ; 53 ; 54 CLEAN ; 55 K ^TMP($J,"LR61") 56 K LRIEN,LRLEN,LRNODE,LRSNM,LRSPECN 57 D CLEAN^LRSRVR 58 D ^%ZISC 59 Q 60 ; 61 ; 62 FILE ; Search file entry and build record. 63 ; 64 F S LRROOT=$Q(@LRROOT) Q:LRROOT="" Q:$QS(LRROOT,2)'="B" D 65 . Q:$G(@LRROOT) 66 . S LRIEN=$QS(LRROOT,4),LRSPEC="" 67 . S LRNAME=$P($G(^LAB(LRFN,LRIEN,0)),"^"),LRNAME=$$TRIM^XLFSTR(LRNAME,"RL"," ") 68 . S X=$P($G(^LAB(LRFN,LRIEN,0)),"^",2) 69 . S LRSNM=$S(LRFN'=62:X,1:"") 70 . I LRFN=62 S LRSPEC=X 71 . I LRSNM'="",LRFN>60.9,LRFN<61.61 S LRX=((LRFN*10)#610)+1,LRSNM=$E("TMEFDPJ",LRX)_"-"_LRSNM 72 . S LRSCT=$P($G(^LAB(LRFN,LRIEN,"SCT")),"^"),(LRSCTEC,LRSCTX,LRVUID)="" 73 . I LRLEX,LRSCT'="" D 74 . . K LRX 75 . . S LRX=$$CODE^LEXTRAN(LRSCT,"SCT",DT,"LRX") 76 . . S LRSCTX=$G(LRX("F")),LRSCTEC=$S(LRX<1:$P(LRX,"^",2),1:"") 77 . . I LRSCTVER="",LRX>0 S LRSCTVER=$P($G(LRX(0)),"^",3) 78 . S LRSTR=LRSTR_LRST_"-"_LRFN_"-"_LRIEN_"|"_LRNAME_"|"_LRSNM_"|"_LRVUID_"|"_LRSCT_"|"_LRSCTX_"|"_LRSCTEC_"|" 79 . S LRSPECN="|" 80 . I LRFN=62,LRSPEC D 81 . . S LRSPECN=$P($G(^LAB(61,LRSPEC,0)),"^") 82 . . S LRSPECN=LRSPECN_"|"_LRST_"-61-"_LRSPEC 83 . S LRSTR=LRSTR_LRSPECN_"|1.1|" 84 . S LRCNT=LRCNT+1,LRCNT(LRFN)=LRCNT(LRFN)+1 S:LRSCT LRCNT("SCT")=LRCNT("SCT")+1,LRCNT(LRFN,"SCT")=LRCNT(LRFN,"SCT")+1 85 . D SETDATA 86 Q 87 ; 88 ; 89 SETDATA ; Set data into report structure 90 S LRSTR=LRSTR_LRCRLF 91 S LRNODE=$O(^TMP($J,"LRDATA",""),-1) 92 D ENCODE^LRSRVR4(.LRSTR) 93 Q 94 ; 95 ; 96 HDR ; Set the header information 97 N LRFILENM 98 S LRFILENM=$TR(LRSTN," ","_")_"-"_LRSUB_"-"_$P($$FMTHL7^XLFDT(LRSTIME),"-")_".TXT" 99 S ^TMP($J,"LRDATA",1)="Report Generated.......: "_$$FMTE^XLFDT(LRSTIME)_" at "_LRSTN 100 S ^TMP($J,"LRDATA",2)="Report requested.......: "_LRSUB 101 S ^TMP($J,"LRDATA",3)="SNOMED CT version......: " 102 S ^TMP($J,"LRDATA",4)="Extract version........: 1.1" 103 F I=5,15,16,18,23 S ^TMP($J,"LRDATA",I)=" " 104 S ^TMP($J,"LRDATA",17)="Attached file..........: "_LRFILENM 105 S ^TMP($J,"LRDATA",19)="Legend:" 106 S X="Station #-File #-IEN|Entry Name|SNOMED I|VUID|SNOMED CT|SNOMED CT TERM|Mapping Exception|Related Specimen|Related Specimen ID|Extract Ver|" 107 S ^TMP($J,"LRDATA",20)=X 108 S X=" 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 |" 109 S ^TMP($J,"LRDATA",21)=X 110 S ^TMP($J,"LRDATA",22)=$$REPEAT^XLFSTR("-",$L(X)) 111 S ^TMP($J,"LRDATA",24)=$$UUBEGFN^LRSRVR2A(LRFILENM) 112 Q 113 ; 114 ; 115 MAILSEND(LRMSUBJ) ; Send extract back to requestor. 116 ; 117 N LRINSTR,LRTASK,LRTO,XMERR,XMZ 118 S LRTO(XQSND)="" 119 S LRINSTR("ADDR FLAGS")="R" 120 S LRINSTR("FROM")="LAB_PACKAGE" 121 S LRMSUBJ=$E(LRMSUBJ,1,65) 122 D SENDMSG^XMXAPI(.5,LRMSUBJ,"^TMP($J,""LRDATA"")",.LRTO,.LRINSTR,.LRTASK) 123 Q 1 LRSRVR6 ;DALIO/JMC - LAB DATA SERVER CONT'D SNOMED EXTRACT ;Aug 17, 2006 2 ;;5.2;LAB SERVICE;**346**;Sep 27, 1994;Build 10 3 ; Produces SNOMED extract via LRLABSERVER option 4 ; 5 Q 6 ; 7 ; 8 SERVER ; Server entry Point 9 N I,LRCNT,LREND,LRL,LRMSUBJ,LRST,LRSTN,LRTXT,LRX,LRY 10 D BUILD 11 S LRMSUBJ=LRST_" "_LRSTN_" SNOMED EXTRACT "_$$HTE^XLFDT($H,"1M") 12 D MAILSEND(LRMSUBJ) 13 D CLEAN 14 Q 15 ; 16 ; 17 BUILD ; Build extract 18 N J,LRCNT,LRCRLF,LRETIME,LRFN,LRLEX,LRNAME,LRQUIT,LRROOT,LRSCT,LRSCTEC,LRSCTVER,LRSCTX,LRSPEC,LRSTIME,LRSTR,LRVAL,LRVUID,LRX,LRY,X,Y 19 ; 20 S LRSTIME=$$NOW^XLFDT,LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2),LRSCTVER="" 21 I LRST="" S LRST="???" 22 K ^TMP($J,"LRDATA") 23 S (LRCNT,LRCNT("SCT"))=0,LRCRLF=$C(13,10),LRSTR="" 24 F I=61,61.1,61.2,61.3,61.4,61.5,61.6,62 S LRCNT(I)=0,LRCNT(I,"SCT")=0 25 D HDR 26 ; 27 ; Flag to indicate if SNOMED CT is available from LEXICON. 28 S LRLEX=0 29 I $T(CODE^LEXTRAN)'="" S LRLEX=1 30 ; 31 F LRFN=61,61.1,61.2,61.3,61.4,61.5,61.6,62 D 32 . S LRROOT="^LAB("_LRFN_",""B"")" 33 . D FILE 34 ; 35 S LRETIME=$$NOW^XLFDT 36 ; Set the final info into the ^TMP message global 37 S LRNODE=$O(^TMP($J,"LRDATA",""),-1) 38 I LRSTR'="" S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR) 39 S ^TMP($J,"LRDATA",LRNODE+1)=" " 40 S ^TMP($J,"LRDATA",LRNODE+2)="end" 41 ; 42 S ^TMP($J,"LRDATA",1)=^TMP($J,"LRDATA",1)_" (Run time:"_$$FMDIFF^XLFDT(LRETIME,LRSTIME,3)_")" 43 S ^TMP($J,"LRDATA",3)="SNOMED CT version......: "_LRSCTVER 44 S J=6 45 S ^TMP($J,"LRDATA",J)="Number of records per file:" 46 F I=61,61.1,61.2,61.3,61.4,61.5,61.6,62 D 47 . S J=J+1 48 . S ^TMP($J,"LRDATA",J)=" "_$$LJ^XLFSTR($$GET1^DID(I,"","","NAME")_" File (#"_I_")",32,".")_": "_$J(LRCNT(I),5)_" ("_LRCNT(I,"SCT")_" mapped)" 49 S ^TMP($J,"LRDATA",J+1)=$$LJ^XLFSTR("Total number of records",33,".")_": "_$J(LRCNT,5)_" ("_LRCNT("SCT")_" mapped)" 50 ; 51 Q 52 ; 53 ; 54 CLEAN ; 55 K ^TMP($J,"LR61") 56 K LRIEN,LRLEN,LRNODE,LRSNM,LRSPECN 57 D CLEAN^LRSRVR 58 D ^%ZISC 59 Q 60 ; 61 ; 62 FILE ; Search file entry and build record. 63 ; 64 F S LRROOT=$Q(@LRROOT) Q:LRROOT="" Q:$QS(LRROOT,2)'="B" D 65 . Q:$G(@LRROOT) 66 . S LRIEN=$QS(LRROOT,4),LRSPEC="" 67 . S LRNAME=$P($G(^LAB(LRFN,LRIEN,0)),"^"),LRNAME=$$TRIM^XLFSTR(LRNAME,"RL"," ") 68 . S X=$P($G(^LAB(LRFN,LRIEN,0)),"^",2) 69 . S LRSNM=$S(LRFN'=62:X,1:"") 70 . I LRFN=62 S LRSPEC=X 71 . I LRSNM'="",LRFN>60.9,LRFN<61.61 S LRX=((LRFN*10)#610)+1,LRSNM=$E("TMEFDPJ",LRX)_"-"_LRSNM 72 . S LRSCT=$P($G(^LAB(LRFN,LRIEN,"SCT")),"^"),(LRSCTEC,LRSCTX,LRVUID)="" 73 . I LRLEX,LRSCT'="" D 74 . . K LRX 75 . . S LRX=$$CODE^LEXTRAN(LRSCT,"SCT",DT,"LRX") 76 . . S LRSCTX=$G(LRX("F")),LRSCTEC=$S(LRX<1:$P(LRX,"^",2),1:"") 77 . . I LRSCTVER="",LRX>0 S LRSCTVER=$P($G(LRX(0)),"^",3) 78 . S LRSTR=LRSTR_LRST_"-"_LRFN_"-"_LRIEN_"|"_LRNAME_"|"_LRSNM_"|"_LRVUID_"|"_LRSCT_"|"_LRSCTX_"|"_LRSCTEC_"|" 79 . S LRSPECN="|" 80 . I LRFN=62,LRSPEC D 81 . . S LRSPECN=$P($G(^LAB(61,LRSPEC,0)),"^") 82 . . S LRSPECN=LRSPECN_"|"_LRST_"-61-"_LRSPEC 83 . S LRSTR=LRSTR_LRSPECN_"|1.1|" 84 . S LRCNT=LRCNT+1,LRCNT(LRFN)=LRCNT(LRFN)+1 S:LRSCT LRCNT("SCT")=LRCNT("SCT")+1,LRCNT(LRFN,"SCT")=LRCNT(LRFN,"SCT")+1 85 . D SETDATA 86 Q 87 ; 88 ; 89 SETDATA ; Set data into report structure 90 S LRSTR=LRSTR_LRCRLF 91 S LRNODE=$O(^TMP($J,"LRDATA",""),-1) 92 D ENCODE^LRSRVR4(.LRSTR) 93 Q 94 ; 95 ; 96 HDR ; Set the header information 97 N LRFILENM 98 S LRFILENM=$TR(LRSTN," ","_")_"-"_LRSUB_"-"_$P($$FMTHL7^XLFDT(LRSTIME),"-")_".TXT" 99 S ^TMP($J,"LRDATA",1)="Report Generated.......: "_$$FMTE^XLFDT(LRSTIME)_" at "_LRSTN 100 S ^TMP($J,"LRDATA",2)="Report requested.......: "_LRSUB 101 S ^TMP($J,"LRDATA",3)="SNOMED CT version......: " 102 S ^TMP($J,"LRDATA",4)="Extract version........: 1.1" 103 F I=5,15,16,18,23 S ^TMP($J,"LRDATA",I)=" " 104 S ^TMP($J,"LRDATA",17)="Attached file..........: "_LRFILENM 105 S ^TMP($J,"LRDATA",19)="Legend:" 106 S X="Station #-File #-IEN|Entry Name|SNOMED I|VUID|SNOMED CT|SNOMED CT TERM|Mapping Exception|Related Specimen|Related Specimen ID|Extract Ver|" 107 S ^TMP($J,"LRDATA",20)=X 108 S X=" 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 |" 109 S ^TMP($J,"LRDATA",21)=X 110 S ^TMP($J,"LRDATA",22)=$$REPEAT^XLFSTR("-",$L(X)) 111 S ^TMP($J,"LRDATA",24)=$$UUBEGFN^LRSRVR2A(LRFILENM) 112 Q 113 ; 114 ; 115 MAILSEND(LRMSUBJ) ; Send extract back to requestor. 116 ; 117 N LRINSTR,LRTASK,LRTO,XMERR,XMZ 118 S LRTO(XQSND)="" 119 S LRINSTR("ADDR FLAGS")="R" 120 S LRINSTR("FROM")="LAB_PACKAGE" 121 D SENDMSG^XMXAPI(.5,LRMSUBJ,"^TMP($J,""LRDATA"")",.LRTO,.LRINSTR,.LRTASK) 122 Q
Note:
See TracChangeset
for help on using the changeset viewer.
