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

HDISDOLL.m

Go to the documentation of this file.
  1. HDISDOLL ;BPFO/DTG - DISPLAY LOOKUP ITEMS FOR LABORATORY; Apr 07, 2018@12:42
  1. ;;1.0;HEALTH DATA & INFORMATICS;**22**;Feb 22, 2005;Build 26
  1. ;
  1. ;
  1. EN ; Display found orderable items for Lab
  1. ;
  1. ;
  1. ;
  1. ; put XML into tmp file
  1. ;^TMP("HDISDOLL",$J,"T")= Orderable Item Type (P, L, or R)
  1. ;^TMP("HDISDOLL",$J,"F",1)=FACILITY NAME-NUMBER^Production Y/N^NET NAME^type of lookup (single, Partial Match, ALL)^Partial Name
  1. ;^TMP("HDISDOLL",$J,0)= O# of orderable items
  1. ;^TMP("HDISDOLL",$J,O#,1)=orderable item IEN^orderable item name^mnemonic^status^inactive date
  1. ;^TMP("HDISDOLL",$J,O#,"S",0)= S# of synonyms
  1. ;^TMP("HDISDOLL",$J,O#,"S",S#)= synonym
  1. ;^TMP("HDISDOLL",$J,O#,"LPI",0)= LPI# of primary test items (#60) tests associated to 101.43 item
  1. ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,1)=IEN^name^Panel^ if error
  1. ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",0)= LTI# of lab test items (#60)
  1. ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,1)=IEN^name^type^data location^data physical location^status^inactive dt
  1. ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",0)= LTS# of specimens for LTI (60.01)
  1. ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",LTS,1)=IEN^name^units^inactive dt^status
  1. ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",LTS,2)=MLTF IEN^mltf name^mltf alt name^mltf inactive dt
  1. ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",LTS,3)=mltf status^mltf LOINC Code^mltf componet^mltf property
  1. ;^TMP("HDISDOLL",$J,O#,"LPI",LPI#,"LTI",LTI,"LTS",LTS,4)=mltf time aspect^mltf specimen^mltf scale^mltf method
  1. ;
  1. ;
  1. EN1 ;
  1. N LPI,LPIEN,LPNM,LPO1,LPPN,LTI1,LTIDA,LTIDAP,LTIDT,LTIEN,LTINM,TAB,LTI,LTS,HDIORD
  1. N LTIST,LTITYP,LTMANM,LTMCOM,LTMDT,LTMIEN,LTMLON,LTMMET,LTMNM,LTMPRO,LTMSCA,LTMSPC
  1. N LTMST,LTMTIM,LTS1,LTS2,LTS3,LTS4,LTSDT,LTSIEN,LTSNM,LTSST,LTSUN,M,HDIV,HD,HD1,HD2
  1. N O10143,OIDT,OIEN,OIMEN,OINM,OIST,OISYN,OK,OK1,QUIT,R,D,HDIA,HDIFAC,HDIOI,HDIORD,LPPER
  1. S HDIV="^TMP(""HDISDOLP"",$J)" K @HDIV
  1. S A=1,TAB=$C(9),QUIT=""
  1. I HDITYPE="X" G XML
  1. L1 S A=$O(@RET1@(A)) I 'A G L1E
  1. S B=$G(@RET1@(A)) I B["</Laboratory_Orderable_Items>" G L1E
  1. I A=2&(B["<Laboratory_Orderable_Items") S @HDIV@("T")="LABORATORY" G L1
  1. I B="<Facility>" S M="" G L1
  1. I B["<Facility_Name-Number>" S $P(M,U,1)=$$N(B) G L1
  1. I B["<Facility_Production_Account>" S $P(M,U,2)=$$N(B) G L1
  1. I B["<Facility_Net_Name>" S $P(M,U,3)=$$N(B) G L1
  1. I B["<Look_up_Type>" S $P(M,U,4)=$$N(B) G L1
  1. I B["<Look_up_Partial_Name>" S $P(M,U,5)=$$N(B) G L1
  1. I B["</Facility>" S @HDIV@("F",1)=M G L1
  1. I B="<Orderable_Item>" D G L1
  1. . S C=$G(@HDIV@(0)),C=C+1,@HDIV@(0)=C,HDIORD=C,HDIOI="",OK=0,OK1=0
  1. . F S A=$O(@RET1@(A)),B=$G(@RET1@(A)) Q:B["</Orderable_Item>" D ;<
  1. . . I B["<Orderable_Item_Number>" S $P(HDIOI,U,1)=$$N(B) Q
  1. . . I B["<Orderable_Item_Name>" S C=$$N(B),$P(HDIOI,U,2)=$$CHAR(C) Q
  1. . . I B["<Orderable_Item_Mnemonic>" S C=$$N(B),$P(HDIOI,U,3)=$$CHAR(C) Q
  1. . . I B["<Orderable_Item_Inactive_Date>" S $P(HDIOI,U,4)=$$N(B) Q
  1. . . I B["<Orderable_Item_Status>" S $P(HDIOI,U,5)=$$N(B),@HDIV@(HDIORD,1)=HDIOI Q
  1. . . I B["<Orderable_Item_Synonym>" F S A=$O(@RET1@(A)),B=$G(@RET1@(A)) D I OK1=1 Q
  1. . . . I B["<Orderable_Item_Synonym_Name>" D Q
  1. . . . . 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
  1. . . . I B["</Orderable_Item_Synonym>" Q
  1. . . . I B["<Lab_Primary_Order_Item>" S A=A-1,OK1=1 Q
  1. . . I B="<Lab_Primary_Order_Item>" D Q
  1. . . . S C=$G(@HDIV@(HDIORD,"LPI",0)),C=C+1,@HDIV@(HDIORD,"LPI",0)=C,LPI=C,(LPO1,OK,OK1)=""
  1. . . . F S A=$O(@RET1@(A)),B=$G(@RET1@(A)) Q:B["</Lab_Primary_Order_Item>" D ;<
  1. . . . . I B["<Lab_Primary_Test_IEN>" S LPO1=$$N(B) Q
  1. . . . . I B["<Lab_Primary_Test_Name>" S R=$$N(B),$P(LPO1,U,2)=$$CHAR(R) Q
  1. . . . . I B["Lab_Primary_Test_Panel>" S $P(LPO1,U,3)=$$N(B),@HDIV@(HDIORD,"LPI",LPI,1)=LPO1 Q
  1. . . . . 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 ;<
  1. . . . . . I B["<Lab_Test_IEN>" S LTI1=$$N(B) Q
  1. . . . . . I B["<Lab_Test_Name>" S C=$$N(B),$P(LTI1,U,2)=$$CHAR(C) Q
  1. . . . . . I B["<Lab_Test_Type>" S $P(LTI1,U,3)=$$N(B) Q
  1. . . . . . I B["<Lab_Test_Data_Location>" S $P(LTI1,U,4)=$$N(B) Q
  1. . . . . . I B["<Lab_Test_Data_Loc_Physical>" S $P(LTI1,U,5)=$$N(B) Q
  1. . . . . . I B["<Lab_Test_Inactive_Date>" S $P(LTI1,U,6)=$$N(B) Q
  1. . . . . . I B["<Lab_Test_Status>" S $P(LTI1,U,7)=$$N(B),@HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,1)=LTI1 Q
  1. . . . . . 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 ;<
  1. . . . . . . I B["<Lab_Test_Specimen_IEN>" S LTS1=$$N(B) Q
  1. . . . . . . I B["<Lab_Test_Specimen_Name>" S C=$$N(B),$P(LTS1,U,2)=$$CHAR(C) Q
  1. . . . . . . I B["<Lab_Test_Specimen_Units>" S C=$$N(B),$P(LTS1,U,3)=$$CHAR(C) Q
  1. . . . . . . I B["<Lab_Test_Specimen_Inactive_Date>" S $P(LTS1,U,4)=$$N(B)
  1. . . . . . . I B["<Lab_Test_Specimen_Status>" S $P(LTS1,U,5)=$$N(B),@HDIV@(HDIORD,"LPI",LPI,"LTI",LTI,"LTS",LTS,1)=LTS1 Q
  1. . . . . . . I B="<Master_Lab_Test_Item>" Q
  1. . . . . . . I B="</Master_Lab_Test_Item>" Q
  1. . . . . . . I B["<Master_Lab_Test_IEN>" S LTS2=$$N(B) Q
  1. . . . . . . I B["<Master_Lab_Test_Name>" S C=$$N(B),$P(LTS2,U,2)=$$CHAR(C) Q
  1. . . . . . . I B["<Master_Lab_Test_Alternate_Name>" S C=$$N(B),$P(LTS2,U,3)=$$CHAR(C) Q
  1. . . . . . . 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
  1. . . . . . . I B["<Master_Lab_Test_Status>" S LTS3=$$N(B) Q
  1. . . . . . . I B["<Master_Lab_Test_LOINC_Code>" S $P(LTS3,U,2)=$$N(B) Q
  1. . . . . . . I B["<Master_Lab_Test_Component>" S C=$$N(B),$P(LTS3,U,3)=$$CHAR(C) Q
  1. . . . . . . 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
  1. . . . . . . I B["<Master_Lab_Test_Time_Aspect>" S LTS4=$$N(B) Q
  1. . . . . . . I B["<Master_Lab_Test_Specimen>" S C=$$N(B),$P(LTS4,U,2)=$$CHAR(C) Q
  1. . . . . . . I B["<Master_Lab_Test_Scale>" S C=$$N(B),$P(LTS4,U,3)=$$CHAR(C) Q
  1. . . . . . . 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
  1. ;
  1. L1E ; end of flip from XML
  1. ;
  1. ;
  1. I HDITYPE="R" G REPORT
  1. G EXPORT
  1. Q
  1. ;
  1. REPORT ;
  1. ; basic repeats
  1. S HDIFAC=$G(@HDIV@("F",1)),HDIA=$G(@HDIV@("T")),QUIT="",PAGE=1
  1. S HD="HDI Orderable Items SDO List For: "_HDIA
  1. s HD1=$P(HDIFAC,U,1)_" "_($S($P(HDIFAC,U,2)="NO":"NOT-",1:""))_"PRODUCTION"
  1. S HD2="Type of Lookup: "_$P(HDIFAC,U,4)
  1. I $P(HDIFAC,U,4)="PARTIAL" S HD2=HD2_" Partial Name: "_$P(HDIFAC,U,5)
  1. S XDD=^DD("DD"),ULINE="",$P(ULINE,"_",79)="_"
  1. U IO
  1. S O10143=0,QUIT=""
  1. R1 D GETORD I 'O10143 G PDONE
  1. D RHEAD,RORD S LPI=0
  1. R2 D GETLPI I 'LPI D PAUSE G PDONE:QUIT,R1
  1. D RLPI I QUIT G PDONE
  1. I LPPER G R1
  1. S LTI=0
  1. R3 D GETLTI I 'LTI G R2
  1. D RLTI I QUIT G PDONE
  1. S LTS=0
  1. R4 D GETLTS I 'LTS G R3
  1. D RLTS1 I QUIT G PDONE
  1. D RLTS2 I QUIT G PDONE
  1. G R4
  1. ;
  1. RCHKC I HDICRT,($Y>(IOSL-4)) D I QUIT Q
  1. .D PAUSE
  1. .Q:QUIT
  1. .;W @IOF
  1. .W !
  1. .I HDITYPE'="X" D RHEAD
  1. E I ('HDICRT),($Y>(IOSL-2)) D
  1. .W @IOF
  1. .I HDITYPE'="X" D RHEAD
  1. ;
  1. Q
  1. ;
  1. PAUSE N DIR,DIRUT,X,Y
  1. ;F Q:$Y>(IOSL-3) W !
  1. I 'HDICRT Q
  1. ; W !
  1. S DIR(0)="E" D ^DIR
  1. I ('(+Y))!$D(DIRUT) S QUIT=1
  1. I 'QUIT S $Y=0
  1. Q
  1. ;
  1. DONE ; final quit point
  1. K @HDIV,@RET1,RET1
  1. K LPI,LPIEN,LPNM,LPO1,LPPN,LTI1,LTIDA,LTIDAP,LTIDT,LTIEN,LTINM,TAB,LTI,LTS,HDIORD
  1. K LTIST,LTITYP,LTMANM,LTMCOM,LTMDT,LTMIEN,LTMLON,LTMMET,LTMNM,LTMPRO,LTMSCA,LTMSPC
  1. K LTMST,LTMTIM,LTS1,LTS2,LTS3,LTS4,LTSDT,LTSIEN,LTSNM,LTSST,LTSUN,M,HDIV,HD,HD1,HD2
  1. K O10143,OIDT,OIEN,OIMEN,OINM,OIST,OISYN,OK,OK1,QUIT,R,D,HDIA,HDIFAC,HDIOI,HDIORD,LPPER
  1. Q
  1. ;
  1. PLE ;
  1. PDONE ; print done
  1. I 'HDICRT D ^%ZISC
  1. U IO W !!,?29,$S(QUIT'=1:"--- Report Finished ---",1:"--- Report Aborted ---")
  1. G DONE
  1. Q
  1. ;
  1. ;
  1. RHEAD ;Description: Prints the report header.
  1. Q:QUIT
  1. N LINE
  1. I $Y>1 W @IOF
  1. W !,?(40-($L(HD)\2)),HD
  1. W !,?(40-($L(HD1)\2)),HD1
  1. W !,?(40-($L(HD2)\2)),HD2
  1. W !,?27,"Date Printed: "_$$FMTE^XLFDT(DT),?70,"Page ",PAGE
  1. S PAGE=PAGE+1
  1. ;
  1. W !,ULINE
  1. Q
  1. ;
  1. RORD ; print order info
  1. D RCHKC Q:QUIT
  1. W !,"Orderable Item Name: ",OINM
  1. D RCHKC Q:QUIT
  1. W !," IEN: ",OIEN,?15,"Mnemonic: ",$S(($E(OIMEN)="Y"):"Yes",1:"No"),?29,"Inactive Date: ",OIDT
  1. D RCHKC Q:QUIT
  1. W ?63,"Status: ",$S(OIST=1:"Inactive",1:" Active")
  1. D RCHKC Q:QUIT
  1. W !," Synonyms: "
  1. S A=12,B=0,C="" F S B=$O(OISYN(B)) Q:'B S C=$G(OISYN(B)) D:(A+($L(C)+1)>78) RCHKC Q:QUIT W:(A+($L(C)+1)>78) !," " W C W:(B'=OISYN(0)) ", " S A=$S((A+($L(C)+2)>78):2,1:A)+($L(C)+2)
  1. D RCHKC Q:QUIT
  1. W !,ULINE
  1. Q
  1. ;
  1. RLPI ; print lab primary info
  1. D RCHKC Q:QUIT
  1. I LPPER D Q
  1. . W !,"Laboratory Primary Item for Orderable Item: ",$E(LPNM,1,33),"..."
  1. . D RCHKC Q:QUIT
  1. . W !,"With IEN of: ",LTIEN," Not Found in Laboratory Test File"
  1. W !,"Laboratory Primary Item: ",LPNM,?70,"IEN: ",$E(" ",1,(5-$L(LPIEN))),LPIEN
  1. D RCHKC Q:QUIT
  1. W !," Panel: ",LPPN
  1. Q
  1. ;
  1. RLTI ; print lab test
  1. D RCHKC Q:QUIT
  1. W !,"Laboratory Test: ",LTINM,?70,"IEN: ",$E(" ",1,(5-$L(LTIEN))),LTIEN
  1. D RCHKC Q:QUIT
  1. W !," Type: ",$P(LTITYP," ",1),?17,"Data Location: ",LTIDA,?46,"Data Loc Physical: ",LTIDAP
  1. D RCHKC Q:QUIT
  1. W !," Inactive Date: ",LTIDT,?61,"Status: " I LTIEN&(LTINM'="") W $S(($E(LTIST)=1):"Inactive",1:" Active")
  1. Q
  1. ;
  1. RLTS1 ; print specimen info
  1. D RCHKC Q:QUIT
  1. W !,"Specimen: ",LTSNM,?70,"IEN: ",$E(" ",1,(5-$L(LTSIEN))),LTSIEN
  1. D RCHKC I QUIT Q
  1. W !," Units: ",LTSUN,?22,"Inactive Date: ",LTSDT,?61,"Status: " I LTSIEN&(LTSNM'="") W $S(($E(LTSST)=1):"Inactive",1:" Active")
  1. Q
  1. ;
  1. RLTS2 ; print initial mltf info
  1. D RCHKC Q:QUIT
  1. I LTMNM="" D Q
  1. . W !,"Master Lab Test Name: SPECIMEN NOT ASSOCIATED TO MASTER LABORATORY TEST File"
  1. W !,"Master Lab Test Name: "
  1. D DISPL(LTMNM,53,71) I QUIT Q
  1. ;
  1. D RCHKC Q:QUIT
  1. W !," IEN: ",LTMIEN,?18,"Inactive DT: ",LTMDT,?61,"Status: " I LTMIEN&(LTMNM'="") W $S(($E(LTMST)=1):"Inactive",1:" Active")
  1. ;
  1. D RCHKC Q:QUIT
  1. W !," Alternate Name: "
  1. D DISPL(LTMANM,56,71) I QUIT Q
  1. ;
  1. D RCHKC Q:QUIT
  1. W !," LOINC Code: ",LTMLON
  1. ;
  1. D RCHKC Q:QUIT
  1. W !," Component: "
  1. D DISPL(LTMCOM,63,71) I QUIT Q
  1. ;
  1. D RCHKC Q:QUIT
  1. W !," Property: "
  1. D DISPL(LTMPRO,63,71) I QUIT Q
  1. ;
  1. D RCHKC Q:QUIT
  1. W !," Time Aspect: "
  1. D DISPL(LTMTIM,61,71) I QUIT Q
  1. ;
  1. W !," Specimen: "
  1. D DISPL(LTMSPC,63,71) I QUIT Q
  1. ;
  1. D RCHKC Q:QUIT
  1. W !," Scale: "
  1. D DISPL(LTMSCA,66,71) I QUIT Q
  1. ;
  1. D RCHKC Q:QUIT
  1. W !," Method: "
  1. D DISPL(LTMTIM,65,71) I QUIT Q
  1. Q
  1. ;
  1. EXPORT ; output as export file
  1. ; basic repeats
  1. S HDIFAC=$G(@HDIV@("F",1)),HDIA=$G(@HDIV@("T"))
  1. ; walk collection
  1. S O10143=0 D EHEAD
  1. E1 D GETORD I 'O10143 G EOUT
  1. S LPI=0
  1. E2 D GETLPI I 'LPI G E1
  1. S LTI=0
  1. E3 D GETLTI I 'LTI G E2
  1. S LTS=0
  1. E4 D GETLTS I 'LTS G E3
  1. ; output data
  1. U IO W $P(HDIFAC,U,1),TAB,$P(HDIFAC,U,2),TAB,$P(HDIFAC,U,3),TAB,HDIA,TAB,$P(HDIFAC,U,4),TAB,$P(HDIFAC,U,5),TAB
  1. W OIEN,TAB,OINM,TAB,($S(($E(OIMEN)="Y"):"Yes",1:"No")),TAB,OIDT,TAB,($S(OIST=1:"Inactive",1:"Active")),TAB
  1. ; get synonyms
  1. S A=0 F I=1:1 S A=$O(OISYN(A)) Q:'A S B=$G(OISYN(A)) W B W:(I'=$G(OISYN(0))) ", "
  1. S A="" I LTIEN&(LTINM'="") S A=$S(LTIST=1:"Inactive",1:"Active")
  1. W TAB,LPIEN,TAB,LPNM,TAB,LPPN,TAB,LTIEN,TAB,LTINM,TAB,LTITYP,TAB,LTIDA,TAB,LTIDAP,TAB,LTIDT,TAB,A,TAB
  1. S A="" I LTSIEN&(LTSNM'="") S A=$S(LTSST=1:"Inactive",1:"Active")
  1. W LTSIEN,TAB,LTSNM,TAB,LTSUN,TAB,LTSDT,TAB,A,TAB,LTMIEN,TAB,LTMNM,TAB,LTMANM,TAB,LTMDT,TAB
  1. S A="" I LTMIEN&(LTMNM'="") S A=$S(LTMST=1:"Inactive",1:"Active")
  1. W A,TAB,LTMLON,TAB,LTMCOM,TAB,LTMPRO,TAB,LTMTIM,TAB,LTMSPC,TAB,LTMSCA,TAB,LTMMET
  1. W !
  1. G E4
  1. ;
  1. EOUT ;
  1. I 'HDICRT D ^%ZISC
  1. G DONE
  1. Q
  1. ;
  1. EHEAD ; export header
  1. U IO W "Facility_Name-Number",TAB,"Production_Account",TAB,"Net_Name",TAB,"Area",TAB,"Type_of_Lookup",TAB
  1. W "Partial_Name",TAB,"Orderable_Item_IEN",TAB
  1. W "Orderable_Item_Name",TAB,"Orderable_Item_Mnemonic",TAB,"Orderable_Item_Inactive_Date",TAB,"Orderable_Item_Status",TAB
  1. W "Orderable_Item_Synonyms",TAB,"Lab_Primary_Test_IEN",TAB,"Lab_Primary_Test_Name",TAB,"Lab_Primary_Test_Panel",TAB
  1. W "Lab_Test_IEN",TAB,"Lab_Test_Name",TAB,"Lab_Test_Type",TAB,"Lab_Test_Data_Location",TAB,"Lab_Test_Data_Loc_Physical",TAB
  1. W "Lab_Test_Inactive_Date",TAB,"Lab_Test_Status",TAB,"Lab_Test_Specimen_IEN",TAB,"Lab_Test_Specimen_Name",TAB
  1. W "Lab_Test_Specimen_Units",TAB,"Lab_Test_Specimen_Inactive_Date",TAB,"Lab_Test_Specimen_Status",TAB
  1. W "Master_Lab_Test_IEN",TAB,"Master_Lab_Test_Name",TAB,"Master_Lab_Test_Alternate_Name",TAB,"Master_Lab_Test_Inactive_Date",TAB
  1. W "Master_Lab_Test_Status",TAB,"Master_Lab_Test_LOINC_Code",TAB,"Master_Lab_Test_Component",TAB
  1. W "Master_Lab_Test_Property",TAB,"Master_Lab_Test_Time_Aspect",TAB,"Master_Lab_Test_Specimen",TAB
  1. W "Master_Lab_Test_Scale",TAB,"Master_Lab_Test_Method"
  1. W !
  1. Q
  1. ;
  1. GETORD S (OIEN,OINM,OIMEN,OIDT,OIST)=""
  1. S O10143=$O(@HDIV@(O10143)) I 'O10143 Q
  1. 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)
  1. K OISYN M OISYN=@HDIV@(O10143,"S")
  1. Q
  1. ;
  1. GETLPI ; get primary lab item
  1. S (LPIEN,LPNM,LPPN,LPPER)=""
  1. N C
  1. S LPI=$O(@HDIV@(O10143,"LPI",LPI)) I 'LPI Q
  1. S B=$G(@HDIV@(O10143,"LPI",LPI,1)),LPIEN=$P(B,U,1),LPNM=$P(B,U,2),LPPN=$P(B,U,3)
  1. I $P(B,U,4)'="" S C=$P(B,U,4),LPIEN=$P(C,":",1),LPNM=$P(C,":",2),LPPER=1
  1. Q
  1. ;
  1. GETLTI ; get lab test item
  1. S (LTIEN,LTINM,LTITYP,LTIDA,LTIDAP,LTIDT,LTIST)=""
  1. S LTI=$O(@HDIV@(O10143,"LPI",LPI,"LTI",LTI)) I 'LTI Q
  1. 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)
  1. S LTIDA=$P(B,U,4),LTIDAP=$P(B,U,5),LTIDT=$P(B,U,6),LTIST=$P(B,U,7)
  1. Q
  1. ;
  1. GETLTS ; get lab specimen and mltf item
  1. S (LTSIEN,LTSNM,LTSUN,LTSDT,LTSST,LTMIEN,LTMNM,LTMANM,LTMST,LTMLON,LTMCOM,LTMPRO,LTMTIM,LTMSPC,LTMSCA,LTMMET)=""
  1. S LTS=$O(@HDIV@(O10143,"LPI",LPI,"LTI",LTI,"LTS",LTS)) I 'LTS Q
  1. 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)
  1. S LTSDT=$P(B,U,4),LTSST=$P(B,U,5)
  1. 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)
  1. S LTMDT=$P(B,U,4)
  1. 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)
  1. 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)
  1. Q
  1. ;
  1. CHAR(A) ; check for ctrl chars, <, >, &
  1. N B,C,D,I,L,M,N
  1. I A="" Q A
  1. S D=A
  1. I A["'AND'" D ;<
  1. . S B=$F(A,"'AND'")
  1. . S A=$E(A,1,(B-6))_"&"_$E(A,B,$L(A))
  1. I A["'LESS THAN'" D ;<
  1. . S B=$F(A,"'LESS THAN'")
  1. . S A=$E(A,1,(B-12))_"<"_$E(A,B,$L(A))
  1. I A["'GREATER THAN'" D ;<
  1. . S B=$F(A,"'GREATER THAN'")
  1. . S A=$E(A,1,(B-15))_">"_$E(A,B,$L(A))
  1. I A["'FORWARD SLASH'" D ;<
  1. . S B=$F(A,"'FORWARD SLASH'")
  1. . S A=$E(A,1,(B-16))_"/"_$E(A,B,$L(A))
  1. Q A
  1. ;
  1. N(K) ;get value
  1. N F
  1. S F=$P($P(K,"<",2),">",2)
  1. Q F
  1. ;
  1. XML ; entry if output is XML
  1. U IO
  1. N A,B,C S A=0
  1. F S A=$O(@RET1@(A)) Q:'A W $G(@RET1@(A)),! ; D RCHKC I QUIT Q
  1. K A,B,C
  1. ;G PDONE
  1. I 'HDICRT D ^%ZISC
  1. Q
  1. ;
  1. DISPL(S,F,E) ; display lines
  1. N A,D
  1. I S="" Q
  1. I $L(S)<F W S G DISPL1
  1. S D=F F Q:S="" S A="" D I QUIT Q ;<
  1. . S A=$E(S,1,D),S=$E(S,(D+1),$L(S)),D=E
  1. . W A I S'="" W " <"
  1. . D RCHKC
  1. . Q:QUIT
  1. . I S'="" W !," > "
  1. DISPL1 ;
  1. I QUIT Q
  1. D RCHKC Q:QUIT
  1. ;