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

LRSRVR1.m

Go to the documentation of this file. 
  1. LRSRVR1 ;VA/DALOI/JMC -LAB DATA SERVER, CONT'D - LOINC SECTION ;JUL 06, 2010 3:14 PM
  1.  ;;5.2;LAB SERVICE;**303,1027**;NOV 01, 1997
  1.  ;
  1.  ; LR*5.2*1027 - IHS/OIT/MKK
  1.  ;
  1. LOINC ; Scan for LOINC Coding
  1.  ;
  1.  N LR60,LR61,LRLLINA,LRLLINB,LRLLINC,LRX
  1.  K XMY
  1.  ;S XMY("G.LOINCSERVER@ISC-DALLAS.VA.GOV")=""    ; LR*5.2*1027 - Don't send to VA
  1.  S XMY(XQSND)=""
  1.  S ^TMP($J,"LRDATA",1)="*"_$$NOW^XLFDT
  1.  S ^TMP($J,"LRDATA",2)="No codes defined at "_LRSTN
  1.  K ^TMP($J,"LRSERVER","LOINC")
  1.  S LINE=2,LINR=1
  1.  F LRSUB="AI","AH" D
  1.  . S LRA=""
  1.  . F  S LRA=$O(^LAM(LRSUB,LRA)) Q:'LRA  D
  1.  . . S LRB=""
  1.  . . F  S LRB=$O(^LAM(LRSUB,LRA,LRB)) Q:LRB=""  S ^TMP($J,"LRSERVER","LOINC",LRB)=""
  1.  ;
  1.  S LRA=""
  1.  F  S LRA=$O(^TMP($J,"LRSERVER","LOINC",LRA)) Q:LRA=""  D
  1.  . K LOINCDTA,LOINCDTB,LRERR
  1.  . D GETS^DIQ(64,LRA,".01;1;25;25.5","IE","LOINCDTB","LRERR")
  1.  . D GETS^DIQ(64,LRA,"20*","IE","LOINCDTA","LRERR")
  1.  . S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB=""
  1.  . I LINE>2 F  Q:'$D(^TMP($J,"LRDATA",LINE))  S LINE=LINE+1
  1.  . S LRLLINA="~"_LRST_"^"_$G(LOINCDTB(64,LRPNTB,.01,"E"))
  1.  . ;PROCEDURE (64,.01)
  1.  . S LRLLINA=LRLLINA_"^"_$G(LOINCDTB(64,LRPNTB,1,"E"))
  1.  . ;WKLD CODE (64,1)
  1.  . S LRLLINA=LRLLINA_"^"_$G(LOINCDTB(64,LRPNTB,25,"E"))
  1.  . ;DEFAULT LOINC CODE (64,25)
  1.  . S LRLLINA=LRLLINA_"^"_$G(LOINCDTB(64,LRPNTB,25.5,"E"))
  1.  . ;LOOK FOR 64.01 & 64.02 HERE
  1.  . I '$O(LOINCDTA(64.01,"")) S ^TMP($J,"LRDATA",LINE)=LRLLINA S LINE=LINE+1
  1.  . S LRAA1=""
  1.  . F  S LRAA1=$O(LOINCDTA(64.01,LRAA1)) Q:LRAA1=""  D
  1.  . . I '$D(LOINCDTA(64.01,LRAA1,.01,"I")) D  Q
  1.  . . . S ^TMP($J,"LRDTERR",LINR)="Specimen sub-field error in file 64!!  "_LRAA1,LINR=LINR+1
  1.  . . . S ^TMP($J,"LRDTERR",LINR)=$G(LRERR("DIERR",1,"TEXT",1)),LINR=LINR+1
  1.  . . S LRPNTA=LOINCDTA(64.01,LRAA1,.01,"I")
  1.  . . D GETS^DIQ(61,LRPNTA,.0961,,"LOINCTAS","LRERR")
  1.  . . S LRLLINB="^"_$G(LOINCTAS(61,LRPNTA_",",.0961))
  1.  . . ;TIME ASPECT (61,.0961)
  1.  . . S LRLLINB=LRLLINB_"^"_LOINCDTA(64.01,LRAA1,.01,"E")
  1.  . . ;SPECIMEN (64.01,.01)
  1.  . . I '$O(LOINCDTA(64.02,"")) S ^TMP($J,"LRDATA",LINE)=LRLLINA_LRLLINB,LINE=LINE+1
  1.  . . S LRAA=""
  1.  . . F  S LRAA=$O(LOINCDTA(64.02,LRAA)) Q:LRAA=""  D
  1.  . . . S LRLLINC="^"_$G(LOINCDTA(64.02,LRAA,2,"E"))
  1.  . . . ;DATA LOCATION (64.02,2)
  1.  . . . D TSTNAM
  1.  . . . ;TEST (64.02,3)
  1.  . . . S LRLLINC=LRLLINC_"^"_$G(LOINCDTA(64.02,LRAA,4,"E"))
  1.  . . . S ^TMP($J,"LRDATA",LINE)=LRLLINA_LRLLINB_LRLLINC
  1.  . . . D TSTTYP,TSTUNS
  1.  . . . S LINE=LINE+1
  1.  D EXIT^LRSRVR
  1.  Q
  1.  ;
  1.  ;
  1. LOINCL ; Build and send local LOINC report
  1.  ;
  1.  N LINE,LINR,LRA,LRXREF
  1.  K ^TMP($J,"LRSERVER","LOINC")
  1.  K XMY
  1.  S XMY(XQSND)=""
  1.  S ^TMP($J,"LRDATA",1)="Report Generated "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_LRSTN
  1.  S ^TMP($J,"LRDATA",2)="No codes defined at "_LRSTN
  1.  S LINE=2,LINR=1
  1.  F LRXREF="AI","AH" D
  1.  . S LRA=""
  1.  . F  S LRA=$O(^LAM(LRXREF,LRA)) Q:'LRA  D
  1.  . . S LRB=""
  1.  . . F  S LRB=$O(^LAM(LRXREF,LRA,LRB)) Q:LRB=""  S ^TMP($J,"LRSERVER","LOINC",LRB)=""
  1.  ;
  1.  S LRA=""
  1.  F  S LRA=$O(^TMP($J,"LRSERVER","LOINC",LRA)) Q:LRA=""  D LOINCLA
  1.  D EXIT^LRSRVR
  1.  Q
  1.  ;
  1.  ;
  1. LOINCLA ;
  1.  N LR60,LR61,LRERR,LOINCDTA,LOINCDTB,LRPNTB,LRX
  1.  S:'$D(LINE) LINE=1 S:'$D(LINR) LINR=1
  1.  D GETS^DIQ(64,LRA,".01;1;25;25.5","IE","LOINCDTB","LRERR")
  1.  D GETS^DIQ(64,LRA,"20*","IE","LOINCDTA","LRERR")
  1.  S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB=""
  1.  S ^TMP($J,"LRDATA",LINE)="",LINE=LINE+1
  1.  S ^TMP($J,"LRDATA",LINE)="NLT Procedure: "_$G(LOINCDTB(64,LRPNTB,.01,"E")),LINE=LINE+1
  1.  ;
  1.  ; Procedure (64,.01)
  1.  S ^TMP($J,"LRDATA",LINE)="NLT Code: "_$G(LOINCDTB(64,LRPNTB,1,"E")),LINE=LINE+1
  1.  ;
  1.  ; WKLD CODE (64,1)
  1.  S ^TMP($J,"LRDATA",LINE)="Default LOINC Code: "_$G(LOINCDTB(64,LRPNTB,25,"E"))_" : "_$G(^LAB(95.3,+$G(LOINCDTB(64,LRPNTB,25,"E")),80)),LINE=LINE+1
  1.  ;
  1.  ; Default LOINC code (64,25)
  1.  S ^TMP($J,"LRDATA",LINE)="Default LOINC Code Test: "_$G(LOINCDTB(64,LRPNTB,25.5,"E")),LINE=LINE+1
  1.  ;
  1.  ; Look for 64.01 & 64.02 here
  1.  S LRAA1=""
  1.  F  S LRAA1=$O(LOINCDTA(64.01,LRAA1)) Q:LRAA1=""  D
  1.  . I '$D(LOINCDTA(64.01,LRAA1,.01,"I")) D  Q
  1.  . . S ^TMP($J,"LRDATA",LINE)="Specimen sub-field error in file 64!!  "_LRAA1,LINE=LINE+1
  1.  . . S ^TMP($J,"LRDATA",LINE)=$G(LRERR("DIERR",1,"TEXT",1)),LINE=LINE+1
  1.  . S LRPNTA=LOINCDTA(64.01,LRAA1,.01,"I")
  1.  . D GETS^DIQ(61,LRPNTA,.0961,,"LOINCTAS","LRERR")
  1.  . S ^TMP($J,"LRDATA",LINE)="Time Aspect: "_LOINCTAS(61,LRPNTA_",",.0961),LINE=LINE+1
  1.  . ; TIME ASPECT (61,.0961)
  1.  . S ^TMP($J,"LRDATA",LINE)="Specimen: "_LOINCDTA(64.01,LRAA1,.01,"E"),LINE=LINE+1
  1.  . ; SPECIMEN (64.01,.01)
  1.  . S LRAA=""
  1.  . F  S LRAA=$O(LOINCDTA(64.02,LRAA)) Q:LRAA=""  I LRAA[LRAA1 D
  1.  . . S ^TMP($J,"LRDATA",LINE)="Data Location: "_$G(LOINCDTA(64.02,LRAA,2,"E")),LINE=LINE+1
  1.  . . ; DATA LOCATION (64.02,2)
  1.  . . D TSTTYP,TSTNAM,TSTUNS
  1.  . . S ^TMP($J,"LRDATA",LINE)="LOINC Code: "_$G(LOINCDTA(64.02,LRAA,4,"E"))_" : "_$G(^LAB(95.3,+$G(LOINCDTA(64.02,LRAA,4,"E")),80)),LINE=LINE+1
  1.  . . ; LOINC CODE (64.02,4)
  1.  Q
  1.  ;
  1.  ;
  1. TSTTYP ; Determine test data type
  1.  N LRX,LRTYPE,LRY
  1.  I LOINCDTA(64.02,LRAA,2,"I")="" Q
  1.  S LRX=$P(LOINCDTA(64.02,LRAA,2,"I"),"(",2)
  1.  S LRTYPE=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"","TYPE")
  1.  I LRSUB="LOINC" S $P(^TMP($J,"LRDATA",LINE),"^",11)=LRTYPE
  1.  I LRSUB="LOCAL REPORT" S ^TMP($J,"LRDATA",LINE)="Data Type: "_LRTYPE,LINE=LINE+1
  1.  S LRY=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"",$S(LRTYPE="SET":"POINTER",1:"INPUT TRANSFORM"))
  1.  I LRSUB="LOINC" S LRY=$TR(LRY,"^","~"),$P(^TMP($J,"LRDATA",LINE),"^",12)=LRY
  1.  I LRSUB="LOCAL REPORT" S ^TMP($J,"LRDATA",LINE)="Data Values: "_LRY,LINE=LINE+1
  1.  S LRY=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"","HELP-PROMPT")
  1.  I LRSUB="LOINC" S $P(^TMP($J,"LRDATA",LINE),"^",13)=LRY
  1.  I LRSUB="LOCAL REPORT" S ^TMP($J,"LRDATA",LINE)="Data Help: "_LRY,LINE=LINE+1
  1.  Q
  1.  ;
  1.  ;
  1. TSTNAM ; Test name and units
  1.  N LRX,LRY
  1.  S LRX=LOINCDTA(64.02,LRAA,3,"E")
  1.  S LRY=""
  1.  I LOINCDTA(64.02,LRAA,3,"I") S LRY=LOINCDTA(64.02,LRAA,3,"I")_"-"_LOINCDTA(64.01,$P(LRAA,",",2,4),.01,"I")
  1.  I LRSUB="LOCAL REPORT" D
  1.  . S ^TMP($J,"LRDATA",LINE)="Test: "_LRX,LINE=LINE+1
  1.  . I LRY'="" S ^TMP($J,"LRDATA",LINE)="Test-Spec: "_LRY,LINE=LINE+1
  1.  I LRSUB="LOINC" D
  1.  . S LRLLINC=LRLLINC_"^"_LRX
  1.  . S $P(^TMP($J,"LRDATA",LINE),"^",15)=LRY
  1.  Q
  1.  ;
  1.  ;
  1. TSTUNS ; Test units
  1.  N LR60,LR61,LRY
  1.  S LR60=+LOINCDTA(64.02,LRAA,3,"I"),LR61=+LOINCDTA(64.01,$P(LRAA,",",2,4),.01,"I")
  1.  S LRY=$$GET1^DIQ(60.01,LR61_","_LR60_",",6)
  1.  I LRSUB="LOINC" S $P(^TMP($J,"LRDATA",LINE),"^",14)=LRY
  1.  I LRSUB="LOCAL REPORT" S ^TMP($J,"LRDATA",LINE)="Units: "_LRY,LINE=LINE+1
  1.  Q