HDISDSRL ;BPFO/DTG - HDI MAILMAN SERVER COLLECT ITEMS FOR LABORATORY; Apr 07, 2018@12:42
;;1.0;HEALTH DATA & INFORMATICS;**22**;Feb 22, 2005;Build 26
;
;
; ICR's:
; 6894 - HDI COLLECT SDOS
;
EN ; Display found orderable items for Lab
;
;
;
; put XML into tmp file
;^TMP("HDISDOLL",$J,"T")= Orderable Item Type (P, L, or R)
;^TMP("HDISDOLL",$J,"F",1)=FACILITY NAME-NUMBER^Production Y/N^NET NAME^type of lookup (single, Partial Match, ALL)^Partial Name
;^TMP("HDISDOLL",$J,0)= O# of orderable items
;^TMP("HDISDOLL",$J,O#,1)=orderable item IEN^orderable item name^mnemonic^status^inactive date
;^TMP("HDISDOLL",$J,O#,"S",0)= S# of synonyms
;^TMP("HDISDOLL",$J,O#,"S",S#)= synonym
;^TMP("HDISDOLL",$J,O#,"LPI",0)= LPI# of primary test items (#60) tests associated to 101.43 item
;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,1)=IEN^name^Panel
;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",0)= LTI# of lab test items (#60)
;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,1)=IEN^name^type^data location^data physical location^status^inactive dt
;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",0)= LTS# of specimens for LTI (60.01)
;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",LTS,1)=IEN^name^units^inactive dt^status
;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",LTS,2)=MLTF IEN^mltf name^mltf alt name^mltf inactive dt
;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",LTS,3)=mltf status^mltf LOINC Code^mltf componet^mltf property
;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",LTS,4)=mltf time aspect^mltf specimen^mltf scale^mltf method
;
;
EN1 ;
N LPI,LPIEN,LPNM,LPO1,LPPN,LTI1,LTIDA,LTIDAP,LTIDT,LTIEN,LTINM,TAB,LTI,LTS,HDIORD
N LTIST,LTITYP,LTMANM,LTMCOM,LTMDT,LTMIEN,LTMLON,LTMMET,LTMNM,LTMPRO,LTMSCA,LTMSPC
N LTMST,LTMTIM,LTS1,LTS2,LTS3,LTS4,LTSDT,LTSIEN,LTSNM,LTSST,LTSUN,M,HDIV,HD,HD1,HD2
N O10143,OIDT,OIEN,OIMEN,OINM,OIST,OISYN,OK,OK1,QUIT,R,D,HDIA,HDIFAC,HDIOI,HDIORD
N RET1,RERROR,RERRARY
N HDFILEN1,HDFILENM,HDIFER,HDIFILN,LT,HDISUBJ,RCOUNT
S HDIV="^TMP(""HDISDOLP"",$J)",RET1="^TMP(""HDISDSRP"",$J)",RCOUNT="",RERROR="",RERRARY="" K @HDIV,@RET1
S RERROR=$$EN^HDISDOC("L","ALL","ALL",.RET1,"RERRARY","RCOUNT")
S A=1,TAB=$C(9),QUIT="",LT=0
;
L1 S A=$O(@RET1@(A)) I 'A G L1E
S B=$G(@RET1@(A)) I B["</Laboratory_Orderable_Items>" G L1E
I A=2&(B["<Laboratory_Orderable_Items") S @HDIV@("T")="LABORATORY" G L1
I B="<Facility>" S M="" G L1
I B["<Facility_Name-Number>" S $P(M,U,1)=$$N(B) G L1
I B["<Facility_Production_Account>" S $P(M,U,2)=$$N(B) G L1
I B["<Facility_Net_Name>" S $P(M,U,3)=$$N(B) G L1
I B["<Look_up_Type>" S $P(M,U,4)=$$N(B) G L1
I B["</Facility>" S @HDIV@("F",1)=M G L1
I B="<Orderable_Item>" D G L1
. S C=$G(@HDIV@(0)),C=C+1,@HDIV@(0)=C,HDIORD=C,HDIOI="",OK=0,OK1=0
. F S A=$O(@RET1@(A)),B=$G(@RET1@(A)) Q:B["</Orderable_Item>" D ;<
. . I B["<Orderable_Item_Number>" S $P(HDIOI,U,1)=$$N(B) Q
. . I B["<Orderable_Item_Name>" S C=$$N(B),$P(HDIOI,U,2)=$$CHAR(C) Q
. . I B["<Orderable_Item_Mnemonic>" S C=$$N(B),$P(HDIOI,U,3)=$$CHAR(C) Q
. . I B["<Orderable_Item_Inactive_Date>" S $P(HDIOI,U,4)=$$N(B) Q
. . I B["<Orderable_Item_Status>" S $P(HDIOI,U,5)=$$N(B),@HDIV@(HDIORD,1)=HDIOI Q
. . I B["<Orderable_Item_Synonym>" F S A=$O(@RET1@(A)),B=$G(@RET1@(A)) D I OK1=1 Q
. . . I B["<Orderable_Item_Synonym_Name>" D Q
. . . . S D=$G(@HDIV@(HDIORD,"S",0)),D=D+1,@HDIV@(HDIORD,"S",0)=D,C=$$N(B),@HDIV@(HDIORD,"S",D)=$$CHAR(C) Q
. . . I B["</Orderable_Item_Synonym>" Q
. . . I B["<Lab_Primary_Order_Item>" S A=A-1,OK1=1 Q
. . I B="<Lab_Primary_Order_Item>" D Q
. . . S C=$G(@HDIV@(HDIORD,"LPI",0)),C=C+1,@HDIV@(HDIORD,"LPI",0)=C,LPI=C,(LPO1,OK,OK1)=""
. . . F S A=$O(@RET1@(A)),B=$G(@RET1@(A)) Q:B["</Lab_Primary_Order_Item>" D ;<
. . . . I B["<Lab_Primary_Test_IEN>" S LPO1=$$N(B) Q
. . . . I B["<Lab_Primary_Test_Name>" S R=$$N(B),$P(LPO1,U,2)=$$CHAR(R) Q
. . . . I B["Lab_Primary_Test_Panel>" S $P(LPO1,U,3)=$$N(B),@HDIV@(HDIORD,"LPI",LPI,1)=LPO1 Q
. . . . I B="<Laboratory_Test_Item>" S C=$G(@HDIV@(HDIORD,"LPI",LPI,"LTI",0)),C=C+1,@HDIV@(HDIORD,"LPI",LPI,"LTI",0)=C,LTI=C,LTI1="" F S A=$O(@RET1@(A)),B=$G(@RET1@(A)) Q:B["</Laboratory_Test_Item>" D ;<
. . . . . ;S C=$G(@HDIV@(HDIORD,"LPI",LPI,"LTI",0)),C=C+1,@HDIV@(HDIORD,"LPI",LPI,"LTI",0)=C,LTI=C,LTI1=""
. . . . . I B["<Lab_Test_IEN>" S LTI1=$$N(B) Q
. . . . . I B["<Lab_Test_Name>" S C=$$N(B),$P(LTI1,U,2)=$$CHAR(C) Q
. . . . . I B["<Lab_Test_Type>" S $P(LTI1,U,3)=$$N(B) Q
. . . . . I B["<Lab_Test_Data_Location>" S $P(LTI1,U,4)=$$N(B) Q
. . . . . I B["<Lab_Test_Data_Loc_Physical>" S $P(LTI1,U,5)=$$N(B) Q
. . . . . I B["<Lab_Test_Inactive_Date>" S $P(LTI1,U,6)=$$N(B) Q
. . . . . I B["<Lab_Test_Status>" S $P(LTI1,U,7)=$$N(B),@HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,1)=LTI1 Q
. . . . . I B="<Lab_Test_Specimen>" S C=$G(@HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",0)),C=C+1,@HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",0)=C,LTS=C,(LTS1,LTS2,LTS3,LTS4)="" F S A=$O(@RET1@(A)),B=$G(@RET1@(A)) Q:B["</Lab_Test_Specimen>" D ;<
. . . . . . I B["<Lab_Test_Specimen_IEN>" S LTS1=$$N(B) Q
. . . . . . I B["<Lab_Test_Specimen_Name>" S C=$$N(B),$P(LTS1,U,2)=$$CHAR(C) Q
. . . . . . I B["<Lab_Test_Specimen_Units>" S C=$$N(B),$P(LTS1,U,3)=$$CHAR(C) Q
. . . . . . I B["<Lab_Test_Specimen_Inactive_Date>" S $P(LTS1,U,4)=$$N(B)
. . . . . . I B["<Lab_Test_Specimen_Status>" S $P(LTS1,U,5)=$$N(B),@HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",LTS,1)=LTS1 Q
. . . . . . I B="<Master_Lab_Test_Item>" Q
. . . . . . I B="</Master_Lab_Test_Item>" Q
. . . . . . I B["<Master_Lab_Test_IEN>" S LTS2=$$N(B) Q
. . . . . . I B["<Master_Lab_Test_Name>" S C=$$N(B),$P(LTS2,U,2)=$$CHAR(C) Q
. . . . . . I B["<Master_Lab_Test_Alternate_Name>" S C=$$N(B),$P(LTS2,U,3)=$$CHAR(C) Q
. . . . . . I B["<Master_Lab_Test_Inactive_Date>" S $P(LTS2,U,4)=$$N(B),@HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",LTS,2)=LTS2 Q
. . . . . . I B["<Master_Lab_Test_Status>" S LTS3=$$N(B) Q
. . . . . . I B["<Master_Lab_Test_LOINC_Code>" S $P(LTS3,U,2)=$$N(B) Q
. . . . . . I B["<Master_Lab_Test_Component>" S C=$$N(B),$P(LTS3,U,3)=$$CHAR(C) Q
. . . . . . I B["<Master_Lab_Test_Property>" S C=$$N(B),$P(LTS3,U,4)=$$CHAR(C),@HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",LTS,3)=LTS3 Q
. . . . . . I B["<Master_Lab_Test_Time_Aspect>" S LTS4=$$N(B) Q
. . . . . . I B["<Master_Lab_Test_Specimen>" S C=$$N(B),$P(LTS4,U,2)=$$CHAR(C) Q
. . . . . . I B["<Master_Lab_Test_Scale>" S C=$$N(B),$P(LTS4,U,3)=$$CHAR(C) Q
. . . . . . I B["<Master_Lab_Test_Method>" S C=$$N(B),$P(LTS4,U,4)=$$CHAR(C),@HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",LTS,4)=LTS4 Q
;
L1E ; end of flip from XML
;
D INIT^HDISDSR1
;HDISV HPM
;^TMP($J,"HDIDATA"),^TMP($J,"LR60")
S A="Report Generated.......: "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_HDISTN
S LT=LT+$L(A),@HDISV@(1)=A
S A="Report requested.......: "_HDISUB
S LT=LT+$L(A),@HDISV@(2)=A
S A="Extract version........: 1.0"
S LT=LT+$L(A),@HDISV@(3)=A
S A="Orderable Items File Count: "_$J($P(RCOUNT,U,2),6)
S LT=LT+$L(A),@HDISV@(4)=A
S A="Number of Orderable Items File That Are Inactive: "_$J($P(RCOUNT,U,3),6)
S LT=LT+$L(A),@HDISV@(5)=A
;S A="Number of Orderable Items Mnemonics: "_$J($P(RCOUNT,U,4),6)
;S LT=LT+$L(A),@HDISV@(6)=A
S A="Number of Primary Lab Tests Count: "_$J($P(RCOUNT,U,5),6)
S LT=LT+$L(A),@HDISV@(6)=A
S A="Number of Primary Tests that are Panels: "_$J($P(RCOUNT,U,6),6)
S LT=LT+$L(A),@HDISV@(7)=A
S A="Number of Laboratory Tests: "_$J($P(RCOUNT,U,7),6)
S LT=LT+$L(A),@HDISV@(8)=A
S A="Number of Unique Laboratory Tests: "_$J($P(RCOUNT,U,13),6)
S LT=LT+$L(A),@HDISV@(9)=A
S A="Number of Inactive Laboratory Tests: "_$J($P(RCOUNT,U,8),6)
S LT=LT+$L(A),@HDISV@(10)=A
S A="Number of Specimens: "_$J($P(RCOUNT,U,9),6)
S LT=LT+$L(A),@HDISV@(11)=A
S A="Number of Inactive Specimens: "_$J($P(RCOUNT,U,10),6)
S LT=LT+$L(A),@HDISV@(12)=A
S A="Number of Master Laboratory Tests: "_$J($P(RCOUNT,U,11),6)
S LT=LT+$L(A),@HDISV@(13)=A
S A="Number of Unique Master Laboratory Tests: "_$J($P(RCOUNT,U,14),6)
S LT=LT+$L(A),@HDISV@(14)=A
S A="Number of Inactive Master Laboratory Tests: "_$J($P(RCOUNT,U,12),6)
S LT=LT+$L(A),@HDISV@(15)=A
S HDFILEN1=$TR(HDISTN," ","_")_"-"_HDISUB_"-"_$P($$FMTHL7^XLFDT($$NOW^XLFDT),"-")
S HDIFER=$TR(HDISTN," ","_")_"-"_HDISUB_"-ERRORS-"_$P($$FMTHL7^XLFDT($$NOW^XLFDT),"-")_".TXT"
S HDIFILN=1
S HDFILENM=HDFILEN1_"_"_HDIFILN_".TXT"
S A="Attached HDI SDO file.....: "_HDFILENM
S LT=LT+$L(A)
S @HDISV@(16)=$$REPEAT^XLFSTR("-",75),LT=LT+75
S HDINODE=$O(@HDISV@(""),-1),HDINODE=HDINODE+1
S @HDISV@(HDINODE)=" ",HDINODE=HDINODE+1
S @HDISV@(HDINODE)=A_$J(" ",6),HDINODE=HDINODE+1
I RERROR D
. S @HDISV@(HDINODE)="Attached HDI SDO "_HDISUB_" Errors...: "_HDIFER
. S HDINODE=HDINODE+1
S @HDISV@(HDINODE)=" ",HDINODE=HDINODE+1
I RERROR D DISER^HDISDSR1
S HDINODE=$O(@HDISV@(""),-1),HDINODE=HDINODE+1
S @HDISV@(HDINODE)=" ",HDINODE=HDINODE+1
S @HDISV@(HDINODE)=$$UUBEGFN^HDISDSR1(HDFILENM)
;
D EHEAD
;
G EXPORT
Q
;
DONE ; final quit point
S HDISUBJ=HDIST_" "_HDISTN_" COMPLETED LAB ORDERABLE ITEMS SDO CODES "_$$HTE^XLFDT($H,"1M")
D MAILSEND^HDISDSR1(HDISUBJ)
D CLEAN^HDISDSR1
K @HDIV,@RET1,RET1
K LPI,LPIEN,LPNM,LPO1,LPPN,LTI1,LTIDA,LTIDAP,LTIDT,LTIEN,LTINM,TAB,LTI,LTS,HDIORD
K LTIST,LTITYP,LTMANM,LTMCOM,LTMDT,LTMIEN,LTMLON,LTMMET,LTMNM,LTMPRO,LTMSCA,LTMSPC
K LTMST,LTMTIM,LTS1,LTS2,LTS3,LTS4,LTSDT,LTSIEN,LTSNM,LTSST,LTSUN,M,HDIV,HD,HD1,HD2
K O10143,OIDT,OIEN,OIMEN,OINM,OIST,OISYN,OK,OK1,QUIT,R,D,HDIA,HDIFAC,HDIOI,HDIORD
K HDFILEN1,HDFILENM,HDIFER,HDIFILN,LT,HDISUBJ,RCOUNT
Q
;
EXPORT ; output as export file
; basic repeats
S HDIFAC=$G(@HDIV@("F",1)),HDIA=$G(@HDIV@("T"))
; walk collection
S O10143=0,(OIEN,OINM,OIMEN,OIDT,OIST)=""
E1 D GETORD I 'O10143 G EOUT
S LPI=0,(LPIEN,LPNM,LPPN)=""
E2 D GETLPI I 'LPI G E1
S LTI=0,(LTIEN,LTINM,LTITYP,LTIDA,LTIDAP,LTIDT,LTIST)=""
E3 D GETLTI I 'LTI G E2
S LTS=0,(LTSIEN,LTSNM,LTSUN,LTSDT,LTSST,LTMIEN,LTMNM,LTMANM,LTMST,LTMLON,LTMCOM,LTMPRO,LTMTIM,LTMSPC,LTMSCA,LTMMET)=""
E4 D GETLTS I 'LTS G E3
; output data
S HDISTR=HDISTR_$P(HDIFAC,U,1)_TAB_$P(HDIFAC,U,2)_TAB_$P(HDIFAC,U,3)_TAB_HDIA_TAB_$P(HDIFAC,U,4)_TAB
D SETDATA
S HDISTR=HDISTR_OIEN_TAB_OINM_TAB_($S(($E(OIMEN)="Y"):"Yes",1:""))_TAB_OIDT_TAB_($S(OIST=1:"Inactive",1:"Active"))_TAB
D SETDATA
; get synonyms
S A=0 F I=1:1 S A=$O(OISYN(A)) Q:'A S B=$G(OISYN(A)) S HDISTR=HDISTR_B S:(A'=OISYN(0)) HDISTR=HDISTR_", " I $L(HDISTR)>100 D SETDATA
I $L(HDISTR)>55 D SETDATA
S A="" I LTIEN&(LTINM'="") S A=$S(LTIST=1:"Inactive",1:"Active")
S HDISTR=HDISTR_TAB_LPIEN_TAB_LPNM_TAB_LPPN_TAB_LTIEN_TAB_LTINM_TAB_LTITYP_TAB_LTIDA_TAB_LTIDAP_TAB_LTIDT_TAB_A_TAB
D SETDATA
S A="" I LTSIEN&(LTSNM'="") S A=$S(LTSST=1:"Inactive",1:"Active")
S HDISTR=HDISTR_LTSIEN_TAB_LTSNM_TAB_LTSUN_TAB_LTSDT_TAB_A_TAB_LTMIEN_TAB_LTMNM_TAB_LTMANM_TAB_LTMDT_TAB
D SETDATA
S A="" I LTMIEN&(LTMNM'="") S A=$S(LTMST=1:"Inactive",1:"Active")
S HDISTR=HDISTR_A_TAB_LTMLON_TAB_LTMCOM_TAB_LTMPRO_TAB_LTMTIM_TAB_LTMSPC_TAB_LTMSCA_TAB_LTMMET
S HDISTR=HDISTR_HDICRLF
D SETDATA
I LT>HDIMAX D PSEND
G E4
;
EOUT ;
S HDINODE=$O(@HDISV@(""),-1)
I HDISTR'="" S HDINODE=HDINODE+1,@HDISV@(HDINODE)=$$UUEN^HDISDSR1(HDISTR)
S @HDISV@(HDINODE+1)=" "
S @HDISV@(HDINODE+2)="end"
G DONE
;
;
EHEAD ; export header
S HDISTR="Facility_Name-Number"_TAB_"Production_Account"_TAB_"Net_Name"_TAB_"Area"_TAB_"Type_of_Lookup"_TAB_"Orderable_Item_IEN"_TAB
D SETDATA
S HDISTR=HDISTR_"Orderable_Item_Name"_TAB_"Orderable_Item_Mnemonic"_TAB_"Orderable_Item_Inactive_Date"_TAB_"Orderable_Item_Status"_TAB
D SETDATA
S HDISTR=HDISTR_"Orderable_Item_Synonyms"_TAB_"Lab_Primary_Test_IEN"_TAB_"Lab_Primary_Test_Name"_TAB_"Lab_Primary_Test_Panel"_TAB
D SETDATA
S HDISTR=HDISTR_"Lab_Test_IEN"_TAB_"Lab_Test_Name"_TAB_"Lab_Test_Type"_TAB_"Lab_Test_Data_Location"_TAB_"Lab_Test_Data_Loc_Physical"_TAB
D SETDATA
S HDISTR=HDISTR_"Lab_Test_Inactive_Date"_TAB_"Lab_Test_Status"_TAB_"Lab_Test_Specimen_IEN"_TAB_"Lab_Test_Specimen_Name"_TAB
D SETDATA
S HDISTR=HDISTR_"Lab_Test_Specimen_Units"_TAB_"Lab_Test_Specimen_Inactive_Date"_TAB_"Lab_Test_Specimen_Status"_TAB
D SETDATA
S HDISTR=HDISTR_"Master_Lab_Test_IEN"_TAB_"Master_Lab_Test_Name"_TAB_"Master_Lab_Test_Alternate_Name"_TAB_"Master_Lab_Test_Inactive_Date"_TAB
D SETDATA
S HDISTR=HDISTR_"Master_Lab_Test_Status"_TAB_"Master_Lab_Test_LOINC_Code"_TAB_"Master_Lab_Test_Component"_TAB
D SETDATA
S HDISTR=HDISTR_"Master_Lab_Test_Property"_TAB_"Master_Lab_Test_Time_Aspect"_TAB_"Master_Lab_Test_Specimen"_TAB
D SETDATA
S HDISTR=HDISTR_"Master_Lab_Test_Scale"_TAB_"Master_Lab_Test_Method"_HDICRLF
D SETDATA
Q
;
GETORD S O10143=$O(@HDIV@(O10143)) I 'O10143 Q
S B=$G(@HDIV@(O10143,1)),OIEN=$P(B,U,1),OINM=$P(B,U,2),OIMEN=$P(B,U,3),OIDT=$P(B,U,4),OIST=$P(B,U,5)
K OISYN M OISYN=@HDIV@(O10143,"S")
Q
;
GETLPI ; get primary lab item
S LPI=$O(@HDIV@(O10143,"LPI",LPI)) I 'LPI Q
S B=$G(@HDIV@(O10143,"LPI",LPI,1)),LPIEN=$P(B,U,1),LPNM=$P(B,U,2),LPPN=$P(B,U,3)
Q
;
GETLTI ; get lab test item
S LTI=$O(@HDIV@(O10143,"LPI",LPI,"LTI",LTI)) I 'LTI Q
S B=$G(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,1)),LTIEN=$P(B,U,1),LTINM=$P(B,U,2),LTITYP=$P(B,U,3)
S LTIDA=$P(B,U,4),LTIDAP=$P(B,U,5),LTIDT=$P(B,U,6),LTIST=$P(B,U,7)
Q
;
GETLTS ; get lab specimen and mltf item
S LTS=$O(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,"LTS",LTS)) I 'LTS Q
S B=$G(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,"LTS",LTS,1)),LTSIEN=$P(B,U,1),LTSNM=$P(B,U,2),LTSUN=$P(B,U,3)
S LTSDT=$P(B,U,4),LTSST=$P(B,U,5)
S B=$G(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,"LTS",LTS,2)),LTMIEN=$P(B,U,1),LTMNM=$P(B,U,2),LTMANM=$P(B,U,3)
S LTMDT=$P(B,U,4)
S B=$G(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,"LTS",LTS,3)),LTMST=$P(B,U,1),LTMLON=$P(B,U,2),LTMCOM=$P(B,U,3),LTMPRO=$P(B,U,4)
S B=$G(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,"LTS",LTS,4)),LTMTIM=$P(B,U,1),LTMSPC=$P(B,U,2),LTMSCA=$P(B,U,3),LTMMET=$P(B,U,4)
Q
;
CHAR(A) ; check for ctrl chars, <, >, &
N B,C,D,I,L,M,N
I A="" Q A
S D=A
I A["'AND'" D ;<
. S B=$F(A,"'AND'")
. S A=$E(A,1,(B-6))_"&"_$E(A,B,$L(A))
I A["'LESS THAN'" D ;<
. S B=$F(A,"'LESS THAN'")
. S A=$E(A,1,(B-12))_"<"_$E(A,B,$L(A))
I A["'GREATER THAN'" D ;<
. S B=$F(A,"'GREATER THAN'")
. S A=$E(A,1,(B-15))_">"_$E(A,B,$L(A))
I A["'FORWARD SLASH'" D ;<
. S B=$F(A,"'FORWARD SLASH'")
. S A=$E(A,1,(B-16))_"/"_$E(A,B,$L(A))
Q A
;
N(K) ;get value
N F
S F=$P($P(K,"<",2),">",2)
Q F
;
SETDATA ; Set data into report structure
S HDINODE=$O(@HDISV@(""),-1)
D ENCODE^HDISDSR1(.HDISTR)
Q
;
PSEND ; SEND IF FILE TO BIG
S HDINODE=$O(@HDISV@(""),-1)
I HDISTR'="" S HDINODE=HDINODE+1,@HDISV@(HDINODE)=$$UUEN^HDISDSR1(HDISTR)
S @HDISV@(HDINODE+1)=" "
S @HDISV@(HDINODE+2)="end"
S HDISTR=""
;
S HDISUBJ=HDIST_" "_HDISTN_$S(HDIFILN>1:" CONTINUATION OF",1:"")_" LAB ORDERABLE ITEMS SDO CODES "_$$HTE^XLFDT($H,"1M")
D MAILSEND^HDISDSR1(HDISUBJ)
;
S HDIFILN=HDIFILN+1,LT=0
K @HDISV
S A="This is a continuation of: "_HDFILENM_$J(" ",6),LT=$L(A)
S @HDISV@(1)=A
S A=" ",LT=LT+1,@HDISV@(2)=A
S A=" This file does not contain a header, only data"_$J(" ",6),LT=LT+$L(A)
S @HDISV@(3)=A
S A=" This file should be combined with the previous file(s)"_$J(" ",6),LT=LT+$L(A)
S @HDISV@(4)=A
S @HDISV@(5)=" "
S HDFILENM=HDFILEN1_"_"_HDIFILN_".TXT"
S @HDISV@(6)="Attached HDI SDO file.....: "_HDFILENM
S @HDISV@(7)=$$REPEAT^XLFSTR("-",75),LT=LT+75
S HDINODE=$O(@HDISV@(""),-1),HDINODE=HDINODE+1
S @HDISV@(HDINODE)=" ",HDINODE=HDINODE+1
S @HDISV@(HDINODE)=$$UUBEGFN^HDISDSR1(HDFILENM)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISDSRL 15741 printed Jan 18, 2025@02:57:47 Page 2
HDISDSRL ;BPFO/DTG - HDI MAILMAN SERVER COLLECT ITEMS FOR LABORATORY; Apr 07, 2018@12:42
+1 ;;1.0;HEALTH DATA & INFORMATICS;**22**;Feb 22, 2005;Build 26
+2 ;
+3 ;
+4 ; ICR's:
+5 ; 6894 - HDI COLLECT SDOS
+6 ;
EN ; Display found orderable items for Lab
+1 ;
+2 ;
+3 ;
+4 ; put XML into tmp file
+5 ;^TMP("HDISDOLL",$J,"T")= Orderable Item Type (P, L, or R)
+6 ;^TMP("HDISDOLL",$J,"F",1)=FACILITY NAME-NUMBER^Production Y/N^NET NAME^type of lookup (single, Partial Match, ALL)^Partial Name
+7 ;^TMP("HDISDOLL",$J,0)= O# of orderable items
+8 ;^TMP("HDISDOLL",$J,O#,1)=orderable item IEN^orderable item name^mnemonic^status^inactive date
+9 ;^TMP("HDISDOLL",$J,O#,"S",0)= S# of synonyms
+10 ;^TMP("HDISDOLL",$J,O#,"S",S#)= synonym
+11 ;^TMP("HDISDOLL",$J,O#,"LPI",0)= LPI# of primary test items (#60) tests associated to 101.43 item
+12 ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,1)=IEN^name^Panel
+13 ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",0)= LTI# of lab test items (#60)
+14 ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,1)=IEN^name^type^data location^data physical location^status^inactive dt
+15 ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",0)= LTS# of specimens for LTI (60.01)
+16 ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",LTS,1)=IEN^name^units^inactive dt^status
+17 ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",LTS,2)=MLTF IEN^mltf name^mltf alt name^mltf inactive dt
+18 ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",LTS,3)=mltf status^mltf LOINC Code^mltf componet^mltf property
+19 ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",LTS,4)=mltf time aspect^mltf specimen^mltf scale^mltf method
+20 ;
+21 ;
EN1 ;
+1 NEW LPI,LPIEN,LPNM,LPO1,LPPN,LTI1,LTIDA,LTIDAP,LTIDT,LTIEN,LTINM,TAB,LTI,LTS,HDIORD
+2 NEW LTIST,LTITYP,LTMANM,LTMCOM,LTMDT,LTMIEN,LTMLON,LTMMET,LTMNM,LTMPRO,LTMSCA,LTMSPC
+3 NEW LTMST,LTMTIM,LTS1,LTS2,LTS3,LTS4,LTSDT,LTSIEN,LTSNM,LTSST,LTSUN,M,HDIV,HD,HD1,HD2
+4 NEW O10143,OIDT,OIEN,OIMEN,OINM,OIST,OISYN,OK,OK1,QUIT,R,D,HDIA,HDIFAC,HDIOI,HDIORD
+5 NEW RET1,RERROR,RERRARY
+6 NEW HDFILEN1,HDFILENM,HDIFER,HDIFILN,LT,HDISUBJ,RCOUNT
+7 SET HDIV="^TMP(""HDISDOLP"",$J)"
SET RET1="^TMP(""HDISDSRP"",$J)"
SET RCOUNT=""
SET RERROR=""
SET RERRARY=""
KILL @HDIV,@RET1
+8 SET RERROR=$$EN^HDISDOC("L","ALL","ALL",.RET1,"RERRARY","RCOUNT")
+9 SET A=1
SET TAB=$CHAR(9)
SET QUIT=""
SET LT=0
+10 ;
L1 SET A=$ORDER(@RET1@(A))
IF 'A
GOTO L1E
+1 SET B=$GET(@RET1@(A))
IF B["</Laboratory_Orderable_Items>"
GOTO L1E
+2 IF A=2&(B["<Laboratory_Orderable_Items")
SET @HDIV@("T")="LABORATORY"
GOTO L1
+3 IF B="<Facility>"
SET M=""
GOTO L1
+4 IF B["<Facility_Name-Number>"
SET $PIECE(M,U,1)=$$N(B)
GOTO L1
+5 IF B["<Facility_Production_Account>"
SET $PIECE(M,U,2)=$$N(B)
GOTO L1
+6 IF B["<Facility_Net_Name>"
SET $PIECE(M,U,3)=$$N(B)
GOTO L1
+7 IF B["<Look_up_Type>"
SET $PIECE(M,U,4)=$$N(B)
GOTO L1
+8 IF B["</Facility>"
SET @HDIV@("F",1)=M
GOTO L1
+9 IF B="<Orderable_Item>"
Begin DoDot:1
+10 SET C=$GET(@HDIV@(0))
SET C=C+1
SET @HDIV@(0)=C
SET HDIORD=C
SET HDIOI=""
SET OK=0
SET OK1=0
+11 ;<
FOR
SET A=$ORDER(@RET1@(A))
SET B=$GET(@RET1@(A))
if B["</Orderable_Item>"
QUIT
Begin DoDot:2
+12 IF B["<Orderable_Item_Number>"
SET $PIECE(HDIOI,U,1)=$$N(B)
QUIT
+13 IF B["<Orderable_Item_Name>"
SET C=$$N(B)
SET $PIECE(HDIOI,U,2)=$$CHAR(C)
QUIT
+14 IF B["<Orderable_Item_Mnemonic>"
SET C=$$N(B)
SET $PIECE(HDIOI,U,3)=$$CHAR(C)
QUIT
+15 IF B["<Orderable_Item_Inactive_Date>"
SET $PIECE(HDIOI,U,4)=$$N(B)
QUIT
+16 IF B["<Orderable_Item_Status>"
SET $PIECE(HDIOI,U,5)=$$N(B)
SET @HDIV@(HDIORD,1)=HDIOI
QUIT
+17 IF B["<Orderable_Item_Synonym>"
FOR
SET A=$ORDER(@RET1@(A))
SET B=$GET(@RET1@(A))
Begin DoDot:3
+18 IF B["<Orderable_Item_Synonym_Name>"
Begin DoDot:4
+19 SET D=$GET(@HDIV@(HDIORD,"S",0))
SET D=D+1
SET @HDIV@(HDIORD,"S",0)=D
SET C=$$N(B)
SET @HDIV@(HDIORD,"S",D)=$$CHAR(C)
QUIT
End DoDot:4
QUIT
+20 IF B["</Orderable_Item_Synonym>"
QUIT
+21 IF B["<Lab_Primary_Order_Item>"
SET A=A-1
SET OK1=1
QUIT
End DoDot:3
IF OK1=1
QUIT
+22 IF B="<Lab_Primary_Order_Item>"
Begin DoDot:3
+23 SET C=$GET(@HDIV@(HDIORD,"LPI",0))
SET C=C+1
SET @HDIV@(HDIORD,"LPI",0)=C
SET LPI=C
SET (LPO1,OK,OK1)=""
+24 ;<
FOR
SET A=$ORDER(@RET1@(A))
SET B=$GET(@RET1@(A))
if B["</Lab_Primary_Order_Item>"
QUIT
Begin DoDot:4
+25 IF B["<Lab_Primary_Test_IEN>"
SET LPO1=$$N(B)
QUIT
+26 IF B["<Lab_Primary_Test_Name>"
SET R=$$N(B)
SET $PIECE(LPO1,U,2)=$$CHAR(R)
QUIT
+27 IF B["Lab_Primary_Test_Panel>"
SET $PIECE(LPO1,U,3)=$$N(B)
SET @HDIV@(HDIORD,"LPI",LPI,1)=LPO1
QUIT
+28 ;<
IF B="<Laboratory_Test_Item>"
SET C=$GET(@HDIV@(HDIORD,"LPI",LPI,"LTI",0))
SET C=C+1
SET @HDIV@(HDIORD,"LPI",LPI,"LTI",0)=C
SET LTI=C
SET LTI1=""
FOR
SET A=$ORDER(@RET1@(A))
SET B=$GET(@RET1@(A))
if B["</Laboratory_Test_Item>"
QUIT
Begin DoDot:5
+29 ;S C=$G(@HDIV@(HDIORD,"LPI",LPI,"LTI",0)),C=C+1,@HDIV@(HDIORD,"LPI",LPI,"LTI",0)=C,LTI=C,LTI1=""
+30 IF B["<Lab_Test_IEN>"
SET LTI1=$$N(B)
QUIT
+31 IF B["<Lab_Test_Name>"
SET C=$$N(B)
SET $PIECE(LTI1,U,2)=$$CHAR(C)
QUIT
+32 IF B["<Lab_Test_Type>"
SET $PIECE(LTI1,U,3)=$$N(B)
QUIT
+33 IF B["<Lab_Test_Data_Location>"
SET $PIECE(LTI1,U,4)=$$N(B)
QUIT
+34 IF B["<Lab_Test_Data_Loc_Physical>"
SET $PIECE(LTI1,U,5)=$$N(B)
QUIT
+35 IF B["<Lab_Test_Inactive_Date>"
SET $PIECE(LTI1,U,6)=$$N(B)
QUIT
+36 IF B["<Lab_Test_Status>"
SET $PIECE(LTI1,U,7)=$$N(B)
SET @HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,1)=LTI1
QUIT
+37 ;<
IF B="<Lab_Test_Specimen>"
SET C=$GET(@HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",0))
SET C=C+1
SET @HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",0)=C
SET LTS=C
SET (LTS1,LTS2,LTS3,LTS4)=""
FOR
SET A=$ORDER(@RET1@(A))
SET B=$GET(@RET1@(A))
if B["</Lab_Test_Specimen>"
QUIT
Begin DoDot:6
+38 IF B["<Lab_Test_Specimen_IEN>"
SET LTS1=$$N(B)
QUIT
+39 IF B["<Lab_Test_Specimen_Name>"
SET C=$$N(B)
SET $PIECE(LTS1,U,2)=$$CHAR(C)
QUIT
+40 IF B["<Lab_Test_Specimen_Units>"
SET C=$$N(B)
SET $PIECE(LTS1,U,3)=$$CHAR(C)
QUIT
+41 IF B["<Lab_Test_Specimen_Inactive_Date>"
SET $PIECE(LTS1,U,4)=$$N(B)
+42 IF B["<Lab_Test_Specimen_Status>"
SET $PIECE(LTS1,U,5)=$$N(B)
SET @HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",LTS,1)=LTS1
QUIT
+43 IF B="<Master_Lab_Test_Item>"
QUIT
+44 IF B="</Master_Lab_Test_Item>"
QUIT
+45 IF B["<Master_Lab_Test_IEN>"
SET LTS2=$$N(B)
QUIT
+46 IF B["<Master_Lab_Test_Name>"
SET C=$$N(B)
SET $PIECE(LTS2,U,2)=$$CHAR(C)
QUIT
+47 IF B["<Master_Lab_Test_Alternate_Name>"
SET C=$$N(B)
SET $PIECE(LTS2,U,3)=$$CHAR(C)
QUIT
+48 IF B["<Master_Lab_Test_Inactive_Date>"
SET $PIECE(LTS2,U,4)=$$N(B)
SET @HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",LTS,2)=LTS2
QUIT
+49 IF B["<Master_Lab_Test_Status>"
SET LTS3=$$N(B)
QUIT
+50 IF B["<Master_Lab_Test_LOINC_Code>"
SET $PIECE(LTS3,U,2)=$$N(B)
QUIT
+51 IF B["<Master_Lab_Test_Component>"
SET C=$$N(B)
SET $PIECE(LTS3,U,3)=$$CHAR(C)
QUIT
+52 IF B["<Master_Lab_Test_Property>"
SET C=$$N(B)
SET $PIECE(LTS3,U,4)=$$CHAR(C)
SET @HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",LTS,3)=LTS3
QUIT
+53 IF B["<Master_Lab_Test_Time_Aspect>"
SET LTS4=$$N(B)
QUIT
+54 IF B["<Master_Lab_Test_Specimen>"
SET C=$$N(B)
SET $PIECE(LTS4,U,2)=$$CHAR(C)
QUIT
+55 IF B["<Master_Lab_Test_Scale>"
SET C=$$N(B)
SET $PIECE(LTS4,U,3)=$$CHAR(C)
QUIT
+56 IF B["<Master_Lab_Test_Method>"
SET C=$$N(B)
SET $PIECE(LTS4,U,4)=$$CHAR(C)
SET @HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",LTS,4)=LTS4
QUIT
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
GOTO L1
+57 ;
L1E ; end of flip from XML
+1 ;
+2 DO INIT^HDISDSR1
+3 ;HDISV HPM
+4 ;^TMP($J,"HDIDATA"),^TMP($J,"LR60")
+5 SET A="Report Generated.......: "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_HDISTN
+6 SET LT=LT+$LENGTH(A)
SET @HDISV@(1)=A
+7 SET A="Report requested.......: "_HDISUB
+8 SET LT=LT+$LENGTH(A)
SET @HDISV@(2)=A
+9 SET A="Extract version........: 1.0"
+10 SET LT=LT+$LENGTH(A)
SET @HDISV@(3)=A
+11 SET A="Orderable Items File Count: "_$JUSTIFY($PIECE(RCOUNT,U,2),6)
+12 SET LT=LT+$LENGTH(A)
SET @HDISV@(4)=A
+13 SET A="Number of Orderable Items File That Are Inactive: "_$JUSTIFY($PIECE(RCOUNT,U,3),6)
+14 SET LT=LT+$LENGTH(A)
SET @HDISV@(5)=A
+15 ;S A="Number of Orderable Items Mnemonics: "_$J($P(RCOUNT,U,4),6)
+16 ;S LT=LT+$L(A),@HDISV@(6)=A
+17 SET A="Number of Primary Lab Tests Count: "_$JUSTIFY($PIECE(RCOUNT,U,5),6)
+18 SET LT=LT+$LENGTH(A)
SET @HDISV@(6)=A
+19 SET A="Number of Primary Tests that are Panels: "_$JUSTIFY($PIECE(RCOUNT,U,6),6)
+20 SET LT=LT+$LENGTH(A)
SET @HDISV@(7)=A
+21 SET A="Number of Laboratory Tests: "_$JUSTIFY($PIECE(RCOUNT,U,7),6)
+22 SET LT=LT+$LENGTH(A)
SET @HDISV@(8)=A
+23 SET A="Number of Unique Laboratory Tests: "_$JUSTIFY($PIECE(RCOUNT,U,13),6)
+24 SET LT=LT+$LENGTH(A)
SET @HDISV@(9)=A
+25 SET A="Number of Inactive Laboratory Tests: "_$JUSTIFY($PIECE(RCOUNT,U,8),6)
+26 SET LT=LT+$LENGTH(A)
SET @HDISV@(10)=A
+27 SET A="Number of Specimens: "_$JUSTIFY($PIECE(RCOUNT,U,9),6)
+28 SET LT=LT+$LENGTH(A)
SET @HDISV@(11)=A
+29 SET A="Number of Inactive Specimens: "_$JUSTIFY($PIECE(RCOUNT,U,10),6)
+30 SET LT=LT+$LENGTH(A)
SET @HDISV@(12)=A
+31 SET A="Number of Master Laboratory Tests: "_$JUSTIFY($PIECE(RCOUNT,U,11),6)
+32 SET LT=LT+$LENGTH(A)
SET @HDISV@(13)=A
+33 SET A="Number of Unique Master Laboratory Tests: "_$JUSTIFY($PIECE(RCOUNT,U,14),6)
+34 SET LT=LT+$LENGTH(A)
SET @HDISV@(14)=A
+35 SET A="Number of Inactive Master Laboratory Tests: "_$JUSTIFY($PIECE(RCOUNT,U,12),6)
+36 SET LT=LT+$LENGTH(A)
SET @HDISV@(15)=A
+37 SET HDFILEN1=$TRANSLATE(HDISTN," ","_")_"-"_HDISUB_"-"_$PIECE($$FMTHL7^XLFDT($$NOW^XLFDT),"-")
+38 SET HDIFER=$TRANSLATE(HDISTN," ","_")_"-"_HDISUB_"-ERRORS-"_$PIECE($$FMTHL7^XLFDT($$NOW^XLFDT),"-")_".TXT"
+39 SET HDIFILN=1
+40 SET HDFILENM=HDFILEN1_"_"_HDIFILN_".TXT"
+41 SET A="Attached HDI SDO file.....: "_HDFILENM
+42 SET LT=LT+$LENGTH(A)
+43 SET @HDISV@(16)=$$REPEAT^XLFSTR("-",75)
SET LT=LT+75
+44 SET HDINODE=$ORDER(@HDISV@(""),-1)
SET HDINODE=HDINODE+1
+45 SET @HDISV@(HDINODE)=" "
SET HDINODE=HDINODE+1
+46 SET @HDISV@(HDINODE)=A_$JUSTIFY(" ",6)
SET HDINODE=HDINODE+1
+47 IF RERROR
Begin DoDot:1
+48 SET @HDISV@(HDINODE)="Attached HDI SDO "_HDISUB_" Errors...: "_HDIFER
+49 SET HDINODE=HDINODE+1
End DoDot:1
+50 SET @HDISV@(HDINODE)=" "
SET HDINODE=HDINODE+1
+51 IF RERROR
DO DISER^HDISDSR1
+52 SET HDINODE=$ORDER(@HDISV@(""),-1)
SET HDINODE=HDINODE+1
+53 SET @HDISV@(HDINODE)=" "
SET HDINODE=HDINODE+1
+54 SET @HDISV@(HDINODE)=$$UUBEGFN^HDISDSR1(HDFILENM)
+55 ;
+56 DO EHEAD
+57 ;
+58 GOTO EXPORT
+59 QUIT
+60 ;
DONE ; final quit point
+1 SET HDISUBJ=HDIST_" "_HDISTN_" COMPLETED LAB ORDERABLE ITEMS SDO CODES "_$$HTE^XLFDT($HOROLOG,"1M")
+2 DO MAILSEND^HDISDSR1(HDISUBJ)
+3 DO CLEAN^HDISDSR1
+4 KILL @HDIV,@RET1,RET1
+5 KILL LPI,LPIEN,LPNM,LPO1,LPPN,LTI1,LTIDA,LTIDAP,LTIDT,LTIEN,LTINM,TAB,LTI,LTS,HDIORD
+6 KILL LTIST,LTITYP,LTMANM,LTMCOM,LTMDT,LTMIEN,LTMLON,LTMMET,LTMNM,LTMPRO,LTMSCA,LTMSPC
+7 KILL LTMST,LTMTIM,LTS1,LTS2,LTS3,LTS4,LTSDT,LTSIEN,LTSNM,LTSST,LTSUN,M,HDIV,HD,HD1,HD2
+8 KILL O10143,OIDT,OIEN,OIMEN,OINM,OIST,OISYN,OK,OK1,QUIT,R,D,HDIA,HDIFAC,HDIOI,HDIORD
+9 KILL HDFILEN1,HDFILENM,HDIFER,HDIFILN,LT,HDISUBJ,RCOUNT
+10 QUIT
+11 ;
EXPORT ; output as export file
+1 ; basic repeats
+2 SET HDIFAC=$GET(@HDIV@("F",1))
SET HDIA=$GET(@HDIV@("T"))
+3 ; walk collection
+4 SET O10143=0
SET (OIEN,OINM,OIMEN,OIDT,OIST)=""
E1 DO GETORD
IF 'O10143
GOTO EOUT
+1 SET LPI=0
SET (LPIEN,LPNM,LPPN)=""
E2 DO GETLPI
IF 'LPI
GOTO E1
+1 SET LTI=0
SET (LTIEN,LTINM,LTITYP,LTIDA,LTIDAP,LTIDT,LTIST)=""
E3 DO GETLTI
IF 'LTI
GOTO E2
+1 SET LTS=0
SET (LTSIEN,LTSNM,LTSUN,LTSDT,LTSST,LTMIEN,LTMNM,LTMANM,LTMST,LTMLON,LTMCOM,LTMPRO,LTMTIM,LTMSPC,LTMSCA,LTMMET)=""
E4 DO GETLTS
IF 'LTS
GOTO E3
+1 ; output data
+2 SET HDISTR=HDISTR_$PIECE(HDIFAC,U,1)_TAB_$PIECE(HDIFAC,U,2)_TAB_$PIECE(HDIFAC,U,3)_TAB_HDIA_TAB_$PIECE(HDIFAC,U,4)_TAB
+3 DO SETDATA
+4 SET HDISTR=HDISTR_OIEN_TAB_OINM_TAB_($SELECT(($EXTRACT(OIMEN)="Y"):"Yes",1:""))_TAB_OIDT_TAB_($SELECT(OIST=1:"Inactive",1:"Active"))_TAB
+5 DO SETDATA
+6 ; get synonyms
+7 SET A=0
FOR I=1:1
SET A=$ORDER(OISYN(A))
if 'A
QUIT
SET B=$GET(OISYN(A))
SET HDISTR=HDISTR_B
if (A'=OISYN(0))
SET HDISTR=HDISTR_", "
IF $LENGTH(HDISTR)>100
DO SETDATA
+8 IF $LENGTH(HDISTR)>55
DO SETDATA
+9 SET A=""
IF LTIEN&(LTINM'="")
SET A=$SELECT(LTIST=1:"Inactive",1:"Active")
+10 SET HDISTR=HDISTR_TAB_LPIEN_TAB_LPNM_TAB_LPPN_TAB_LTIEN_TAB_LTINM_TAB_LTITYP_TAB_LTIDA_TAB_LTIDAP_TAB_LTIDT_TAB_A_TAB
+11 DO SETDATA
+12 SET A=""
IF LTSIEN&(LTSNM'="")
SET A=$SELECT(LTSST=1:"Inactive",1:"Active")
+13 SET HDISTR=HDISTR_LTSIEN_TAB_LTSNM_TAB_LTSUN_TAB_LTSDT_TAB_A_TAB_LTMIEN_TAB_LTMNM_TAB_LTMANM_TAB_LTMDT_TAB
+14 DO SETDATA
+15 SET A=""
IF LTMIEN&(LTMNM'="")
SET A=$SELECT(LTMST=1:"Inactive",1:"Active")
+16 SET HDISTR=HDISTR_A_TAB_LTMLON_TAB_LTMCOM_TAB_LTMPRO_TAB_LTMTIM_TAB_LTMSPC_TAB_LTMSCA_TAB_LTMMET
+17 SET HDISTR=HDISTR_HDICRLF
+18 DO SETDATA
+19 IF LT>HDIMAX
DO PSEND
+20 GOTO E4
+21 ;
EOUT ;
+1 SET HDINODE=$ORDER(@HDISV@(""),-1)
+2 IF HDISTR'=""
SET HDINODE=HDINODE+1
SET @HDISV@(HDINODE)=$$UUEN^HDISDSR1(HDISTR)
+3 SET @HDISV@(HDINODE+1)=" "
+4 SET @HDISV@(HDINODE+2)="end"
+5 GOTO DONE
+6 ;
+7 ;
EHEAD ; export header
+1 SET HDISTR="Facility_Name-Number"_TAB_"Production_Account"_TAB_"Net_Name"_TAB_"Area"_TAB_"Type_of_Lookup"_TAB_"Orderable_Item_IEN"_TAB
+2 DO SETDATA
+3 SET HDISTR=HDISTR_"Orderable_Item_Name"_TAB_"Orderable_Item_Mnemonic"_TAB_"Orderable_Item_Inactive_Date"_TAB_"Orderable_Item_Status"_TAB
+4 DO SETDATA
+5 SET HDISTR=HDISTR_"Orderable_Item_Synonyms"_TAB_"Lab_Primary_Test_IEN"_TAB_"Lab_Primary_Test_Name"_TAB_"Lab_Primary_Test_Panel"_TAB
+6 DO SETDATA
+7 SET HDISTR=HDISTR_"Lab_Test_IEN"_TAB_"Lab_Test_Name"_TAB_"Lab_Test_Type"_TAB_"Lab_Test_Data_Location"_TAB_"Lab_Test_Data_Loc_Physical"_TAB
+8 DO SETDATA
+9 SET HDISTR=HDISTR_"Lab_Test_Inactive_Date"_TAB_"Lab_Test_Status"_TAB_"Lab_Test_Specimen_IEN"_TAB_"Lab_Test_Specimen_Name"_TAB
+10 DO SETDATA
+11 SET HDISTR=HDISTR_"Lab_Test_Specimen_Units"_TAB_"Lab_Test_Specimen_Inactive_Date"_TAB_"Lab_Test_Specimen_Status"_TAB
+12 DO SETDATA
+13 SET HDISTR=HDISTR_"Master_Lab_Test_IEN"_TAB_"Master_Lab_Test_Name"_TAB_"Master_Lab_Test_Alternate_Name"_TAB_"Master_Lab_Test_Inactive_Date"_TAB
+14 DO SETDATA
+15 SET HDISTR=HDISTR_"Master_Lab_Test_Status"_TAB_"Master_Lab_Test_LOINC_Code"_TAB_"Master_Lab_Test_Component"_TAB
+16 DO SETDATA
+17 SET HDISTR=HDISTR_"Master_Lab_Test_Property"_TAB_"Master_Lab_Test_Time_Aspect"_TAB_"Master_Lab_Test_Specimen"_TAB
+18 DO SETDATA
+19 SET HDISTR=HDISTR_"Master_Lab_Test_Scale"_TAB_"Master_Lab_Test_Method"_HDICRLF
+20 DO SETDATA
+21 QUIT
+22 ;
GETORD SET O10143=$ORDER(@HDIV@(O10143))
IF 'O10143
QUIT
+1 SET B=$GET(@HDIV@(O10143,1))
SET OIEN=$PIECE(B,U,1)
SET OINM=$PIECE(B,U,2)
SET OIMEN=$PIECE(B,U,3)
SET OIDT=$PIECE(B,U,4)
SET OIST=$PIECE(B,U,5)
+2 KILL OISYN
MERGE OISYN=@HDIV@(O10143,"S")
+3 QUIT
+4 ;
GETLPI ; get primary lab item
+1 SET LPI=$ORDER(@HDIV@(O10143,"LPI",LPI))
IF 'LPI
QUIT
+2 SET B=$GET(@HDIV@(O10143,"LPI",LPI,1))
SET LPIEN=$PIECE(B,U,1)
SET LPNM=$PIECE(B,U,2)
SET LPPN=$PIECE(B,U,3)
+3 QUIT
+4 ;
GETLTI ; get lab test item
+1 SET LTI=$ORDER(@HDIV@(O10143,"LPI",LPI,"LTI",LTI))
IF 'LTI
QUIT
+2 SET B=$GET(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,1))
SET LTIEN=$PIECE(B,U,1)
SET LTINM=$PIECE(B,U,2)
SET LTITYP=$PIECE(B,U,3)
+3 SET LTIDA=$PIECE(B,U,4)
SET LTIDAP=$PIECE(B,U,5)
SET LTIDT=$PIECE(B,U,6)
SET LTIST=$PIECE(B,U,7)
+4 QUIT
+5 ;
GETLTS ; get lab specimen and mltf item
+1 SET LTS=$ORDER(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,"LTS",LTS))
IF 'LTS
QUIT
+2 SET B=$GET(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,"LTS",LTS,1))
SET LTSIEN=$PIECE(B,U,1)
SET LTSNM=$PIECE(B,U,2)
SET LTSUN=$PIECE(B,U,3)
+3 SET LTSDT=$PIECE(B,U,4)
SET LTSST=$PIECE(B,U,5)
+4 SET B=$GET(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,"LTS",LTS,2))
SET LTMIEN=$PIECE(B,U,1)
SET LTMNM=$PIECE(B,U,2)
SET LTMANM=$PIECE(B,U,3)
+5 SET LTMDT=$PIECE(B,U,4)
+6 SET B=$GET(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,"LTS",LTS,3))
SET LTMST=$PIECE(B,U,1)
SET LTMLON=$PIECE(B,U,2)
SET LTMCOM=$PIECE(B,U,3)
SET LTMPRO=$PIECE(B,U,4)
+7 SET B=$GET(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,"LTS",LTS,4))
SET LTMTIM=$PIECE(B,U,1)
SET LTMSPC=$PIECE(B,U,2)
SET LTMSCA=$PIECE(B,U,3)
SET LTMMET=$PIECE(B,U,4)
+8 QUIT
+9 ;
CHAR(A) ; check for ctrl chars, <, >, &
+1 NEW B,C,D,I,L,M,N
+2 IF A=""
QUIT A
+3 SET D=A
+4 ;<
IF A["'AND'"
Begin DoDot:1
+5 SET B=$FIND(A,"'AND'")
+6 SET A=$EXTRACT(A,1,(B-6))_"&"_$EXTRACT(A,B,$LENGTH(A))
End DoDot:1
+7 ;<
IF A["'LESS THAN'"
Begin DoDot:1
+8 SET B=$FIND(A,"'LESS THAN'")
+9 SET A=$EXTRACT(A,1,(B-12))_"<"_$EXTRACT(A,B,$LENGTH(A))
End DoDot:1
+10 ;<
IF A["'GREATER THAN'"
Begin DoDot:1
+11 SET B=$FIND(A,"'GREATER THAN'")
+12 SET A=$EXTRACT(A,1,(B-15))_">"_$EXTRACT(A,B,$LENGTH(A))
End DoDot:1
+13 ;<
IF A["'FORWARD SLASH'"
Begin DoDot:1
+14 SET B=$FIND(A,"'FORWARD SLASH'")
+15 SET A=$EXTRACT(A,1,(B-16))_"/"_$EXTRACT(A,B,$LENGTH(A))
End DoDot:1
+16 QUIT A
+17 ;
N(K) ;get value
+1 NEW F
+2 SET F=$PIECE($PIECE(K,"<",2),">",2)
+3 QUIT F
+4 ;
SETDATA ; Set data into report structure
+1 SET HDINODE=$ORDER(@HDISV@(""),-1)
+2 DO ENCODE^HDISDSR1(.HDISTR)
+3 QUIT
+4 ;
PSEND ; SEND IF FILE TO BIG
+1 SET HDINODE=$ORDER(@HDISV@(""),-1)
+2 IF HDISTR'=""
SET HDINODE=HDINODE+1
SET @HDISV@(HDINODE)=$$UUEN^HDISDSR1(HDISTR)
+3 SET @HDISV@(HDINODE+1)=" "
+4 SET @HDISV@(HDINODE+2)="end"
+5 SET HDISTR=""
+6 ;
+7 SET HDISUBJ=HDIST_" "_HDISTN_$SELECT(HDIFILN>1:" CONTINUATION OF",1:"")_" LAB ORDERABLE ITEMS SDO CODES "_$$HTE^XLFDT($HOROLOG,"1M")
+8 DO MAILSEND^HDISDSR1(HDISUBJ)
+9 ;
+10 SET HDIFILN=HDIFILN+1
SET LT=0
+11 KILL @HDISV
+12 SET A="This is a continuation of: "_HDFILENM_$JUSTIFY(" ",6)
SET LT=$LENGTH(A)
+13 SET @HDISV@(1)=A
+14 SET A=" "
SET LT=LT+1
SET @HDISV@(2)=A
+15 SET A=" This file does not contain a header, only data"_$JUSTIFY(" ",6)
SET LT=LT+$LENGTH(A)
+16 SET @HDISV@(3)=A
+17 SET A=" This file should be combined with the previous file(s)"_$JUSTIFY(" ",6)
SET LT=LT+$LENGTH(A)
+18 SET @HDISV@(4)=A
+19 SET @HDISV@(5)=" "
+20 SET HDFILENM=HDFILEN1_"_"_HDIFILN_".TXT"
+21 SET @HDISV@(6)="Attached HDI SDO file.....: "_HDFILENM
+22 SET @HDISV@(7)=$$REPEAT^XLFSTR("-",75)
SET LT=LT+75
+23 SET HDINODE=$ORDER(@HDISV@(""),-1)
SET HDINODE=HDINODE+1
+24 SET @HDISV@(HDINODE)=" "
SET HDINODE=HDINODE+1
+25 SET @HDISV@(HDINODE)=$$UUBEGFN^HDISDSR1(HDFILENM)
+26 QUIT
+27 ;
