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

ECX3115P.m

Go to the documentation of this file.
  1. ECX3115P ;ALB/MRY -Populate DSS LOINC Code file Post-Init Rtn; 02/10/09
  1. ;;3.0;DSS EXTRACTS;**115**;Dec 22,1997;Build 3
  1. ;
  1. ENV ;Main entry point for Environment check point.
  1. ;
  1. S XPDABORT=""
  1. D PROGCHK(.XPDABORT) ;checks programmer variables
  1. I XPDABORT="" K XPDABORT
  1. Q
  1. ;
  1. PROGCHK(XPDABORT) ;checks for necessary programmer variables
  1. ;
  1. I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
  1. .D BMES^XPDUTL("*****")
  1. .D MES^XPDUTL("Your programming variables are not set up properly.")
  1. .D MES^XPDUTL("Installation aborted.")
  1. .D MES^XPDUTL("*****")
  1. .S XPDABORT=2
  1. Q
  1. POST ;
  1. ;Seed new LOINC Codes
  1. D ADDLNC
  1. ;Remove LOINC Codes
  1. D DELLNC
  1. Q
  1. ;
  1. ADDLNC ;Add LOINC Codes
  1. N ECXLINE,ECXSTR,ECXDA,CNT
  1. D MES^XPDUTL(" ")
  1. D MES^XPDUTL(" ")
  1. D MES^XPDUTL(" Adding entries to DSS LOINC CODES File (#727.29)...")
  1. D MES^XPDUTL(" ")
  1. S CNT=0
  1. N DIC,DIE,DA,DLAYGO,DR,X,Y,ECXLINE,ECXSTR,ECXDN,ECXDTN,ECXLN,ECXDRU
  1. S DIC="^ECX(727.29,",DIC(0)="L",DLAYGO=727.29
  1. F ECXLINE=1:1 S ECXSTR=$P($T(ALOINC+ECXLINE),";;",2) Q:ECXSTR="EXIT" D
  1. . S X=$P(ECXSTR,"^") ;I $$GET1^DIQ(95.3,X,.01,"I")'=X Q
  1. . D ^DIC I Y<0 D Q
  1. .. D BMES^XPDUTL("*****")
  1. .. D MES^XPDUTL("Unsuccessful entry of LOINC Code - "_X_".")
  1. .. D MES^XPDUTL("******")
  1. . S CNT=CNT+1
  1. . S ECXDN=$P(ECXSTR,"^",2)
  1. . S ECXDTN=$P(ECXSTR,"^",3)
  1. . S ECXLN=$P(ECXSTR,"^",4)
  1. . S ECXDRU=$P(ECXSTR,"^",5)
  1. . S DA=+Y,DR=".02///"_ECXDN_";.03///"_ECXDTN_";.04///"_ECXDRU_";.05///"_ECXLN
  1. . S DIE=DIC D ^DIE
  1. K DA,DIC,DIE,DLAYGO,X,Y
  1. S DIK="^ECX(727.29,",DIK(1)=".02^AC" D ENALL^DIK
  1. K DIK
  1. Q
  1. ;
  1. ALOINC ;LOINC Codes (add)
  1. ;;2947-0^0003^Sodium (Serum)^Sodium Bld-sCnc^MEQ/L or MMOL/L
  1. ;;1558-6^0010^Glucose (Serum)^Glucose p fast SerPl-mCnc^MG/DL
  1. ;;24467-3^0020^CD-4 (Absolute T Cell Count)^CD3+CD4+ Cells # Bld^CELLS/MM3, CELLS/UL
  1. ;;21008-8^0038^HIV Viral Load^HIV1 RNA # SerPl Prb^COPIES/ML
  1. ;;29539-4^0038^HIV Viral Load^HIV Log Viral Load Plas Bdna^COPIES/ML
  1. ;;21333-0^0038^HIV Viral Load^HIV1 RNA # Ser^COPIES/ML
  1. ;;20570-8^0050^Hematocrit^Hct % Bld^%
  1. ;;2340-8^0057^Glucose POC^Glucose Bld Test Str Auto-mCnc^MG/DL
  1. ;;32016-8^0057^Glucose POC^Glucose BldC-mCnc^MG/DL
  1. ;;15152-2^0060^Bilirubin (Direct)^Bilirub Conj SerPl-mCnc^MG/DL
  1. ;;20564-1^0068^O2 Saturation^O2 Saturation^%
  1. ;;EXIT
  1. Q
  1. ;
  1. DELLNC ;Remove LOINC Codes
  1. N LOINC,ENTRY,DA,DIK
  1. D MES^XPDUTL(" ")
  1. D MES^XPDUTL(" ")
  1. D MES^XPDUTL(" Removing entries to DSS LOINC CODES File (#727.29)...")
  1. D MES^XPDUTL(" ")
  1. S CNT=0
  1. ;
  1. F LOINC="3719-2","5222-5","14152-3" S ENTRY=+$O(^ECX(727.29,"B",LOINC,0)) I ENTRY D
  1. . S DA=ENTRY,DIK="^ECX(727.29," D ^DIK
  1. Q