- ECX3115P ;ALB/MRY -Populate DSS LOINC Code file Post-Init Rtn; 02/10/09
- ;;3.0;DSS EXTRACTS;**115**;Dec 22,1997;Build 3
- ;
- ENV ;Main entry point for Environment check point.
- ;
- S XPDABORT=""
- D PROGCHK(.XPDABORT) ;checks programmer variables
- I XPDABORT="" K XPDABORT
- Q
- ;
- PROGCHK(XPDABORT) ;checks for necessary programmer variables
- ;
- I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
- .D BMES^XPDUTL("*****")
- .D MES^XPDUTL("Your programming variables are not set up properly.")
- .D MES^XPDUTL("Installation aborted.")
- .D MES^XPDUTL("*****")
- .S XPDABORT=2
- Q
- POST ;
- ;Seed new LOINC Codes
- D ADDLNC
- ;Remove LOINC Codes
- D DELLNC
- Q
- ;
- ADDLNC ;Add LOINC Codes
- N ECXLINE,ECXSTR,ECXDA,CNT
- D MES^XPDUTL(" ")
- D MES^XPDUTL(" ")
- D MES^XPDUTL(" Adding entries to DSS LOINC CODES File (#727.29)...")
- D MES^XPDUTL(" ")
- S CNT=0
- N DIC,DIE,DA,DLAYGO,DR,X,Y,ECXLINE,ECXSTR,ECXDN,ECXDTN,ECXLN,ECXDRU
- S DIC="^ECX(727.29,",DIC(0)="L",DLAYGO=727.29
- F ECXLINE=1:1 S ECXSTR=$P($T(ALOINC+ECXLINE),";;",2) Q:ECXSTR="EXIT" D
- . S X=$P(ECXSTR,"^") ;I $$GET1^DIQ(95.3,X,.01,"I")'=X Q
- . D ^DIC I Y<0 D Q
- .. D BMES^XPDUTL("*****")
- .. D MES^XPDUTL("Unsuccessful entry of LOINC Code - "_X_".")
- .. D MES^XPDUTL("******")
- . S CNT=CNT+1
- . S ECXDN=$P(ECXSTR,"^",2)
- . S ECXDTN=$P(ECXSTR,"^",3)
- . S ECXLN=$P(ECXSTR,"^",4)
- . S ECXDRU=$P(ECXSTR,"^",5)
- . S DA=+Y,DR=".02///"_ECXDN_";.03///"_ECXDTN_";.04///"_ECXDRU_";.05///"_ECXLN
- . S DIE=DIC D ^DIE
- K DA,DIC,DIE,DLAYGO,X,Y
- S DIK="^ECX(727.29,",DIK(1)=".02^AC" D ENALL^DIK
- K DIK
- Q
- ;
- ALOINC ;LOINC Codes (add)
- ;;2947-0^0003^Sodium (Serum)^Sodium Bld-sCnc^MEQ/L or MMOL/L
- ;;1558-6^0010^Glucose (Serum)^Glucose p fast SerPl-mCnc^MG/DL
- ;;24467-3^0020^CD-4 (Absolute T Cell Count)^CD3+CD4+ Cells # Bld^CELLS/MM3, CELLS/UL
- ;;21008-8^0038^HIV Viral Load^HIV1 RNA # SerPl Prb^COPIES/ML
- ;;29539-4^0038^HIV Viral Load^HIV Log Viral Load Plas Bdna^COPIES/ML
- ;;21333-0^0038^HIV Viral Load^HIV1 RNA # Ser^COPIES/ML
- ;;20570-8^0050^Hematocrit^Hct % Bld^%
- ;;2340-8^0057^Glucose POC^Glucose Bld Test Str Auto-mCnc^MG/DL
- ;;32016-8^0057^Glucose POC^Glucose BldC-mCnc^MG/DL
- ;;15152-2^0060^Bilirubin (Direct)^Bilirub Conj SerPl-mCnc^MG/DL
- ;;20564-1^0068^O2 Saturation^O2 Saturation^%
- ;;EXIT
- Q
- ;
- DELLNC ;Remove LOINC Codes
- N LOINC,ENTRY,DA,DIK
- D MES^XPDUTL(" ")
- D MES^XPDUTL(" ")
- D MES^XPDUTL(" Removing entries to DSS LOINC CODES File (#727.29)...")
- D MES^XPDUTL(" ")
- S CNT=0
- ;
- F LOINC="3719-2","5222-5","14152-3" S ENTRY=+$O(^ECX(727.29,"B",LOINC,0)) I ENTRY D
- . S DA=ENTRY,DIK="^ECX(727.29," D ^DIK
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3115P 2638 printed Feb 18, 2025@23:16:09 Page 2
- 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
- +2 ;
- ENV ;Main entry point for Environment check point.
- +1 ;
- +2 SET XPDABORT=""
- +3 ;checks programmer variables
- DO PROGCHK(.XPDABORT)
- +4 IF XPDABORT=""
- KILL XPDABORT
- +5 QUIT
- +6 ;
- PROGCHK(XPDABORT) ;checks for necessary programmer variables
- +1 ;
- +2 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
- Begin DoDot:1
- +3 DO BMES^XPDUTL("*****")
- +4 DO MES^XPDUTL("Your programming variables are not set up properly.")
- +5 DO MES^XPDUTL("Installation aborted.")
- +6 DO MES^XPDUTL("*****")
- +7 SET XPDABORT=2
- End DoDot:1
- +8 QUIT
- POST ;
- +1 ;Seed new LOINC Codes
- +2 DO ADDLNC
- +3 ;Remove LOINC Codes
- +4 DO DELLNC
- +5 QUIT
- +6 ;
- ADDLNC ;Add LOINC Codes
- +1 NEW ECXLINE,ECXSTR,ECXDA,CNT
- +2 DO MES^XPDUTL(" ")
- +3 DO MES^XPDUTL(" ")
- +4 DO MES^XPDUTL(" Adding entries to DSS LOINC CODES File (#727.29)...")
- +5 DO MES^XPDUTL(" ")
- +6 SET CNT=0
- +7 NEW DIC,DIE,DA,DLAYGO,DR,X,Y,ECXLINE,ECXSTR,ECXDN,ECXDTN,ECXLN,ECXDRU
- +8 SET DIC="^ECX(727.29,"
- SET DIC(0)="L"
- SET DLAYGO=727.29
- +9 FOR ECXLINE=1:1
- SET ECXSTR=$PIECE($TEXT(ALOINC+ECXLINE),";;",2)
- if ECXSTR="EXIT"
- QUIT
- Begin DoDot:1
- +10 ;I $$GET1^DIQ(95.3,X,.01,"I")'=X Q
- SET X=$PIECE(ECXSTR,"^")
- +11 DO ^DIC
- IF Y<0
- Begin DoDot:2
- +12 DO BMES^XPDUTL("*****")
- +13 DO MES^XPDUTL("Unsuccessful entry of LOINC Code - "_X_".")
- +14 DO MES^XPDUTL("******")
- End DoDot:2
- QUIT
- +15 SET CNT=CNT+1
- +16 SET ECXDN=$PIECE(ECXSTR,"^",2)
- +17 SET ECXDTN=$PIECE(ECXSTR,"^",3)
- +18 SET ECXLN=$PIECE(ECXSTR,"^",4)
- +19 SET ECXDRU=$PIECE(ECXSTR,"^",5)
- +20 SET DA=+Y
- SET DR=".02///"_ECXDN_";.03///"_ECXDTN_";.04///"_ECXDRU_";.05///"_ECXLN
- +21 SET DIE=DIC
- DO ^DIE
- End DoDot:1
- +22 KILL DA,DIC,DIE,DLAYGO,X,Y
- +23 SET DIK="^ECX(727.29,"
- SET DIK(1)=".02^AC"
- DO ENALL^DIK
- +24 KILL DIK
- +25 QUIT
- +26 ;
- ALOINC ;LOINC Codes (add)
- +1 ;;2947-0^0003^Sodium (Serum)^Sodium Bld-sCnc^MEQ/L or MMOL/L
- +2 ;;1558-6^0010^Glucose (Serum)^Glucose p fast SerPl-mCnc^MG/DL
- +3 ;;24467-3^0020^CD-4 (Absolute T Cell Count)^CD3+CD4+ Cells # Bld^CELLS/MM3, CELLS/UL
- +4 ;;21008-8^0038^HIV Viral Load^HIV1 RNA # SerPl Prb^COPIES/ML
- +5 ;;29539-4^0038^HIV Viral Load^HIV Log Viral Load Plas Bdna^COPIES/ML
- +6 ;;21333-0^0038^HIV Viral Load^HIV1 RNA # Ser^COPIES/ML
- +7 ;;20570-8^0050^Hematocrit^Hct % Bld^%
- +8 ;;2340-8^0057^Glucose POC^Glucose Bld Test Str Auto-mCnc^MG/DL
- +9 ;;32016-8^0057^Glucose POC^Glucose BldC-mCnc^MG/DL
- +10 ;;15152-2^0060^Bilirubin (Direct)^Bilirub Conj SerPl-mCnc^MG/DL
- +11 ;;20564-1^0068^O2 Saturation^O2 Saturation^%
- +12 ;;EXIT
- +13 QUIT
- +14 ;
- DELLNC ;Remove LOINC Codes
- +1 NEW LOINC,ENTRY,DA,DIK
- +2 DO MES^XPDUTL(" ")
- +3 DO MES^XPDUTL(" ")
- +4 DO MES^XPDUTL(" Removing entries to DSS LOINC CODES File (#727.29)...")
- +5 DO MES^XPDUTL(" ")
- +6 SET CNT=0
- +7 ;
- +8 FOR LOINC="3719-2","5222-5","14152-3"
- SET ENTRY=+$ORDER(^ECX(727.29,"B",LOINC,0))
- IF ENTRY
- Begin DoDot:1
- +9 SET DA=ENTRY
- SET DIK="^ECX(727.29,"
- DO ^DIK
- End DoDot:1
- +10 QUIT