ECX140PT.m

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 ---ECX140PT   1515     printed  Apr 09, 2024@20:57:50                                                                                                                                                                                                    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