- BLRLINKR ; IHS/DIR/FJE - VALIDATION OF VARIOUS V FILE FIELDS ; [ 07/30/2002 9:42 AM ]
- ;;5.2;BLR;**1001**;FEB 1, 1998
- ;
- ; 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.
- ;
- ;
- 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"
- ; generic reject message created when specific PCC rejection not determined
- S:BLRPCC="" BLRBUL=2,BLRPCC="Write to "_$P(^DIC(BLRVFILE,0),U)_" file rejected"
- K BLRTXT,BLRSTR,BLRNAME,BLRVFLD,BLRLIT,BLRTLOG,BLRROOT,BLRPMSG,BLRVPRV,BLRVSUB,BLRCHQ
- Q
- BLDFLD ; create BLR variables from BLRSTR
- 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
- Q:APCDALVR(BLRNAME)=""
- S (DIE,DIC)=BLRROOT,DIC(0)=""
- X $P(^DD(BLRVFILE,BLRVFLD,0),U,5,99)
- Q
- ;
- VTEST ; validation on required TEST field
- 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
- 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
- Q:'BLRVIEN
- S (DIE,DIC)=BLRROOT,DIC(0)=""
- X $P(^DD(BLRVFILE,BLRVFLD,0),U,5,99)
- Q
- ;
- VANTIB ; validation on antibiotic field for Micro or
- ; antibody field for blood bank
- 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 ;
- Q:$G(APCDALVR(BLRNAME))=""
- S BLRPMSG="Field "_BLRTLOG_" of file 9009022 not in Provider file"
- ;I $P(^VA(200,$P(X,"`",2),0),"^",16)="" S BLRBUL=2,BLRPCC=BLRPMSG K X Q
- S BLRVPRV=BLROPRV
- I BLRVPRV="" S BLRBUL=2,BLRPCC=BLRPMSG K X Q
- I '$D(^DIC(6,BLRVPRV)) S BLRBUL=2,BLRPCC=BLRPMSG K X
- Q
- FLDSCHK ;
- 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||
- ;;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||
- ;;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
- BLRLINKR ; IHS/DIR/FJE - VALIDATION OF VARIOUS V FILE FIELDS ; [ 07/30/2002 9:42 AM ]
- +1 ;;5.2;BLR;**1001**;FEB 1, 1998
- +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 ;
- +11 ;
- +12 SET ALRCHKIP=""
- SET BLRLINK=1
- SET BLRCHQ=0
- +13 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
- +14 SET X=APCDALVR(BLRNAME)
- +15 IF 'BLRQUIET
- DO FLDSCHK
- IF BLRCHQ
- QUIT
- +16 SET BLRVSUB=$SELECT(BLRVSUB'="":BLRVSUB,1:"TRANS")
- +17 DO @BLRVSUB
- +18 IF '$DATA(X)
- IF 'BLRQUIET
- WRITE !,BLRLIT_" failed edit in V file"
- Begin DoDot:2
- +19 IF BLRPCC=""
- SET BLRBUL=2
- SET BLRPCC="Field "_BLRTLOG_" of file 9009022 is invalid"
- End DoDot:2
- End DoDot:1
- +20 ; generic reject message created when specific PCC rejection not determined
- +21 IF BLRPCC=""
- SET BLRBUL=2
- SET BLRPCC="Write to "_$PIECE(^DIC(BLRVFILE,0),U)_" file rejected"
- +22 KILL BLRTXT,BLRSTR,BLRNAME,BLRVFLD,BLRLIT,BLRTLOG,BLRROOT,BLRPMSG,BLRVPRV,BLRVSUB,BLRCHQ
- +23 QUIT
- BLDFLD ; create BLR variables from BLRSTR
- +1 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
- +2 QUIT
- +3 ;
- TRANS ; perform input transform found in file in DD for appropriate V file
- +1 IF APCDALVR(BLRNAME)=""
- QUIT
- +2 SET (DIE,DIC)=BLRROOT
- SET DIC(0)=""
- +3 XECUTE $PIECE(^DD(BLRVFILE,BLRVFLD,0),U,5,99)
- +4 QUIT
- +5 ;
- VTEST ; validation on required TEST field
- +1 IF APCDALVR(BLRNAME)=""
- DO REQMSG
- KILL X
- QUIT
- +2 SET APCDALVR(BLRNAME)=$PIECE(APCDALVR(BLRNAME),"`",2)
- +3 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
- +4 QUIT
- VVSIT ; validation on required VISIT field
- +1 IF APCDALVR(BLRNAME)=""
- DO REQMSG
- KILL X
- QUIT
- +2 IF APCDALVR(BLRNAME)'?1N.N
- SET BLRBUL=2
- SET BLRPCC=BLRNAME_" needs to be all numeric"
- KILL X
- QUIT
- +3 IF '$DATA(^AUPNVSIT(APCDALVR(BLRNAME),0))
- SET BLRBUL=2
- SET BLRPCC=BLRNAME_" not a valid visit"
- KILL X
- +4 IF 'BLRVIEN
- QUIT
- +5 SET (DIE,DIC)=BLRROOT
- SET DIC(0)=""
- +6 XECUTE $PIECE(^DD(BLRVFILE,BLRVFLD,0),U,5,99)
- +7 QUIT
- +8 ;
- VANTIB ; validation on antibiotic field for Micro or
- +1 ; antibody field for blood bank
- +2 IF APCDALVR(BLRNAME)=""
- QUIT
- +3 IF $EXTRACT(APCDALVR(BLRNAME))="`"
- SET APCDALVR(BLRNAME)=$PIECE(APCDALVR(BLRNAME),"`",2)
- +4 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
- +5 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
- +6 QUIT
- +7 ;
- VPROV ;
- +1 IF $GET(APCDALVR(BLRNAME))=""
- QUIT
- +2 SET BLRPMSG="Field "_BLRTLOG_" of file 9009022 not in Provider file"
- +3 ;I $P(^VA(200,$P(X,"`",2),0),"^",16)="" S BLRBUL=2,BLRPCC=BLRPMSG K X Q
- +4 SET BLRVPRV=BLROPRV
- +5 IF BLRVPRV=""
- SET BLRBUL=2
- SET BLRPCC=BLRPMSG
- KILL X
- QUIT
- +6 IF '$DATA(^DIC(6,BLRVPRV))
- SET BLRBUL=2
- SET BLRPCC=BLRPMSG
- KILL X
- +7 QUIT
- FLDSCHK ;
- +1 DO CHK^DIE(BLRVFILE,BLRVFLD,"E",APCDALVR(BLRNAME),.BLRCHK)
- +2 IF BLRCHK="^"
- WRITE !,APCDALVR(BLRNAME)_" value is invalid for field "_BLRLIT_" "_BLRVFLD_" in file "_BLRVFILE,!
- SET BLRCHQ=1
- +3 KILL BLRCHK
- +4 QUIT
- +5 ;
- 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 ;;APCDTCDT|1201|date/time collected|1201||
- +18 ;;APCDTPRV|1202|ordering provider ien|1104||VPROV
- +19 ;;APCDTEPR|1204|encounter provider ien|113||VPROV
- +20 ;;APCDTOPR|1210|outside provider name|1105 or 114||
- +21 ;;APCDTLC1|1301|free text comment 1|3001||
- +22 ;;APCDTLC2|1302|free text comment 2|3001||
- +23 ;;APCDTLC3|1303|free text comment 3|3001||
- +24 ;;APCDTCPS|1402|cpt string|201||
- +25 ;
- +26 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
