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
