ECX140PT ;ALB/AG - ECX*3.0*140 Post-Init Rtn; 02/10/09 ; 5/29/12 9:30am
;;3.0;DSS EXTRACTS;**140**;Dec 22,1997;Build 6
;
;Post-init routine adding new entries to:
;
;LOINC Code(#727.29) file
;
;
;
Q
POST ;
;Add new LOINC Codes Entry Point
D ADDLNC
Q
;
ADDLNC ;Add LOINC Codes
N ECXLINE,ECXSTR,ECXCNT
D MES^XPDUTL(" ")
D MES^XPDUTL(" ")
D MES^XPDUTL(" Adding entries to DSS LOINC File (#727.29)...")
D MES^XPDUTL(" ")
S ECXCNT=0
N DIC,DIE,DA,DLAYGO,DR,X,Y,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,"^",1)
.D ^DIC I Y<0 D Q
..D BMES^XPDUTL("*****")
..D MES^XPDUTL("Unsuccessful entry of LOINC Code - "_X_".")
..D MES^XPDUTL("******")
.S ECXCNT=ECXCNT+1
.S ECXDN=$P(ECXSTR,"^",2)
.S ECXDTN=$P(ECXSTR,"^",3)
.S ECXDRU=$P(ECXSTR,"^",4)
.S ECXLN=$P(ECXSTR,"^",5)
.S DA=+Y,DR=".02///"_ECXDN_";.03///"_ECXDTN_";.04///"_ECXDRU_";.05///"_ECXLN
.S DIE=DIC D ^DIE
.D BMES^XPDUTL(">>>.....Code "_$P(ECXSTR,"^")_" is added to the file.")
K DA,DIC,DIE,DLAYGO,X,Y
S DIK="^ECX(727.29,",DIK(1)=".02^AC" D ENALL^DIK
K DIK
Q
;
ALOINC ;LOINC CODE^LAR TEST #^DSS TEST NAME^REPORTING UNITS^LOINC NAME
;;11065-0^0005^BUN^mg/dl^BUN pre dialysis SerPl-mCnc
;;11064-3^0005^BUN^mg/dl^BUN p dialysis SerPl-mCnc
;;2282-2^0025^Folic Acid/ Folate^ng/ml^Folate Bld-mCnc
;;2283-0^0025^Folic Acid/ Folate^ng/ml^Folate RBC-mCnc
;;EXIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX140PT 1515 printed Dec 13, 2024@01:49:37 Page 2
ECX140PT ;ALB/AG - ECX*3.0*140 Post-Init Rtn; 02/10/09 ; 5/29/12 9:30am
+1 ;;3.0;DSS EXTRACTS;**140**;Dec 22,1997;Build 6
+2 ;
+3 ;Post-init routine adding new entries to:
+4 ;
+5 ;LOINC Code(#727.29) file
+6 ;
+7 ;
+8 ;
+9 QUIT
POST ;
+1 ;Add new LOINC Codes Entry Point
+2 DO ADDLNC
+3 QUIT
+4 ;
ADDLNC ;Add LOINC Codes
+1 NEW ECXLINE,ECXSTR,ECXCNT
+2 DO MES^XPDUTL(" ")
+3 DO MES^XPDUTL(" ")
+4 DO MES^XPDUTL(" Adding entries to DSS LOINC File (#727.29)...")
+5 DO MES^XPDUTL(" ")
+6 SET ECXCNT=0
+7 NEW DIC,DIE,DA,DLAYGO,DR,X,Y,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 SET X=$PIECE(ECXSTR,"^",1)
+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 ECXCNT=ECXCNT+1
+16 SET ECXDN=$PIECE(ECXSTR,"^",2)
+17 SET ECXDTN=$PIECE(ECXSTR,"^",3)
+18 SET ECXDRU=$PIECE(ECXSTR,"^",4)
+19 SET ECXLN=$PIECE(ECXSTR,"^",5)
+20 SET DA=+Y
SET DR=".02///"_ECXDN_";.03///"_ECXDTN_";.04///"_ECXDRU_";.05///"_ECXLN
+21 SET DIE=DIC
DO ^DIE
+22 DO BMES^XPDUTL(">>>.....Code "_$PIECE(ECXSTR,"^")_" is added to the file.")
End DoDot:1
+23 KILL DA,DIC,DIE,DLAYGO,X,Y
+24 SET DIK="^ECX(727.29,"
SET DIK(1)=".02^AC"
DO ENALL^DIK
+25 KILL DIK
+26 QUIT
+27 ;
ALOINC ;LOINC CODE^LAR TEST #^DSS TEST NAME^REPORTING UNITS^LOINC NAME
+1 ;;11065-0^0005^BUN^mg/dl^BUN pre dialysis SerPl-mCnc
+2 ;;11064-3^0005^BUN^mg/dl^BUN p dialysis SerPl-mCnc
+3 ;;2282-2^0025^Folic Acid/ Folate^ng/ml^Folate Bld-mCnc
+4 ;;2283-0^0025^Folic Acid/ Folate^ng/ml^Folate RBC-mCnc
+5 ;;EXIT
+6 QUIT
