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

LRMLEDA.m

Go to the documentation of this file.
  1. LRMLEDA ;BPFO/DTG - NTRT MESSAGE PROCESS AND EDITS UPDATE ;12/26/2017
  1. ;;5.2;LAB SERVICE;**468,500**;Sep 27, 1994;Build 29
  1. ;
  1. ; This section is for sending the XML message to ISAAC via HTTP/HTTPS
  1. ;
  1. ; first we save to ^XTMP
  1. Q
  1. EN ; XTMP save
  1. N LRXTMPNM,LRXTMPNUM,CNT,LRNTRTSAV
  1. S CNT=0
  1. ENA S LRXTMPNM="LRNTRTSAV"
  1. L +^XTMP(LRXTMPNM):30 I '$T H 10 S CNT=CNT+1 G ENA:CNT<11,ENO
  1. S ^XTMP(LRXTMPNM,0)=$$FMADD^XLFDT(DT,365)_U_$$NOW^XLFDT()_U_"Lab New Term to NTRT STS XML"
  1. S LRXTMPNUM=$G(^XTMP(LRXTMPNM,"CTRL")),LRXTMPNUM=LRXTMPNUM+1,^XTMP(LRXTMPNM,"CTRL")=LRXTMPNUM
  1. L -^XTMP(LRXTMPNM)
  1. S CNT=0
  1. ; LRTEXT is the built XML send array
  1. ; LR60IEN is the file 60 test IEN
  1. ; LRS is the Specimen IEN from the 60 specimen multiple (60.01)
  1. ; LRDUZ is the DUZ of the person saving the test/specimen item
  1. ENL L +^XTMP(LRXTMPNM,"SEND",LRXTMPNUM):20 I '$T H 2 S CNT=CNT+1 G ENL:CNT<11,ENO
  1. M ^XTMP(LRXTMPNM,"SEND",LRXTMPNUM,"I")=LRTEXT
  1. S ^XTMP(LRXTMPNM,"SEND",LRXTMPNUM,"DUZ")=LRDUZ
  1. S ^XTMP(LRXTMPNM,"SEND",LRXTMPNUM,"LR60IEN")=LR60IEN
  1. S ^XTMP(LRXTMPNM,"SEND",LRXTMPNUM,"LRS")=LRS
  1. S ^XTMP(LRXTMPNM,"SEND",LRXTMPNUM,"ERROR")=0
  1. L -^XTMP(LRXTMPNM,"SEND",LRXTMPNUM)
  1. ENSL L +^XTMP(LRXTMPNM,"O"):5 I '$T G ENO
  1. N ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDESC
  1. S LRNTRTSAV="LRNTRTSAV"
  1. S ZTDTH=$$NOW^XLFDT,ZTDESC="LAB Send NTRT message to ISAAC"
  1. S ZTSAVE("LRXTMPNM")=""
  1. S ZTRTN="XMLSND^LRMLEDA",ZTIO=""
  1. D ^%ZTLOAD
  1. L -^XTMP(LRXTMPNM,"O")
  1. K ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDESC
  1. ENO K LRXTMPNM,LRXTMPNUM,CNT,LRNTRTSAV
  1. Q
  1. ;
  1. ; entry to send messages to ISAAC
  1. ;
  1. XMLSND ;
  1. N CNT,A,B,C,LRT,LRDUZ,LRG,LRS,LR60IEN,LRA,LRTEXT,LRRDAT,LRSDAT,LRRHD,LRSHD,LRFLG,LRMETH,URL,LRXTVER
  1. N LSITE,LRNT,LRNTI,AR,LRNMAIL,LRGMAIL,LRIS,LRPRT,LRIPATH,LXA,LXB,LRNOS1,LRNOS2,LRERR,LRDUZ,LRXTMPNM
  1. N AB,CC,DA,DIC,DIQ,DR,E,LACT,LRNOS3,LRSITEN,LXC,STATUS,XMDUZ,XMY,XMSUB,XMTEXT
  1. S CNT=0,LRXTMPNM="LRNTRTSAV"
  1. X1 L +^XTMP(LRXTMPNM,"O"):20 I '$T S CNT=CNT+1 G X1:CNT<11,XMLOUT
  1. I $G(DT)="" S DT=$$DT^XLFDT
  1. ; get file 66.4 current info
  1. S LSITE=$$SITE^VASITE,LSITE=$P(LSITE,U,1)
  1. S LRNT=$O(^LAB(66.4,"B",LSITE,0))
  1. D GETS^DIQ(66.4,LRNT_",","**","IE","AR")
  1. M LRNTI=AR("66.4",LRNT_",") K AR
  1. ;site number and name
  1. S LRSITE=$G(LRNTI(.01,"I")),LRSITEN=$G(LRNTI(.01,"E"))
  1. ;ntrt mail group
  1. S LRNMAIL=$G(LRNTI(1,"I"))
  1. ;lab send mail group
  1. S LRGMAIL=$G(LRNTI(2,"I"))
  1. ;how to send mail
  1. S LACT=$G(LRNTI(.02,"E"))
  1. ; Isaac web address
  1. S LRIS=$G(LRNTI(4,"I"))
  1. S AA=$$XUP(LRIS) S:$E(AA,1,4)="HTTP" LRIS=$P(LRIS,"//",2,999) S:$E(LRIS,($L(LRIS)))="/" LRIS=$E(LRIS,1,($L(LRIS)-1))
  1. ; Isaac port number
  1. S LRPRT=$G(LRNTI(5,"I"))
  1. ; Isaac path
  1. S LRIPATH=$G(LRNTI(6,"I")) I LRIPATH'="" D ;<
  1. . S LRIPATH=$TR(LRIPATH,"~","/")
  1. . S:$E(LRIPATH,1)'="/" LRIPATH="/"_LRIPATH
  1. S URL=LRIS_":"_LRPRT_LRIPATH
  1. ; if web address or port number are nill do not send
  1. S LRNOS3=0 I $G(LRNTI(4,"I"))=""!($G(LRNTI(5,"I"))="") S LRNOS3=1
  1. ;if no send method
  1. S LRNOS1=0 I LACT=""!(LACT="N")!($G(LRNTI(.05,"I"))="N")!($G(LRNTI(.1,"I"))'=1) S LRNOS1=1
  1. S AA=$$XUP(LRGMAIL)
  1. ; if not production or not VA
  1. S LRNOS2=0 I '$$PROD^XUPROD()!(AA'["DOMAIN.EXT") S LRNOS2=1
  1. ;
  1. S LRA=0,LRXTVER=1+($$PATCH^XPDUTL("XT*7.3*138"))
  1. S LRFLG=10
  1. X2 S LRA=$O(^XTMP(LRXTMPNM,"SEND",LRA)) I 'LRA L -^XTMP(LRXTMPNM,"O") G XMLOUT
  1. S CNT=0
  1. X2A L +^XTMP(LRXTMPNM,"SEND",LRA):5 I '$T S CNT=CNT+1 G X2A:CNT<11,XMLOUT
  1. K LRT,LRRHD,LRRHD,LRSDAT,LRSHD,REDIR
  1. S (LRRHD,LRSHD,LRRDAT)=""
  1. S REDIR=0,LRSHD("CONTENT-TYPE")="application/xml",STATUS=""
  1. M LRT=^XTMP(LRXTMPNM,"SEND",LRA,"I")
  1. S LRDUZ=^XTMP(LRXTMPNM,"SEND",LRA,"DUZ"),LR60IEN=^XTMP(LRXTMPNM,"SEND",LRA,"LR60IEN")
  1. S LRS=^XTMP(LRXTMPNM,"SEND",LRA,"LRS"),LRERR=^XTMP(LRXTMPNM,"SEND",LRA,"ERROR")
  1. ; File 60 test info
  1. ; .01 test name, 4 subscript (CH), 5 data name, 13 field (DD of 5), 64.1 result nlt code
  1. S DA=+LR60IEN
  1. S DIQ="LXB",DIQ(0)="IE",DIC=60,DR=".01;4;64.1;5;13;132;133" K ^UTILITY("DIQ1",$J) D EN^DIQ1 K ^UTILITY("DIQ1",$J)
  1. K LXA M LXA=LXB(60,DA) K LXB
  1. ; get file 60 Test/Specimen info
  1. S DIQ="LXB",DIQ(0)="IE",DIC=60,DR=100,DA=+LR60IEN K LXB,^UTILITY("DIQ1",$J)
  1. S DR(60.01)=".01;6;1;2;9.2;9.3;13;30;32;33;34;35",DA(60.01)=LRS
  1. D EN^DIQ1 K ^UTILITY("DIQ1",$J)
  1. K LXC M LXC=LXB("60.01",LRS) K LXB
  1. ; do not try if failed 10 times
  1. I LRERR>9 D XMERR G X2
  1. ;
  1. ; check if ok to send a message
  1. I LRNOS1=1!(LRNOS2=1)!(LRNOS3=1) D NOTVALID G X2
  1. ;
  1. S STATUS=$$GETURL^XTHC10(URL,LRFLG,"LRRDAT",.LRRHD,"LRT",.LRSHD,$G(REDIR)+1)
  1. S A=$TR(STATUS,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. I A["OK"!(A["ACCEPTED") D G X2
  1. .; send message to order and group that message was sent to ISAAC NTRT
  1. . K XMY,LRTEXT
  1. . S XMSUB="NEW NTRT REQUEST FOR LABORATORY HAS BEEN SENT"
  1. . S XMY(LRDUZ)=""
  1. . S XMDUZ("AUTO ISAAC NTRT PROCESS")="" I LRGMAIL'="" S XMY($P(LRGMAIL,"@",1))=""
  1. . S LRTEXT(1)="A new Laboratory Test has been entered at: "_LRSITEN_" / "_LRSITE
  1. . S LRTEXT(2)=""
  1. . S LRTEXT(3)="Laboratory Test Name / Specimen name: "_$G(LXA(.01,"I"))_" / "_$G(LXC(.01,"E"))
  1. . S LRTEXT(4)=""
  1. . S LRTEXT(5)="Send Status: "_STATUS
  1. . S LRTEXT(6)=""
  1. . S A=0,B="",I=6 F S A=$O(LRRDAT(A)) Q:'A S B=$G(LRRDAT(A)) S:B'="" I=I+1,LRTEXT(I)="ISAAC Reference Information: "_B
  1. . S LRTEXT(I+1)=""
  1. . S XMTEXT="LRTEXT(" D ^XMD
  1. . ;put exception flag in 60 file
  1. . ; since making exception flag uneditable must do physical set
  1. . N A,B,LRO,LRN,I S A=$G(^LAB(60,LR60IEN,1,LRS,5)),B=A,$P(B,U,3)="Y",^LAB(60,LR60IEN,1,LRS,5)=B
  1. . ; need to build array for saving in audit section
  1. . F I=1,2,4 S LRO(I)="",LRN(I)=""
  1. . S LRO(3)=$P(A,U,3),LRN(3)=$P(B,U,3) D ;<
  1. . . N ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDESC
  1. . . S ZTDTH=$$NOW^XLFDT,ZTDESC="LAB Edit Save of Deployed Flag"
  1. . . S ZTRTN="SEDA^LRMLED("_LRS_","_LR60IEN_")",ZTSAVE("LR60IEN")="",ZTSAVE("LRS")=""
  1. . . S ZTSAVE("LRN(")="",ZTSAVE("LRO(")=""
  1. . . S ZTIO=""
  1. . . D ^%ZTLOAD
  1. . ; remove item from send
  1. . S ^XTMP(LRXTMPNM,"DONE",LRA)=LR60IEN_U_LRS_$$NOW^XLFDT_U_LRDUZ
  1. . K ^XTMP(LRXTMPNM,"SEND",LRA)
  1. . L -^XTMP(LRXTMPNM,"SEND",LRA)
  1. . ;
  1. S LRERR=LRERR+1,^XTMP(LRXTMPNM,"SEND",LRA,"ERROR")=LRERR,^XTMP(LRXTMPNM,"SEND",LRA,"ERROR",LRERR)=STATUS
  1. L -^XTMP(LRXTMPNM,"SEND",LRA)
  1. G X2
  1. ;
  1. XMLOUT K CNT,A,B,C,LRT,LRDUZ,LRG,LRS,LR60IEN,LRA,LRTEXT,LRRDAT,LRSDAT,LRRHD,LRSHD,LRFLG,LRMETH,URL,LRXTVER
  1. K LSITE,LRNT,LRNTI,AR,LRNMAIL,LRGMAIL,LRIS,LRPRT,LRIPATH,LXA,LXB,LRNOS1,LRNOS2,LRERR,LRDUZ,AA,LRXTMPNM
  1. K AB,CC,DA,DIC,DIQ,DR,E,LACT,LRNOS3,LRSITEN,LXC,STATUS,XMDUZ,XMY,XMSUB,XMTEXT
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. ;
  1. XUP(UP) ;change to upper case
  1. I UP="" Q ""
  1. N A
  1. S A=$TR(UP,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. Q A
  1. ;
  1. XMERR ; If error count is above 9 send message to LIM that request did not go out and include request in message
  1. ;
  1. K XMY,LRTEXT
  1. S XMSUB="NOT ABLE TO SEND NEW NTRT REQUEST FOR LABORATORY"
  1. S XMY(LRDUZ)=""
  1. S XMDUZ("AUTO ISAAC NTRT PROCESS")="" I LRGMAIL'="" S XMY($P(LRGMAIL,"@",1))=""
  1. S LRTEXT(1)="A new Laboratory Test has been entered at: "_LRSITEN_" / "_LRSITE
  1. S LRTEXT(2)=""
  1. S LRTEXT(3)="Laboratory Test Name / Specimen name: "_$G(LXA(.01,"I"))_" / "_$G(LXC(.01,"E"))
  1. S LRTEXT(4)=""
  1. ; the error statuses
  1. S A=0,C=5 F S A=$O(^XTMP(LRXTMPNM,"SEND",LRA,"ERROR",A)) Q:'A S B=^XTMP(LRXTMPNM,"SEND",LRA,"ERROR",A) D ;<
  1. . S LRTEXT(C)="Error number: "_A_" Error Reason: "_B,LRTEXT(C+1)=""
  1. . S C=C+2
  1. S LRTEXT(C)="Original Message Contents:",LRTEXT(C+1)="",C=C+2
  1. S A=0 F S A=$O(LRT(A)) Q:'A S B=LRT(A),LRTEXT(C)=B,C=C+1
  1. S LRTEXT(C)=""
  1. S XMTEXT="LRTEXT(" D ^XMD
  1. M ^XTMP(LRXTMPNM,"NOTSENT",LRA)=^XTMP(LRXTMPNM,"SEND",LRA)
  1. K ^XTMP(LRXTMPNM,"SEND",LRA)
  1. L -^XTMP(LRXTMPNM,"SEND",LRA)
  1. Q
  1. ;
  1. NOTVALID ; if not valid to send to ISAAC then only send MAILMAN message to
  1. K XMY,LRTEXT
  1. S XMSUB="NOT ABLE TO SEND NEW NTRT REQUEST FOR LABORATORY"
  1. S XMY(LRDUZ)=""
  1. S XMDUZ("AUTO ISAAC NTRT PROCESS")="" I LRGMAIL'="" S XMY($P(LRGMAIL,"@",1))=""
  1. S LRTEXT(1)="A new Laboratory Test has been entered at: "_LRSITEN_" / "_LRSITE
  1. S LRTEXT(2)=""
  1. S LRTEXT(3)="Laboratory Test Name / Specimen name: "_$G(LXA(.01,"I"))_" / "_$G(LXC(.01,"E"))
  1. S LRTEXT(4)=""
  1. S LRTEXT(5)=" ** This message was not sent to ISAAC due to one of the following reasons: **"
  1. S C=5
  1. S A="",B="",CC="",D="",E="" S:LRNOS1=1 A="No Send Location" S:'$$PROD^XUPROD() B="Not a Production System" S:AA'["DOMAIN.EXT" CC="Not a VA System"
  1. I LRNOS3=1 S:$G(LRNTI(4,"I"))="" D="Missing ISAAC Web Address" S:$G(LRNTI(5,"I"))="" E="Missing ISAAC Port Number"
  1. I B'=""!(C'="") D ;<
  1. . F I="A","B","CC","D","E" S AB=$G(@I) I AA'="" S C=C+1,LRTEXT(C)=AB
  1. . ; I B'="" S:A'="" A=A_" , " S A=A_B
  1. . ; I CC'="" S:A'="" A=A_" , " S A=A_CC
  1. . ; I D'="" S:A'="" A=A_" , " S A=A_D
  1. . ; I E'="" S:A'="" A=A_" , " S A=A_E
  1. ; S LRTEXT(6)=A,LRTEXT(7)="",C=8
  1. S C=C+1,LRTEXT(C)="",C=C+1
  1. S LRTEXT(C)="Original Message Contents:",LRTEXT(C+1)="",C=C+2
  1. S A=0 F S A=$O(LRT(A)) Q:'A S B=LRT(A),LRTEXT(C)=B,C=C+1
  1. S LRTEXT(C)=""
  1. S XMTEXT="LRTEXT(" D ^XMD
  1. K ^XTMP(LRXTMPNM,"SEND",LRA)
  1. L -^XTMP(LRXTMPNM,"SEND",LRA)
  1. Q
  1. ;
  1. CHKACT(FILIEN) ; check if 66.3 item is active
  1. ;
  1. N A,B,C,D
  1. I 'FILIEN Q "0"
  1. S (A,B,C)=""
  1. S A=$O(^LRMLTF(FILIEN,"TERMSTATUS",9999999),-1) I 'A Q "0"
  1. S B=$G(^LRMLTF(FILIEN,"TERMSTATUS",A,0))
  1. I $P(B,U,2)=1 Q "1"
  1. Q "0"
  1. ;
  1. XML ;send xml to NTRT
  1. ; moved here from LRMLED
  1. S ALI=0 K LRTEXT
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)=$$XMLHDR^MXMLUTL()
  1. ; get the schemea name and the schema path
  1. S LRSCHNM=$G(LRNTI(7,"I")),LRSCHPA=$G(LRNTI(8,"I"))
  1. S A=$TR(LRSCHNM,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. I LRSCHNM'=""&($E(A,($L(A)-4),$L(A))'[".XSD") S LRSCHNM=LRSCHNM_".XSD"
  1. I LRSCHPA'="" D ;<
  1. . S LRSCHPA=$TR(LRSCHPA,"~","/")
  1. . I $E(LRSCHPA,1,2)'="//" S LRSCHPA="//"_LRSCHPA
  1. . I $E(LRSCHPA,$L(LRSCHPA))'="/" S LRSCHPA=LRSCHPA_"/"
  1. S A="uri:"_LRSCHPA_LRSCHNM
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<DATAEXTRACTS xmlns="""_A_""" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"""
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)=">"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<LAB_NTRT>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Facility_Name-Number>"_LRSITEN_" - "_LRSITE_"</Facility_Name-Number>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Facility_Group_e-mail>"_LRGMAIL_"</Facility_Group_e-mail>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<New_Laboratory_Test_Name>"_$G(LXA(.01,"I"))_"</New_Laboratory_Test_Name>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<New_Laboratory_Test_LOCAL_IEN>"_(+LR60IEN)_"</New_Laboratory_Test_LOCAL_IEN>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Laboratory_Test_Site-Specimen_Number_IEN>"_$G(LXC(.01,"I"))_"</Laboratory_Test_Site-Specimen_Number_IEN>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Laboratory_Test_Site-Specimen_Name>"_$G(LXC(.01,"E"))_"</Laboratory_Test_Site-Specimen_Name>"
  1. S B="",A=$G(LXC(.01,"I")) I A S A=$G(^LAB(61,A,0)),B=$P(A,U,10) I +B>0 S B=$P($G(^LAB(64.061,B,0)),U,1)
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Spec>"_$P(A,U,1)_"</Spec>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Time_Aspect>"_B_"</Time_Aspect>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Units>"_$G(LXC(6,"I"))_"</Units>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<RNLT>"_LRNLT_"</RNLT>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Lab_Section>"_LRSEC_"</Lab_Section>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Subscript>"_$G(LXA(4,"I"))_"</Subscript>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Data_Name>"_LRDTNM_"</Data_Name>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Data_Comment>"_LRCOM_"</Data_Comment>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Data_Type>"_LRCTY_"</Data_Type>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Reference_Low>"_$G(LXC(1,"I"))_"</Reference_Low>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Reference_High>"_$G(LXC(2,"I"))_"</Reference_High>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Therapeutic_Low>"_$G(LXC(9.2,"I"))_"</Therapeutic_Low>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Therapeutic_High>"_$G(LXC(9.3,"I"))_"</Therapeutic_High>"
  1. ;get synonyms
  1. K B S A=0 F I=0:1 S A=$O(^LAB(60,DA,5,A)) Q:'A S B(I)=$P(^LAB(60,DA,5,A,0),U,1)
  1. I I>0 S B=I-1 F I=0:1:B S LXG=B(I) S:LXG'="" ALI=$$LRTP(ALI),LRTEXT(ALI)="<Test_Synonyms>"_LXG_"</Test_Synonyms>"
  1. ; specimen interpretation
  1. ;START OF CHANGE FOR LR*5.2*500
  1. S E=0 F I=1:1 S E=$O(LXE(E)) Q:'E S G=LXE(E),ALI=$$LRTP(ALI),LRTEXT(ALI)="<Specimen_Interpretation>"_$$CHKCHAR(G)_"</Specimen_Interpretation>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Test_Creation_Date>"_$G(LXA(131,"E"))_"</Test_Creation_Date>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Specimen_Create_Date>"_$G(LXC(35,"E"))_"</Specimen_Create_Date>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<In-House_Test>"_$G(LXA(134,"E"))_"</In-House_Test>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<POC_Test>"_$G(LXA(135,"E"))_"</POC_Test>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Scanned_Image_Test>"_$G(LXA(137,"E"))_"</Scanned_Image_Test>"
  1. S E=0 F S E=$O(LXH(E)) Q:'E D
  1. . S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Performing_Lab>"
  1. . S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Lab>"_$G(LXH(E,.01))_"</Lab>"
  1. . S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Order_Code>"_$G(LXH(E,1))_"</Order_Code>"
  1. . S ALI=$$LRTP(ALI),LRTEXT(ALI)="</Performing_Lab>"
  1. N STNTDT S STNTDT=9999999 F S STNTDT=$O(^LAB(60,LR60IEN,11,"B",STNTDT),-1) Q:'STNTDT D
  1. . N STNTIEN,I
  1. . S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Site_Note>"
  1. . S ALI=$$LRTP(ALI),LRTEXT(ALI)="<Date>"_$$FMTE^XLFDT(STNTDT)_"</Date>"
  1. . S STNTIEN=0 S STNTIEN=$O(^LAB(60,LR60IEN,11,"B",STNTDT,STNTIEN)) Q:'STNTIEN D
  1. . . S ALI=$$LRTP(ALI),LRTEXT(ALI)="<p>"
  1. . . S I=0 F S I=$O(^LAB(60,LR60IEN,11,STNTIEN,1,I)) Q:'I D
  1. . . . S ALI=$$LRTP(ALI),LRTEXT(ALI)=$$CHKCHAR($G(^LAB(60,LR60IEN,11,STNTIEN,1,I,0)))
  1. . . S ALI=$$LRTP(ALI),LRTEXT(ALI)="</p>"
  1. . S ALI=$$LRTP(ALI),LRTEXT(ALI)="</Site_Note>"
  1. ;END OF CHANGE FOR LR*5.2*500
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="</LAB_NTRT>"
  1. S ALI=$$LRTP(ALI),LRTEXT(ALI)="</DATAEXTRACTS>"
  1. G EN
  1. Q
  1. ;
  1. LRTP(AA) ;update text counter
  1. S AA=AA+1
  1. Q AA
  1. ;
  1. CHKCHAR(A) ; check for ctrl chars, <, >, &
  1. N B,C,I,L,M,N
  1. I A="" Q A
  1. S B="" F I=1:1:$L(A) S C=$E(A,I) D S L=C
  1. . S M=$E(A,(I+1))
  1. . I $A(C)<32!($A(C)>126) Q ; skip set
  1. . I C="&" S N="'AND'",B=B_N Q
  1. . I C="<" S N="'LESS THAN'",B=B_N Q
  1. . I C=">" S N="'GREATER THAN'",B=B_N Q
  1. . S B=B_C
  1. Q B
  1. ;