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 Dec 13, 2024@01:49:45 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
