source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRSRVR7.m@ 1154

LRSRVR7 ;DALIO/JMC - LAB DATA SERVER CONT'D CPT EXTRACT ;Aug 17, 2006
 ;;5.2;LAB SERVICE;**346**;Sep 27, 1994;Build 10
 ; Produces NLT/CPT extract via LRLABSERVER option
 ;
 Q
 ;
 ;
SERVER ; Server entry Point
 N I,LRCNT,LREND,LRL,LRMSUBJ,LRST,LRSTN,LRTXT,LRX,LRY
 D BUILD
 S LRMSUBJ=LRST_" "_LRSTN_" NLT/CPT EXTRACT "_$$HTE^XLFDT($H,"1M")
 D MAILSEND^LRSRVR6(LRMSUBJ)
 D CLEAN
 Q
 ;
 ;
BUILD ; Build extract
 N LRCNT,LRCRLF,LRFN,LRNAME,LRQUIT,LRROOT,LRSCT,LRSTR,LRVAL,LRVUID,X,Y
 ;
 S LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2)
 I LRST="" S LRST="???"
 K ^TMP($J,"LRDATA")
 S (LRCNT,LRCNT(1),LRCNT(2))=0,LRCRLF=$C(13,10),LRSTR=""
 D HDR,FILE
 ;
 ;
 ; Set the final info into the ^TMP message global
 S LRNODE=$O(^TMP($J,"LRDATA",""),-1)+1
 I LRSTR'="" S ^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR)
 S ^TMP($J,"LRDATA",LRNODE+1)=" "
 S ^TMP($J,"LRDATA",LRNODE+2)="end"
 ;
 S J=4
 S ^TMP($J,"LRDATA",J)="Number of records per file:"
 S ^TMP($J,"LRDATA",J+1)=$$LJ^XLFSTR("Total number of records",33,".")_": "_$J(LRCNT,5)
 S ^TMP($J,"LRDATA",J+2)=$$LJ^XLFSTR("CPT/LOINC records",33,".")_": "_$J(LRCNT(1),5)
 S ^TMP($J,"LRDATA",J+3)=$$LJ^XLFSTR("CPT/Default LOINC records",33,".")_": "_$J(LRCNT(2),5)
 ;
 Q
 ;
 ;
CLEAN ;
 K ^TMP($J,"LR61")
 K J,LA7PCNT,LR64CODE,LR64NM,LRFILENM,LRLEN,LRLN,LRLNC,LRNODE,LRSTSYN
 D CLEAN^LRSRVR
 D ^%ZISC
 Q
 ;
 ;
FILE ;
 ;
 N LR64,LR64018,LR81,LRCPT,LRCPTNM,LRI,LRXX,LRYY,LRZ
 S LRROOT="^LAM(""AD"")",(LR64,LR64018)=0
 F  S LRROOT=$Q(@LRROOT) Q:LRROOT=""  Q:$QS(LRROOT,1)'="AD"  D
 . I $QS(LRROOT,3)'="CPT" Q
 . I LR64'=$QS(LRROOT,2) D
 . . S LR64=$QS(LRROOT,2)
 . . S X=$G(^LAM(LR64,0))
 . . S LR64NM=$P(X,"^"),LR64CODE=$P(X,"^",2)
 . . D LOINC
 . . S LRCNT=LRCNT+1
 . S LR64018=$QS(LRROOT,4)
 . S LR81=+$P($G(^LAM(LR64,4,LR64018,0)),"^")
 . S X=$$CPT^ICPTCOD(LR81,DT,1)
 . S LRCPT=$S($P(X,"^")>0:$P(X,"^",2),1:"IEN "_LR81)
 . S LRCPTNM=$S($P(X,"^")>0:$P(X,"^",3),1:$P(X,"^",2))
 . ;  File "default" mapping
 . S LRSTR=LRSTR_LRST_"-"_LR64_"-"_LR64018_"|"_LR64CODE_"|"_LR64NM_"|"_LRCPT_"|"_LRCPTNM_"|"_LRLN
 . D SETDATA
 . ; File specific specimen/time aspect LOINC mappings
 . S LRXX=LRST_"-"_LR64_"-"_LR64018_"-"
 . S LRYY="|"_LR64CODE_"|"_LR64NM_"|"_LRCPT_"|"_LRCPTNM_"|"
 . S LRI=""
 . F  S LRI=$O(LRLN(LRI)) Q:LRI=""  D
 . . S LRSTR=LRSTR_LRXX_LRI_LRYY_LRLN(LRI)
 . . D SETDATA
 Q
 ;
 ;
SETDATA ; Set data into report structure
 S LRSTR=LRSTR_LRCRLF
 S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
 D ENCODE^LRSRVR4(.LRSTR)
 Q
 ;
 ;
HDR ; Set the header information
 S LRFILENM=$TR(LRSTN," ","_")_"-"_LRSUB_"-"_$P($$FMTHL7^XLFDT($$NOW^XLFDT),"-")_".TXT"
 S ^TMP($J,"LRDATA",1)="Report generated.......: "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_LRSTN
 S ^TMP($J,"LRDATA",2)="Report requested.......: "_LRSUB
 F I=3,8,10,15 S ^TMP($J,"LRDATA",I)=" "
 S ^TMP($J,"LRDATA",9)="Attached file..........: "_LRFILENM
 S ^TMP($J,"LRDATA",11)="Legend:"
 S X="Station #-NLT IEN-CPT IEN-Spec-Time Aspect|NLT Code|NLT Name|CPT Code|CPT Name|Specimen|Time Aspect|LOINC Code|LOINC Short Name|"
 S ^TMP($J,"LRDATA",12)=X
 S X="                    1                     |    2   |   3    |    4   |    5   |    6   |     7     |     8     |        9      |"
 S ^TMP($J,"LRDATA",13)=X
 S ^TMP($J,"LRDATA",14)=$$REPEAT^XLFSTR("-",$L(X))
 S ^TMP($J,"LRDATA",16)=$$UUBEGFN^LRSRVR2A(LRFILENM)
 Q
 ;
 ;
LOINC ; Retreive any LOINC codes for the NLT code
 N LR61,LRJ,LRK,LRSPECN,LRTA,LRX
 K LRLN
 ; Default LOINC
 S LRX=$G(^LAM(LR64,9))
 S LRLN="||||"
 I $P(LRX,"^") D
 . S $P(LRLN,"|",3)=$$GET1^DIQ(95.3,$P(LRX,"^")_",",.01)
 . S $P(LRLN,"|",4)=$$GET1^DIQ(95.3,$P(LRX,"^")_",",81)
 . S LRCNT(2)=LRCNT(2)+1
 I $P(LRX,"^",2) S $P(LRLN,"|",2)=$P($G(^LAB(64.061,$P(LRX,"^",2),0)),"^")
 ;
 ; Specimen specific LOINC
 S LRJ=0
 F  S LRJ=$O(^LAM(LR64,5,LRJ)) Q:'LRJ  D
 . S LR61=+$P($G(^LAM(LR64,5,LRJ,0)),"^")
 . S LRSPECN=$P($G(^LAB(61,LR61,0)),"^")
 . S LRK=0
 . F  S LRK=$O(^LAM(LR64,5,LRJ,1,LRK)) Q:'LRK  D
 . . S LRTA=$P($G(^LAM(LR64,5,LRJ,1,LRK,0)),"^")
 . . S LRLNC=$P($G(^LAM(LR64,5,LRJ,1,LRK,1)),"^")
 . . S LRLN(LRJ_"-"_LRK)=LRSPECN_"|"_$P($G(^LAB(64.061,LRTA,0)),"^")_"|"_$$GET1^DIQ(95.3,LRLNC_",",.01)_"|"_$$GET1^DIQ(95.3,LRLNC_",",81)_"|"
 . . S LRCNT(1)=LRCNT(1)+1
 ;
 Q