BLRLINKP.m

BLRLINKP ; IHS/DIR/FJE - VALIDATION OF VARIOUS V FILE FIELDS ; 22-Oct-2013 09:22 ; MKK

 ;;5.2;IHS LABORATORY;**1001,1015,1017,1018,1019,1021,1025,1033**;NOV 01, 1997

 ;

 ; The following is post-validation logic for the fields in the various

 ; V files 9000010.09 (^AUPNVLAB,^AUPNVMIC,^AUPNVBB, etc.).  It is

 ; called by the linkage process and will be executed ONLY if the PCC

 ; process rejects the write to the V file (PCC error  1 or 2).

 ; The functionality of this procedure is to interpret the reason of

 ; the V file edit rejection and store the error reason in field 106

 ; of file 9009022.

 ; NOTE:  Field 106 = PCC ERROR FLAG;

 ;        File 9009022 = IHS LAB TRANSACTION FILE (the ^BLRTXLOG global)

 ;

 ;

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER ^BLRLINKP")

 D ENTRYAUD^BLRUTIL("ENTER ^BLRLINKP")     ; IHS/OIT/MKK - LR*5.2*1033

 S ALRCHKIP="",BLRLINK=1,BLRCHQ=0

 F T=1:1 S BLRTXT=$T(PARSE+T) S BLRSTR=$P(BLRTXT,";",3) Q:BLRSTR=""!(BLRCHQ)  D BLDFLD I $D(APCDALVR(BLRNAME)) D:BLRSS1[BLRSS!(BLRSS1="")

 .S X=APCDALVR(BLRNAME)

 .I 'BLRQUIET D FLDSCHK Q:BLRCHQ

 .S BLRVSUB=$S(BLRVSUB'="":BLRVSUB,1:"TRANS")

 .D @BLRVSUB

 .I '$D(X) W:'BLRQUIET !,BLRLIT_" failed edit in V file" D

 ..S:BLRPCC="" BLRBUL=2,BLRPCC="Field "_BLRTLOG_" of file 9009022 is invalid"

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1019 IHS

 ; Determine if update to deleted or merged visit caused Error IFF Error Message blank

 D:BLRPCC="" BLRPCCVE

 ;----- END IHS MODIFICATIONS LR*5.2*1019 IHS

 ; generic reject message created when specific PCC rejection not determined

 S:BLRPCC="" BLRBUL=2,BLRPCC="Write to "_$P($G(^DIC(BLRVFILE,0)),U)_" file rejected"

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EXIT ^BLRLINKP")

 D ENTRYAUD^BLRUTIL("EXIT ^BLRLINKP")     ; IHS/OIT/MKK - LR*5.2*1033

 K BLRTXT,BLRSTR,BLRNAME,BLRVFLD,BLRLIT,BLRTLOG,BLRROOT,BLRPMSG,BLRVPRV,BLRVSUB,BLRCHQ

 Q

 ;

BLDFLD ; create BLR variables from BLRSTR

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER BLDFLD^BLRLINKP")

 D ENTRYAUD^BLRUTIL("ENTER BLDFLD^BLRLINKP")     ; IHS/OIT/MKK - LR*5.2*1033

 S BLRNAME=$P(BLRSTR,"|"),BLRVFLD=$P(BLRSTR,"|",2),BLRLIT=$P(BLRSTR,"|",3),BLRTLOG=$P(BLRSTR,"|",4),BLRROOT=$P(BLRSTR,"|",5),BLRVSUB=$P(BLRSTR,"|",6),BLRSS1=$P(BLRSTR,"|",7) S:BLRTLOG="" BLRTLOG=BLRLIT

 Q

 ;

 ;

TRANS ; perform input transform found in file in DD for appropriate V file

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER TRANS^BLRLINKP")

 D ENTRYAUD^BLRUTIL("ENTER TRANS^BLRLINKP")     ; IHS/OIT/MKK - LR*5.2*1033

 Q:APCDALVR(BLRNAME)=""

 S (DIE,DIC)=BLRROOT,DIC(0)=""

 X $P(^DD(BLRVFILE,BLRVFLD,0),U,5,99)   ;INPUT TRANSFORM

 Q

 ;

VTEST ; validation on required TEST field

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER VTEST^BLRLINKP")

 D ENTRYAUD^BLRUTIL("ENTER VTEST^BLRLINKP")     ; IHS/OIT/MKK - LR*5.2*1033

 I APCDALVR(BLRNAME)="" D REQMSG K X Q

 S APCDALVR(BLRNAME)=$P(APCDALVR(BLRNAME),"`",2)

 I '$D(^LAB(60,APCDALVR(BLRNAME))) S BLRBUL=2,BLRPCC="Field "_BLRTLOG_" of file 9009022 not a valid test in file 60" K X

 Q

 ;

VVSIT ; validation on required VISIT field

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER VVSIT^BLRLINKP")

 D ENTRYAUD^BLRUTIL("ENTER VVSIT^BLRLINKP")     ; IHS/OIT/MKK - LR*5.2*1033

 I APCDALVR(BLRNAME)="" D REQMSG K X Q

 I APCDALVR(BLRNAME)'?1N.N S BLRBUL=2,BLRPCC=BLRNAME_" needs to be all numeric" K X Q

 ; I '$D(^AUPNVSIT(APCDALVR(BLRNAME),0)) S BLRBUL=2,BLRPCC=BLRNAME_" not a valid visit" K X

 ; ----- BEGIN IHS/OIT/MKK -- LR*5.2*1025 -- Need a QUIT if this error exists

 I '$D(^AUPNVSIT(APCDALVR(BLRNAME),0)) S BLRBUL=2,BLRPCC=BLRNAME_" not a valid visit" K X Q

 ; ----- END IHS/OIT/MKK -- LR*5.2*1025 -- Need a QUIT if this error exists

 Q:'BLRVIEN

 S (DIE,DIC)=BLRROOT,DIC(0)=""

 X $P(^DD(BLRVFILE,BLRVFLD,0),U,5,99)  ;INPUT TRANSFORM

 Q

 ;

VANTIB ; validation on antibiotic field for Micro or

 ; antibody field for blood bank

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER VANTIB^BLRLINKP")

 D ENTRYAUD^BLRUTIL("ENTER VANTIB^BLRLINKP")     ; IHS/OIT/MKK - LR*5.2*1033

 Q:APCDALVR(BLRNAME)=""

 I $E(APCDALVR(BLRNAME))="`" S APCDALVR(BLRNAME)=$P(APCDALVR(BLRNAME),"`",2)

 I BLRSS="MI",'$D(^LAB(62.06,APCDALVR(BLRNAME))) S BLRBUL=2,BLRPCC="Field "_BLRTLOG_" of file 9009022 not a valid antibiotic IEN" K X Q

 I BLRSS="BB",'$D(^LAB(61.3,APCDALVR(BLRNAME))) S BLRBUL=2,BLRPCC="Field "_BLRTLOG_" of file 9009022 not a valid antibody IEN" K X

 Q

 ;

VPROV ; validation of provider field

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER VPROV^BLRLINKP")

 D ENTRYAUD^BLRUTIL("ENTER VPROV^BLRLINKP")     ; IHS/OIT/MKK - LR*5.2*1033

 Q:$G(APCDALVR(BLRNAME))=""

 ; S BLRPMSG="Field "_BLRTLOG_" of file 9009022 not in Provider file"

 ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 S BLRPMSG="Field "_BLRTLOG_" of file 9009022 not in NEW PERSON file"

 ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 S BLRVPRV=BLROPRV

 I BLRVPRV="" S BLRBUL=2,BLRPCC=BLRPMSG K X Q

 I $G(BLR200CV)]"",'$D(^VA(200,BLRVPRV)) D  Q  ;cmi/maw 1/8/2002**1015**

 . S BLRBUL=2,BLRPCC=BLRPMSG K X  ;cmi/maw 1/8/2002 **1015**

 ; I '$D(^DIC(6,BLRVPRV)) S BLRBUL=2,BLRPCC=BLRPMSG K X

 ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 ;      If the provider is in dictionary 200, it DOES NOT matter if the

 ;      provider is not in dictionary 6.

 S BLRPMSG="Field "_BLRTLOG_" of file 9009022 not in PROVIDER file"

 I '$D(^DIC(6,BLRVPRV))&('$D(^VA(200,BLRVPRV))) S BLRBUL=2,BLRPCC=BLRPMSG K X

 ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 Q

 ;

 ;no action taken at this time

VNOACT ;

 Q

FLDSCHK ;

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER FLDSCHK^BLRLINKP")

 D ENTRYAUD^BLRUTIL("ENTER FLDSCHK^BLRLINKP")     ; IHS/OIT/MKK - LR*5.2*1033

 D CHK^DIE(BLRVFILE,BLRVFLD,"E",APCDALVR(BLRNAME),.BLRCHK)

 I BLRCHK="^" W !,APCDALVR(BLRNAME)_" value is invalid for field "_BLRLIT_" "_BLRVFLD_" in file "_BLRVFILE,! S BLRCHQ=1

 K BLRCHK

 Q

 ;

PARSE ;;subscript name|field # for appropriate V file |literal desc|field # for file #9009022|global root|validation subroutine

 ;;APCDTLAB|.01|lab test|.06||VTEST|

 ;;APCDVSIT|.03|Visit IEN||^AUPNVSIT(|VVSIT|

 ;;APCDTRES|.04|result text|2001|||BB,CH

 ;;APCDTABN|.05|Normal flag|2002|||CH

 ;;APCDTANT|.05|antibiotic|1303||VANTIB|MI

 ;;APCDTANT|.05|antibody|1403||VANTIB|BB

 ;;APCDTACC|.06|Acc #|1202|||

 ;;APCDTRES|.07|blood bank test name|1402|||BB

 ;;APCDTCOL|.08|collection sample|1307|||MI  ;IHS/DIR TUC/AAB 04/08/98

 ;;APCDTCMD|.09|complete date|1309|||MI  ;IHS/DIR TUC/AAB 04/08/98

 ;;APCDTUNI|1101|units|2003|||

 ;;APCDTORD|1102|order number|1103||

 ;;APCDTSTE|1103|site/specimen|2004|^LAB(61,|

 ;;APCDTRFL|1104|reference low|2008||

 ;;APCDTRFH|1105|reference high|2009||

 ;;APCDTCOS|1110|lab test cost|108||

 ;;APCDTLNC|1113|loinc code|1310||VNOACT||  ;IHS/ITSC/TPF 07/01/03 ADD "||" **1017**

 ;;APCDTCLS|1114|collection sample|1307||VNOACT||  ;IHS/ITSC/TPF 07/01/03 ADD "||" **1017**

 ;;APCDTCDT|1201|date/time collected|1201||

 ;;APCDTPRV|1202|ordering provider ien|1104||VPROV

 ;;APCDTEPR|1204|encounter provider ien|113||VPROV

 ;;APCDTOPR|1210|outside provider name|1105 or 114||

 ;;APCDTRDT|1212|result date and time|1309||VNOACT||  ;IHS/ITSC/TPF 07/01/03 ADD "||" **1017**

 ;;APCDTLC1|1301|free text comment 1|3001||

 ;;APCDTLC2|1302|free text comment 2|3001||

 ;;APCDTLC3|1303|free text comment 3|3001||

 ;;APCDTCPS|1402|cpt string|201||

 ;

 Q

REQMSG ;creation of required field message

 S BLRBUL=2,BLRPCC="Field "_BLRTLOG_" is required for PCC and cannot be null"

 Q

 ;

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1019 IHS

 ;      This routine tries to determine if the error message should

 ;      reflect an unsuccessful update to either a deleted PCC visit or

 ;      a merged PCC visit or other non-reported incidents.

BLRPCCVE     ;

 ; Variables are being NEWed so as to make sure no interference

 ; occurs with other LAB routines.

 ;  

 NEW PTPTR,ORDERDT,COLLDT,ACC,DFN

 NEW BLRVDELF,BLRVMERF,COLLDTF,IHSVXF,PCCVDMF,PCCVIS

 NEW IHSVXF

 ;

 Q:BLRLOGDA=""                                   ; If no transaction #, quit

 ;

 S PTPTR=$P($G(^BLRTXLOG(BLRLOGDA,0)),"^",4)     ; Patient Pointer Value

 S ORDERDT=$P($G(^BLRTXLOG(BLRLOGDA,11)),"^",1)  ; Order Date/Time

 S COLLDT=$P($G(^BLRTXLOG(BLRLOGDA,12)),"^",1)   ; Collection Date/Time

 S ACC=$P($G(^BLRTXLOG(BLRLOGDA,12)),"^",2)      ; Accession Number

 S DFN=PTPTR_$P(ORDERDT,".",1)                   ; Pointer to PCC Visit

 ;

 ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1021 - Wrong. It should never be reported.

 ; An issue that is not reported correctly.

 ; I COLLDT<ORDERDT D  Q

 ; . S BLRPCC=""

 ; . S BLRPCC="Collection Date is LESS THAN Ordering Date."

 ; S BLRBUL=2

 ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 ;

 I $G(DFN)="" Q                   ; If no PCC Visit pointer, quit

 ;

 ; Initialize variables

 S (BLRVDELF,BLRVMERF,COLLDTF,IHSVXF,PCCVDMF,PCCVIS)=""

 ;

 S IHSVXF=$O(^LRO(68.999999901,"B",DFN,IHSVXF))       ; PCC Visit X-Ref

 I IHSVXF="" D                                        ; If can't find PCC Visit

 . S DFN=PTPTR_$P(COLLDT,".",1)                       ; use Collect Date to try

 . S IHSVXF=$O(^LRO(68.999999901,"B",DFN,IHSVXF))     ; to get PCC Visit #

 . I IHSVXF'="" S COLLDTF="*"                         ; If Coll Date, Set Flag

 ;

 I IHSVXF="" Q                                        ; If still null, quit

 ;

 S PCCVIS=$P($G(^LRO(68.999999901,IHSVXF,0)),"^",2)   ; PCC Visit #

 S BLRVDELF=$P($G(^AUPNVSIT(PCCVIS,0)),"^",11)        ; Visit Del Flag

 I BLRVDELF'="" S PCCVDMF="D"                         ; Deleted

 S BLRVMERF=$P($G(^AUPNVSIT(PCCVIS,0)),"^",37)        ; Merged to Visit #

 I BLRVMERF'="" S PCCVDMF="M"                         ; Merged

 ;

 ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 ;      The BLRPCC string could be over 60 characters in length,

 ;      which is too long for the PCC ERROR FLAG field in the

 ;      IHS LAB TRANSACTION LOG file.  It has been changed.

 I PCCVDMF="M" D  Q

 . S BLRPCC="PCC Visit "_PCCVIS

 . S BLRPCC=BLRPCC_" has been merged to "_BLRVMERF_"."

 . S BLRBUL=2

 ;

 I PCCVDMF="D" D

 . S BLRPCC="PCC Visit "_PCCVIS_" has been deleted."

 . S BLRBUL=2

 ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 ;

 Q

 ;----- END IHS MODIFICATIONS LR*5.2*1019 IHS

BLRLINKP  ; IHS/DIR/FJE - VALIDATION OF VARIOUS V FILE FIELDS ; 22-Oct-2013 09:22 ; MKK

 +1       ;;5.2;IHS LABORATORY;**1001,1015,1017,1018,1019,1021,1025,1033**;NOV 01, 1997

 +2       ;

 +3       ; The following is post-validation logic for the fields in the various

 +4       ; V files 9000010.09 (^AUPNVLAB,^AUPNVMIC,^AUPNVBB, etc.).  It is

 +5       ; called by the linkage process and will be executed ONLY if the PCC

 +6       ; process rejects the write to the V file (PCC error  1 or 2).

 +7       ; The functionality of this procedure is to interpret the reason of

 +8       ; the V file edit rejection and store the error reason in field 106

 +9       ; of file 9009022.

 +10      ; NOTE:  Field 106 = PCC ERROR FLAG;

 +11      ;        File 9009022 = IHS LAB TRANSACTION FILE (the ^BLRTXLOG global)

 +12      ;

 +13      ;

 +14      ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER ^BLRLINKP")

 +15      ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("ENTER ^BLRLINKP")

 +16       SET ALRCHKIP=""

           SET BLRLINK=1

           SET BLRCHQ=0

 +17       FOR T=1:1

               SET BLRTXT=$TEXT(PARSE+T)

               SET BLRSTR=$PIECE(BLRTXT,";",3)

               IF BLRSTR=""!(BLRCHQ)

                   QUIT 

               DO BLDFLD

               IF $DATA(APCDALVR(BLRNAME))

                   IF BLRSS1[BLRSS!(BLRSS1="")

                       Begin DoDot:1

 +18                       SET X=APCDALVR(BLRNAME)

 +19                       IF 'BLRQUIET

                               DO FLDSCHK

                               IF BLRCHQ

                                   QUIT 

 +20                       SET BLRVSUB=$SELECT(BLRVSUB'="":BLRVSUB,1:"TRANS")

 +21                       DO @BLRVSUB

 +22                       IF '$DATA(X)

                               IF 'BLRQUIET

                                   WRITE !,BLRLIT_" failed edit in V file"

                               Begin DoDot:2

 +23                               IF BLRPCC=""

                                       SET BLRBUL=2

                                       SET BLRPCC="Field "_BLRTLOG_" of file 9009022 is invalid"

                               End DoDot:2

                       End DoDot:1

 +24      ;----- BEGIN IHS MODIFICATIONS LR*5.2*1019 IHS

 +25      ; Determine if update to deleted or merged visit caused Error IFF Error Message blank

 +26       IF BLRPCC=""

               DO BLRPCCVE

 +27      ;----- END IHS MODIFICATIONS LR*5.2*1019 IHS

 +28      ; generic reject message created when specific PCC rejection not determined

 +29       IF BLRPCC=""

               SET BLRBUL=2

               SET BLRPCC="Write to "_$PIECE($GET(^DIC(BLRVFILE,0)),U)_" file rejected"

 +30      ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EXIT ^BLRLINKP")

 +31      ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("EXIT ^BLRLINKP")

 +32       KILL BLRTXT,BLRSTR,BLRNAME,BLRVFLD,BLRLIT,BLRTLOG,BLRROOT,BLRPMSG,BLRVPRV,BLRVSUB,BLRCHQ

 +33       QUIT 

 +34      ;

BLDFLD    ; create BLR variables from BLRSTR

 +1       ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER BLDFLD^BLRLINKP")

 +2       ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("ENTER BLDFLD^BLRLINKP")

 +3        SET BLRNAME=$PIECE(BLRSTR,"|")

           SET BLRVFLD=$PIECE(BLRSTR,"|",2)

           SET BLRLIT=$PIECE(BLRSTR,"|",3)

           SET BLRTLOG=$PIECE(BLRSTR,"|",4)

           SET BLRROOT=$PIECE(BLRSTR,"|",5)

           SET BLRVSUB=$PIECE(BLRSTR,"|",6)

           SET BLRSS1=$PIECE(BLRSTR,"|",7)

           IF BLRTLOG=""

               SET BLRTLOG=BLRLIT

 +4        QUIT 

 +5       ;

 +6       ;

TRANS     ; perform input transform found in file in DD for appropriate V file

 +1       ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER TRANS^BLRLINKP")

 +2       ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("ENTER TRANS^BLRLINKP")

 +3        IF APCDALVR(BLRNAME)=""

               QUIT 

 +4        SET (DIE,DIC)=BLRROOT

           SET DIC(0)=""

 +5       ;INPUT TRANSFORM

           XECUTE $PIECE(^DD(BLRVFILE,BLRVFLD,0),U,5,99)

 +6        QUIT 

 +7       ;

VTEST     ; validation on required TEST field

 +1       ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER VTEST^BLRLINKP")

 +2       ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("ENTER VTEST^BLRLINKP")

 +3        IF APCDALVR(BLRNAME)=""

               DO REQMSG

               KILL X

               QUIT 

 +4        SET APCDALVR(BLRNAME)=$PIECE(APCDALVR(BLRNAME),"`",2)

 +5        IF '$DATA(^LAB(60,APCDALVR(BLRNAME)))

               SET BLRBUL=2

               SET BLRPCC="Field "_BLRTLOG_" of file 9009022 not a valid test in file 60"

               KILL X

 +6        QUIT 

 +7       ;

VVSIT     ; validation on required VISIT field

 +1       ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER VVSIT^BLRLINKP")

 +2       ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("ENTER VVSIT^BLRLINKP")

 +3        IF APCDALVR(BLRNAME)=""

               DO REQMSG

               KILL X

               QUIT 

 +4        IF APCDALVR(BLRNAME)'?1N.N

               SET BLRBUL=2

               SET BLRPCC=BLRNAME_" needs to be all numeric"

               KILL X

               QUIT 

 +5       ; I '$D(^AUPNVSIT(APCDALVR(BLRNAME),0)) S BLRBUL=2,BLRPCC=BLRNAME_" not a valid visit" K X

 +6       ; ----- BEGIN IHS/OIT/MKK -- LR*5.2*1025 -- Need a QUIT if this error exists

 +7        IF '$DATA(^AUPNVSIT(APCDALVR(BLRNAME),0))

               SET BLRBUL=2

               SET BLRPCC=BLRNAME_" not a valid visit"

               KILL X

               QUIT 

 +8       ; ----- END IHS/OIT/MKK -- LR*5.2*1025 -- Need a QUIT if this error exists

 +9        IF 'BLRVIEN

               QUIT 

 +10       SET (DIE,DIC)=BLRROOT

           SET DIC(0)=""

 +11      ;INPUT TRANSFORM

           XECUTE $PIECE(^DD(BLRVFILE,BLRVFLD,0),U,5,99)

 +12       QUIT 

 +13      ;

VANTIB    ; validation on antibiotic field for Micro or

 +1       ; antibody field for blood bank

 +2       ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER VANTIB^BLRLINKP")

 +3       ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("ENTER VANTIB^BLRLINKP")

 +4        IF APCDALVR(BLRNAME)=""

               QUIT 

 +5        IF $EXTRACT(APCDALVR(BLRNAME))="`"

               SET APCDALVR(BLRNAME)=$PIECE(APCDALVR(BLRNAME),"`",2)

 +6        IF BLRSS="MI"

               IF '$DATA(^LAB(62.06,APCDALVR(BLRNAME)))

                   SET BLRBUL=2

                   SET BLRPCC="Field "_BLRTLOG_" of file 9009022 not a valid antibiotic IEN"

                   KILL X

                   QUIT 

 +7        IF BLRSS="BB"

               IF '$DATA(^LAB(61.3,APCDALVR(BLRNAME)))

                   SET BLRBUL=2

                   SET BLRPCC="Field "_BLRTLOG_" of file 9009022 not a valid antibody IEN"

                   KILL X

 +8        QUIT 

 +9       ;

VPROV     ; validation of provider field

 +1       ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER VPROV^BLRLINKP")

 +2       ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("ENTER VPROV^BLRLINKP")

 +3        IF $GET(APCDALVR(BLRNAME))=""

               QUIT 

 +4       ; S BLRPMSG="Field "_BLRTLOG_" of file 9009022 not in Provider file"

 +5       ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 +6        SET BLRPMSG="Field "_BLRTLOG_" of file 9009022 not in NEW PERSON file"

 +7       ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 +8        SET BLRVPRV=BLROPRV

 +9        IF BLRVPRV=""

               SET BLRBUL=2

               SET BLRPCC=BLRPMSG

               KILL X

               QUIT 

 +10      ;cmi/maw 1/8/2002**1015**

           IF $GET(BLR200CV)]""

               IF '$DATA(^VA(200,BLRVPRV))

                   Begin DoDot:1

 +11      ;cmi/maw 1/8/2002 **1015**

                       SET BLRBUL=2

                       SET BLRPCC=BLRPMSG

                       KILL X

                   End DoDot:1

                   QUIT 

 +12      ; I '$D(^DIC(6,BLRVPRV)) S BLRBUL=2,BLRPCC=BLRPMSG K X

 +13      ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 +14      ;      If the provider is in dictionary 200, it DOES NOT matter if the

 +15      ;      provider is not in dictionary 6.

 +16       SET BLRPMSG="Field "_BLRTLOG_" of file 9009022 not in PROVIDER file"

 +17       IF '$DATA(^DIC(6,BLRVPRV))&('$DATA(^VA(200,BLRVPRV)))

               SET BLRBUL=2

               SET BLRPCC=BLRPMSG

               KILL X

 +18      ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 +19       QUIT 

 +20      ;

 +21      ;no action taken at this time

VNOACT    ;

 +1        QUIT 

FLDSCHK   ;

 +1       ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER FLDSCHK^BLRLINKP")

 +2       ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("ENTER FLDSCHK^BLRLINKP")

 +3        DO CHK^DIE(BLRVFILE,BLRVFLD,"E",APCDALVR(BLRNAME),.BLRCHK)

 +4        IF BLRCHK="^"

               WRITE !,APCDALVR(BLRNAME)_" value is invalid for field "_BLRLIT_" "_BLRVFLD_" in file "_BLRVFILE,!

               SET BLRCHQ=1

 +5        KILL BLRCHK

 +6        QUIT 

 +7       ;

PARSE     ;;subscript name|field # for appropriate V file |literal desc|field # for file #9009022|global root|validation subroutine

 +1       ;;APCDTLAB|.01|lab test|.06||VTEST|

 +2       ;;APCDVSIT|.03|Visit IEN||^AUPNVSIT(|VVSIT|

 +3       ;;APCDTRES|.04|result text|2001|||BB,CH

 +4       ;;APCDTABN|.05|Normal flag|2002|||CH

 +5       ;;APCDTANT|.05|antibiotic|1303||VANTIB|MI

 +6       ;;APCDTANT|.05|antibody|1403||VANTIB|BB

 +7       ;;APCDTACC|.06|Acc #|1202|||

 +8       ;;APCDTRES|.07|blood bank test name|1402|||BB

 +9       ;;APCDTCOL|.08|collection sample|1307|||MI  ;IHS/DIR TUC/AAB 04/08/98

 +10      ;;APCDTCMD|.09|complete date|1309|||MI  ;IHS/DIR TUC/AAB 04/08/98

 +11      ;;APCDTUNI|1101|units|2003|||

 +12      ;;APCDTORD|1102|order number|1103||

 +13      ;;APCDTSTE|1103|site/specimen|2004|^LAB(61,|

 +14      ;;APCDTRFL|1104|reference low|2008||

 +15      ;;APCDTRFH|1105|reference high|2009||

 +16      ;;APCDTCOS|1110|lab test cost|108||

 +17      ;;APCDTLNC|1113|loinc code|1310||VNOACT||  ;IHS/ITSC/TPF 07/01/03 ADD "||" **1017**

 +18      ;;APCDTCLS|1114|collection sample|1307||VNOACT||  ;IHS/ITSC/TPF 07/01/03 ADD "||" **1017**

 +19      ;;APCDTCDT|1201|date/time collected|1201||

 +20      ;;APCDTPRV|1202|ordering provider ien|1104||VPROV

 +21      ;;APCDTEPR|1204|encounter provider ien|113||VPROV

 +22      ;;APCDTOPR|1210|outside provider name|1105 or 114||

 +23      ;;APCDTRDT|1212|result date and time|1309||VNOACT||  ;IHS/ITSC/TPF 07/01/03 ADD "||" **1017**

 +24      ;;APCDTLC1|1301|free text comment 1|3001||

 +25      ;;APCDTLC2|1302|free text comment 2|3001||

 +26      ;;APCDTLC3|1303|free text comment 3|3001||

 +27      ;;APCDTCPS|1402|cpt string|201||

 +28      ;

 +29       QUIT 

REQMSG    ;creation of required field message

 +1        SET BLRBUL=2

           SET BLRPCC="Field "_BLRTLOG_" is required for PCC and cannot be null"

 +2        QUIT 

 +3       ;

 +4       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1019 IHS

 +5       ;      This routine tries to determine if the error message should

 +6       ;      reflect an unsuccessful update to either a deleted PCC visit or

 +7       ;      a merged PCC visit or other non-reported incidents.

BLRPCCVE  ;

 +1       ; Variables are being NEWed so as to make sure no interference

 +2       ; occurs with other LAB routines.

 +3       ;  

 +4        NEW PTPTR,ORDERDT,COLLDT,ACC,DFN

 +5        NEW BLRVDELF,BLRVMERF,COLLDTF,IHSVXF,PCCVDMF,PCCVIS

 +6        NEW IHSVXF

 +7       ;

 +8       ; If no transaction #, quit

           IF BLRLOGDA=""

               QUIT 

 +9       ;

 +10      ; Patient Pointer Value

           SET PTPTR=$PIECE($GET(^BLRTXLOG(BLRLOGDA,0)),"^",4)

 +11      ; Order Date/Time

           SET ORDERDT=$PIECE($GET(^BLRTXLOG(BLRLOGDA,11)),"^",1)

 +12      ; Collection Date/Time

           SET COLLDT=$PIECE($GET(^BLRTXLOG(BLRLOGDA,12)),"^",1)

 +13      ; Accession Number

           SET ACC=$PIECE($GET(^BLRTXLOG(BLRLOGDA,12)),"^",2)

 +14      ; Pointer to PCC Visit

           SET DFN=PTPTR_$PIECE(ORDERDT,".",1)

 +15      ;

 +16      ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1021 - Wrong. It should never be reported.

 +17      ; An issue that is not reported correctly.

 +18      ; I COLLDT<ORDERDT D  Q

 +19      ; . S BLRPCC=""

 +20      ; . S BLRPCC="Collection Date is LESS THAN Ordering Date."

 +21      ; S BLRBUL=2

 +22      ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 +23      ;

 +24      ; If no PCC Visit pointer, quit

           IF $GET(DFN)=""

               QUIT 

 +25      ;

 +26      ; Initialize variables

 +27       SET (BLRVDELF,BLRVMERF,COLLDTF,IHSVXF,PCCVDMF,PCCVIS)=""

 +28      ;

 +29      ; PCC Visit X-Ref

           SET IHSVXF=$ORDER(^LRO(68.999999901,"B",DFN,IHSVXF))

 +30      ; If can't find PCC Visit

           IF IHSVXF=""

               Begin DoDot:1

 +31      ; use Collect Date to try

                   SET DFN=PTPTR_$PIECE(COLLDT,".",1)

 +32      ; to get PCC Visit #

                   SET IHSVXF=$ORDER(^LRO(68.999999901,"B",DFN,IHSVXF))

 +33      ; If Coll Date, Set Flag

                   IF IHSVXF'=""

                       SET COLLDTF="*"

               End DoDot:1

 +34      ;

 +35      ; If still null, quit

           IF IHSVXF=""

               QUIT 

 +36      ;

 +37      ; PCC Visit #

           SET PCCVIS=$PIECE($GET(^LRO(68.999999901,IHSVXF,0)),"^",2)

 +38      ; Visit Del Flag

           SET BLRVDELF=$PIECE($GET(^AUPNVSIT(PCCVIS,0)),"^",11)

 +39      ; Deleted

           IF BLRVDELF'=""

               SET PCCVDMF="D"

 +40      ; Merged to Visit #

           SET BLRVMERF=$PIECE($GET(^AUPNVSIT(PCCVIS,0)),"^",37)

 +41      ; Merged

           IF BLRVMERF'=""

               SET PCCVDMF="M"

 +42      ;

 +43      ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 +44      ;      The BLRPCC string could be over 60 characters in length,

 +45      ;      which is too long for the PCC ERROR FLAG field in the

 +46      ;      IHS LAB TRANSACTION LOG file.  It has been changed.

 +47       IF PCCVDMF="M"

               Begin DoDot:1

 +48               SET BLRPCC="PCC Visit "_PCCVIS

 +49               SET BLRPCC=BLRPCC_" has been merged to "_BLRVMERF_"."

 +50               SET BLRBUL=2

               End DoDot:1

               QUIT 

 +51      ;

 +52       IF PCCVDMF="D"

               Begin DoDot:1

 +53               SET BLRPCC="PCC Visit "_PCCVIS_" has been deleted."

 +54               SET BLRBUL=2

               End DoDot:1

 +55      ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1021

 +56      ;

 +57       QUIT 

 +58      ;----- END IHS MODIFICATIONS LR*5.2*1019 IHS