BLRLNKU1.m

BLRLNKU1 ; IHS/HQT/MJL - IHS Laboratory PCC Visit Creation Utility ; 13-Oct-2017 14:04 ;  MKK

 ;;5.2;IHS LABORATORY;**1041**;NOV 01, 1997;Build 23

 ;

RESETLOI ; EP - Reset LOINC, if necessary

 NEW ARYLOINC,F60IEN,F60LOINC,IHSLOINC,TXNLOINC,SITESPEC,STR

 ;

 S ARYLOINC=+$TR($G(APCDALVR("APCDTLNC")),"`")     ; Array's LOINC

 ;

 S F60IEN=+$TR($G(APCDALVR("APCDTLAB")),"`")       ; File 60 IEN

 S SITESPEC=+$TR($G(APCDALVR("APCDTSTE")),"`")     ; Site/Specimen IEN

 S F60LOINC=+$$GET1^DIQ(60.01,SITESPEC_","_F60IEN,95.3,"I")  ; File 60 Site/Specimen LOINC

 I F60LOINC D:ARYLOINC'=F60LOINC FLOINC(F60LOINC)  Q

 ;

 S IHSLOINC=+$$GET1^DIQ(60,F60IEN,"IHS LOINC","I")      ; File 60 IHS LOINC

 I IHSLOINC D:ARYLOINC'=IHSLOINC FLOINC(IHSLOINC)  Q

 ;

 ; If no LOINC in file 60, clear APCDALVR array and file 9009022

 K APCDALVR("APCDTLNC")

 S FDA(9009022,BLRLOGDA_",",1310)="@"

 D UPDATE^DIE("S","FDA",,"ERRS")

 ; S TXNLOINC=+$$GET1^DIQ(9009022,BLRLOGDA,1310,"I")      ; File 9009022 LOINC

 ; I TXNLOINC D:ARYLOINC'=TXNLOINC FLOINC(TXNLOINC)

 ;

 Q

 ;

FLOINC(MAKEITSO) ; EP - Force APCDALVR("APCDTLNC") [LOINC] to a value & reset 9009022 LOINC

 NEW FDA,ERRS

 ;

 K APCDALVR("APCDTLNC")

 S APCDALVR("APCDTLNC")="`"_MAKEITSO

 S BLRLOINC=MAKEITSO

 ;

 S FDA(9009022,BLRLOGDA_",",1310)=MAKEITSO

 D UPDATE^DIE("S","FDA",,"ERRS")

 Q

BLRLNKU1  ; IHS/HQT/MJL - IHS Laboratory PCC Visit Creation Utility ; 13-Oct-2017 14:04 ;  MKK

 +1       ;;5.2;IHS LABORATORY;**1041**;NOV 01, 1997;Build 23

 +2       ;

RESETLOI  ; EP - Reset LOINC, if necessary

 +1        NEW ARYLOINC,F60IEN,F60LOINC,IHSLOINC,TXNLOINC,SITESPEC,STR

 +2       ;

 +3       ; Array's LOINC

           SET ARYLOINC=+$TRANSLATE($GET(APCDALVR("APCDTLNC")),"`")

 +4       ;

 +5       ; File 60 IEN

           SET F60IEN=+$TRANSLATE($GET(APCDALVR("APCDTLAB")),"`")

 +6       ; Site/Specimen IEN

           SET SITESPEC=+$TRANSLATE($GET(APCDALVR("APCDTSTE")),"`")

 +7       ; File 60 Site/Specimen LOINC

           SET F60LOINC=+$$GET1^DIQ(60.01,SITESPEC_","_F60IEN,95.3,"I")

 +8        IF F60LOINC

               IF ARYLOINC'=F60LOINC

                   DO FLOINC(F60LOINC)

               QUIT 

 +9       ;

 +10      ; File 60 IHS LOINC

           SET IHSLOINC=+$$GET1^DIQ(60,F60IEN,"IHS LOINC","I")

 +11       IF IHSLOINC

               IF ARYLOINC'=IHSLOINC

                   DO FLOINC(IHSLOINC)

               QUIT 

 +12      ;

 +13      ; If no LOINC in file 60, clear APCDALVR array and file 9009022

 +14       KILL APCDALVR("APCDTLNC")

 +15       SET FDA(9009022,BLRLOGDA_",",1310)="@"

 +16       DO UPDATE^DIE("S","FDA",,"ERRS")

 +17      ; S TXNLOINC=+$$GET1^DIQ(9009022,BLRLOGDA,1310,"I")      ; File 9009022 LOINC

 +18      ; I TXNLOINC D:ARYLOINC'=TXNLOINC FLOINC(TXNLOINC)

 +19      ;

 +20       QUIT 

 +21      ;

FLOINC(MAKEITSO) ; EP - Force APCDALVR("APCDTLNC") [LOINC] to a value & reset 9009022 LOINC

 +1        NEW FDA,ERRS

 +2       ;

 +3        KILL APCDALVR("APCDTLNC")

 +4        SET APCDALVR("APCDTLNC")="`"_MAKEITSO

 +5        SET BLRLOINC=MAKEITSO

 +6       ;

 +7        SET FDA(9009022,BLRLOGDA_",",1310)=MAKEITSO

 +8        DO UPDATE^DIE("S","FDA",,"ERRS")

 +9        QUIT