BVCHK ; IHS/ITSC/JDH - check field values in files 3,6,16 & 200
;;2.0;IHS V FILES 200 CONVERSION;;MAR 29, 2002
;
W !!,"This routine can not be called from the top",!!
Q
;
EN ;EP non setting, checks file status only;
I $D(^BVCONV(1,"RUNNING")) W !,"The conversion is in progress, Please do not run this routine."
I $G(DUZ(0))'["@" W !!,"You must have fileman programmer access to run this routine.",!! Q
Q:$$DEV
EN1 N BVC3,BVC6,BVC16,BVCDA,BVCDAFH,BVCDAFR,BVCDAH,BVCDATA,BVCERH,BVCERMS,BVCERNM,BVCFDFR,BVCFDH,BVCFDNM,BVCFDTO,BVCFLFR,BVCFLH,BVCFREX,BVCORD
N BVCFRIN,BVCFROM,BVCGLB,BVCGLBH,BVCGLFR,BVCHK,BVCNDFR,BVCNDTO,BVCNMMT,BVCNODE,BVCOK,BVCPCFR,BVCPCTO,BVCPRPT,BVCROOT,BVCSFTD,BVCTO,BVCTOEX,BVCTONM
D INIT
D AVAPCHK
D COMPILE
D:'POP RPT
I BVCHK,'$$CONV S ^BVCHK(1,"OK")="" W !!,"The PCC Conversion may now be run."
I +$$VERSION^XPDUTL("BVC")=2,$L($T(^BVCONV1)) W !,"D EN^BVCONV when you are ready",!!
K ^XTMP("BVCHK")
Q
;
CONV() ; conversion already done message
N BVCFLG S BVCFLG=0
I $P(^DD(9000001,.14,0),U,3)="VA(200,0" W !!,"The conversion appears to already be complete." S BVCFLG=1
Q BVCFLG
;
AVAPCHK ; run ^AVAPCHK
D EN^AVAPCHK
Q
;
COMPILE ; check files
U IO W !,"PRE-CONVERSION STATUS REPORT",!
F BVCROOT="BVC3(","BVC6(","BVC16(" Q:POP D
.S BVCDA=0
.S BVCFLFR=+$E(BVCROOT,4,5)
.Q:'$D(@("BVC"_BVCFLFR))
.S BVCGLFR="^DIC("_BVCFLFR_","
.; loop through ^DIC(
.S BVCDAFR=0
.F S BVCDAFR=$O(@(BVCGLFR_BVCDAFR_")")) Q:'BVCDAFR!POP D ; get from file IEN
..W "." S BVCDATO=+$S(BVCFLFR>3:$G(^DIC(16,BVCDAFR,"A3")),BVCFLFR=3:BVCDAFR,1:0) ; get ^VA 200 pointer through crosswalk . to file IEN
..S BVCORD=0,BVCFDTO=0,BVCFDNM=""
..I 'BVCDATO,BVCFLFR>3 D Q
...S BVCERMS="NO PERSON FILE ""A3"" NODE"
...W !!,"Comparing file "_BVCFLFR_" entry: "_BVCDAFR_" to file 200 entry "_BVCDATO W !!,BVCERMS
...S BVCDATO=BVCDAFR D BLD(1,"","") S BVCOK=0
..S BVCPRPT=$P($G(^VA(200,BVCDATO,0)),U,16) ;get backpointer for comparison
..I BVCPRPT,BVCPRPT'=BVCDAFR S BVCERMS="PERSON FILE PTR ERROR" D BLD(8,BVCPRPT,BVCDATO)
..; get field correspondences and verify match
..S BVCNODE=0
..F S BVCNODE=$O(@(BVCROOT_BVCNODE_")")) Q:'BVCNODE!POP D
...I IOSL-4<$Y D HDR0 Q:POP
...S BVCDATA=@(BVCROOT_BVCNODE_")")
...S BVCFDFR=$P(BVCDATA,U,2)
...S BVCFDTO=$P(BVCDATA,U,3)
...S BVCFDNM=$P(BVCDATA,U)
...S BVCORD=$P(BVCDATA,U,4)
...;W !?3,"Checking the "_BVCFDNM_" field"
...; get node and piece
...S BVCFROM=$P(^DD(BVCFLFR,BVCFDFR,0),U,4)
...S BVCTO=$P(^DD(200,BVCFDTO,0),U,4)
...S BVCNDFR=$P(BVCFROM,";"),BVCPCFR=$P(BVCFROM,";",2)
...S BVCNDTO=$P(BVCTO,";"),BVCPCTO=$P(BVCTO,";",2)
...; get field values
...S BVCFRIN=$P($G(@(BVCGLFR_BVCDAFR_","_BVCNDFR_")")),U,BVCPCFR) ;from file field data
...S BVCFREX=$$VAL^XBDIQ1(BVCGLFR,BVCDAFR,BVCFDFR)
...S BVCTOEX=$$VAL^XBDIQ1(200,BVCDATO,BVCFDTO)
...I BVCFDFR=.01 D
....S BVCTONM=BVCTOEX
....I $L($G(BVCTOEX)) N I,J S I=0 F J=0:1 S I=$O(^VA(200,"B",BVCTOEX,I)) Q:I="" I J,I S BVCERMS="DUPLICATE NAMES" D BLD(7,BVCFREX,BVCTOEX) Q
...I BVCFDNM="PROVIDER CLASS",$L($G(BVCTONM)),'$D(^VA(200,"AK.PROVIDER",BVCTONM,BVCDATO)) D AKPROV
...; compare values
...I BVCFREX'=BVCTOEX,$L(BVCFREX) D
....W:BVCDAFR'=$G(BVCDAFH) !!,"Comparing file "_BVCFLFR_" entry: "_BVCDAFR_" to file 200 entry "_BVCDATO S BVCDAFH=BVCDAFR
....I BVCFDFR=.01 S BVCNMMT=1,BVCERMS="NAME MISMATCH" D BLD(2,BVCFREX,BVCTOEX)
....W !?3,"The "_BVCFDNM_" field does not match to file 200"
....W !?5,"From value: "_BVCFREX,?40,"To value: "_BVCTOEX
....I '$L(BVCTOEX),BVCFDNM'="PROVIDER CLASS",'BVCNMMT Q:$$STUFF
....I BVCFDFR'=.01 D
.....I BVCNMMT D BLD1 Q
.....S BVCERMS="DATA MISMATCH" D BLD(4,BVCFREX,BVCTOEX)
..S BVCNMMT=0
Q
;
STUFF() ; put file 6 data in correspoding empty file 200 field
N DIE,DR,DA,X
W !?7,"Stuffing the field in file 200 with the value of "_BVCFREX
I BVCFDNM="DEA#" D
.N DIE,DR,DA ; delete to avoid a duplicate
.S DIE=6,DA=BVCDAFR,DR=BVCFDFR_"///@" D ^DIE
S DIE=200,DA=BVCDATO,DR=BVCFDTO_"///"_BVCFREX D ^DIE
S BVCSFTD=$P(^VA(200,BVCDATO,BVCNDTO),U,BVCPCTO)=BVCFRIN
W !?9,"The value has "_$S(BVCSFTD:"",1:"not ")_"been stuffed"
I BVCSFTD S BVCERMS="FILE 200 VALUE CHANGE" D BLD(5,BVCFREX,BVCFREX)
Q BVCSFTD
;
INIT F I="BVC3","BVC6","BVC16" K @I D
.F J=1:1 S X=$P($T(@I+J),";;",2) Q:X="END" S @I@(J)=X
K ^XTMP("BVCHK"),^BVCHK(1,"OK")
S ^XTMP("BVCHK",0)=$$HTFM^XLFDT($H+1)_U_DT_U_"PRE-CONVERSION COMPILE"
S BVCNMMT=0,BVCHK=1
S POP=0
Q
;
BLD(BVCERNM,BVCFROM,BVCTO) ; build error global
;
S BVCDAH=BVCDAFR
S:BVCERNM=8 X=$P($G(^XTMP("BVCHK",BVCFLFR,BVCERNM,BVCDATO,BVCORD)),U,2),BVCDAFR=X_$E(",",$L(X)>0)_BVCDAFR
S ^XTMP("BVCHK",BVCFLFR,BVCERNM,BVCDATO,BVCORD)=BVCERMS_U_BVCDAFR_U_BVCFDNM_U_BVCFROM_U_BVCTO
S:BVCERNM<5 BVCHK=0
S BVCDAFR=BVCDAH
Q
;
BLD1 ; keep mismatch fields with mismatch names
S ^XTMP("BVCHK",BVCFLFR,2,BVCDATO,.01,1,BVCORD)=BVCERMS_U_BVCDAFR_U_BVCFDNM_U_BVCFREX_U_BVCTOEX
Q
;
DEV() ; get ouput device
N POP,%ZIS S %ZIS="QM"
D ^%ZIS
I 'POP,$D(IO("Q")) D S:'POP X=$$DEV
.I IO=IO(0) W !!,"You can not queue a job to the home device or a slave printer..Try again",!!,*7 Q
.S ZTDTH=$H,ZTRTN="EN1^BVCHK",ZTDESC="PRE-PCC CONVERSION CHECK" D ^%ZTLOAD I $G(ZTSK) S POP=1 W !,"The pre-PCC Conversion is task "_ZTSK
Q POP
;
RPT ; print out report
D HDR
U IO S (BVCFLFR,BVCERNM,BVCDATO,BVCFDTO,POP)=""
S (BVCFLH,BVCERH,BVCDAH,BVCFDH)=""
S BVCGLB="^XTMP(""BVCHK"",0)",BVCGLBH=$E(BVCGLB,1,13)
F S BVCGLB=$Q(@BVCGLB) Q:$E(BVCGLB,1,$L(BVCGLBH))'=BVCGLBH!POP D
.S X=@BVCGLB
.S BVCERMS=$P(X,U),BVCDAFR=$P(X,U,2),BVCFDNM=$P(X,U,3),BVCFROM=$P(X,U,4),BVCTO=$P(X,U,5)
.S BVCERNM=$P($P(BVCGLB,",",3),","),BVCDATO=$P($P(BVCGLB,",",4),",")
.I BVCERNM'=BVCERH D SUBHDR S BVCERH=BVCERNM
.W:BVCFDNM="NAME" !
.I IOSL-4<$Y D HDR,SUBHDR Q:POP
.S X=0 I BVCERNM=2,BVCFDNM'="NAME" S X=1
.W !,BVCDATO,?8,BVCDAFR,?14+X,$E(BVCFDNM,1,15-X),?30,$E(BVCFROM,1,18),?50,$E(BVCTO,1,18)
D ^%ZISC
Q
;
RTN() ; press return to continue
N POP,DIR S POP=0
I $E(IOST,1,2)="C-",ION'="HFS" S DIR(0)="E" D ^DIR S POP=$D(DIRUT)
Q POP
;
HDR ; report header
S POP=$$RTN Q:POP
W @IOF
W !!,"Field comparisons between file "_BVCFLFR_" and 200 - Categorized Listing",!!
Q
;
SUBHDR ; print subhdrs
W !!,"Category: "_BVCERMS,!!
W "200 DA",?8,"6 DA",?14,"FIELD NAME"
I BVCERNM>1 W ?30,"FILE 6 VALUE",?50,"FILE 200 VALUE"
W !
Q
HDR0 ; report header
S POP=$$RTN Q:POP
W @IOF
W !!,"Field comparisons between file "_BVCFLFR_" and 200 - Sequential Detail Listing",!!
Q
;
AKPROV ; set AK.PROVIDER xref
N BVCFLG,X S BVCFLG=0
S BVCPRKY=$O(^DIC(19.1,"B","PROVIDER",0))
S BVC51=$G(^VA(200,BVCDATO,51,BVCPRKY,0))
I BVC51 D ;no AK.PROVIDER but provider key assigned
.N DA,DIK S DA=+BVC51,DA(1)=BVCDATO
.S DIK="^VA(200,"_DA(1)_",51,",DIK(1)=".01^AC^AB^AK" D EN^DIK
I 'BVC51,$L(BVCTOEX) D ; no provider key but provider class so create the node
.N BVCFDA S BVCFDA($J,200.051,"?+2,"_BVCDATO_",",.01)="`"_BVCPRKY
.D UPDATE^DIE("E","BVCFDA($J)","BVCFDA(""ERR"")")
I $D(^VA(200,"AK.PROVIDER",BVCTONM,BVCDATO)) D
.S BVCERMS="AK.PROVIDER XREF CREATED" D BLD(6,BVCFREX,BVCTOEX)
E D
.S BVCERMS="Does not hold the Provider Key" D BLD(3,BVCFREX,BVCTOEX)
Q
;
BVC3 ; file 3 to file 200 mapping
;;END
;;NAME^0;1^0;1
;;SSN^0;2^0;2
;;END
;
BVC6 ; file 6 to file 200 mapping
;;NAME^.01^.01^0
;;INACTIVATION DATE^100^53.4^1
;;INITIALS^1^1^2
;;STREET ADDRESS 1^.111^.111^3
;;STREET ADDRESS 2^.112^.112^4
;;STREET ADDRESS 3^.113^.113^5
;;CITY^.114^.114^6
;;STATE^.115^.115^7
;;ZIP CODE^.116^.116^8
;;PROVIDER CLASS^2^53.5^9
;;AFFILIATION^9999999.01^9999999.01^10
;;CODE^9999999.02^9999999.02^11
;;IHS LOCAL CODE^9999999.05^9999999.05^11.5
;;MEDICARE PROVIDER NUMBER^9999999.06^9999999.06^12
;;MEDICAID PROVIDER NUMBER^9999999.07^9999999.07^13
;;UPIN NUMBER^9999999.08^9999999.08^14
;;DEA#^5^53.2^15
;;PROVIDER TYPE^3^53.6^16
;;VA#^6^53.3^99
;;END
;;IHS ADC INDEX^9999999.09^9999999.09
BVC16 ; file 16 to file 200 mapping
;;END
;
PRECMP ;EP precompile check
I '$D(DUZ) W !!,"You must have the variable DUZ defined" Q
I $$CONV W !,"But running this routine may identify places where correctIve action is needed."
I '$D(^BVCHK(1,"OK")) W !!,"The pre-conversion routine (EN^BVCHK) may clear up many of the exceptions you may get.",!,"Please run the pre-conversion routine before this call."
I $D(^BVCONV(0,"RUNNING")) W !!,"The conversion has already begun, so this compile is now prohibited." Q
I '$L($T(^BVCONV1)) W !,"The conversion has completed already." Q
K ^BVCONV1(1)
N BVCPRCP,BVCRUN
S BVCPRCP=1,BVCRUN=1
D PR^BVCONV
K ^BVCONV(1,"RUNNING")
Q
;
CNT ; CONVERSION FILDS AND RECORD COUNTS
N X,BVCSUB,BVCZERO,BVCGL,BVCREC,BVCCT S BVCCT=0
W !,"FILE #",?15,"ROOT",?30,"RECORD COUNT"
F BVCSUB=9000000:.01:9000099 S BVCGL=$G(^DIC(BVCSUB,0,"GL")) D:$L(BVCGL)
.S BVCZERO=@(BVCGL_0_")"),X=""
.S BVCREC=$P(BVCZERO,"^",3),X=$$PTR(BVCSUB,"DIC(6,") S:X BVCCT=BVCCT+BVCREC
.W !,BVCSUB,?15,BVCGL,?30,BVCREC,?40,X
W !!,"Total number of records to convert "_$FN(BVCCT,",")
;
Q
;
PTR(SUB,STR) ; find ptr fields
N S,RTN S RTN="",S=0
F S S=$O(^DD(SUB,S)) Q:'S D:$P($G(^DD(SUB,S,0)),"^",3)=STR
.S RTN=RTN_$E(";",RTN>0)_S
Q RTN
BVCHK ; IHS/ITSC/JDH - check field values in files 3,6,16 & 200
+1 ;;2.0;IHS V FILES 200 CONVERSION;;MAR 29, 2002
+2 ;
+3 WRITE !!,"This routine can not be called from the top",!!
+4 QUIT
+5 ;
EN ;EP non setting, checks file status only;
+1 IF $DATA(^BVCONV(1,"RUNNING"))
WRITE !,"The conversion is in progress, Please do not run this routine."
+2 IF $GET(DUZ(0))'["@"
WRITE !!,"You must have fileman programmer access to run this routine.",!!
QUIT
+3 IF $$DEV
QUIT
EN1 NEW BVC3,BVC6,BVC16,BVCDA,BVCDAFH,BVCDAFR,BVCDAH,BVCDATA,BVCERH,BVCERMS,BVCERNM,BVCFDFR,BVCFDH,BVCFDNM,BVCFDTO,BVCFLFR,BVCFLH,BVCFREX,BVCORD
+1 NEW BVCFRIN,BVCFROM,BVCGLB,BVCGLBH,BVCGLFR,BVCHK,BVCNDFR,BVCNDTO,BVCNMMT,BVCNODE,BVCOK,BVCPCFR,BVCPCTO,BVCPRPT,BVCROOT,BVCSFTD,BVCTO,BVCTOEX,BVCTONM
+2 DO INIT
+3 DO AVAPCHK
+4 DO COMPILE
+5 IF 'POP
DO RPT
+6 IF BVCHK
IF '$$CONV
SET ^BVCHK(1,"OK")=""
WRITE !!,"The PCC Conversion may now be run."
+7 IF +$$VERSION^XPDUTL("BVC")=2
IF $LENGTH($TEXT(^BVCONV1))
WRITE !,"D EN^BVCONV when you are ready",!!
+8 KILL ^XTMP("BVCHK")
+9 QUIT
+10 ;
CONV() ; conversion already done message
+1 NEW BVCFLG
SET BVCFLG=0
+2 IF $PIECE(^DD(9000001,.14,0),U,3)="VA(200,0"
WRITE !!,"The conversion appears to already be complete."
SET BVCFLG=1
+3 QUIT BVCFLG
+4 ;
AVAPCHK ; run ^AVAPCHK
+1 DO EN^AVAPCHK
+2 QUIT
+3 ;
COMPILE ; check files
+1 USE IO
WRITE !,"PRE-CONVERSION STATUS REPORT",!
+2 FOR BVCROOT="BVC3(","BVC6(","BVC16("
IF POP
QUIT
Begin DoDot:1
+3 SET BVCDA=0
+4 SET BVCFLFR=+$EXTRACT(BVCROOT,4,5)
+5 IF '$DATA(@("BVC"_BVCFLFR))
QUIT
+6 SET BVCGLFR="^DIC("_BVCFLFR_","
+7 ; loop through ^DIC(
+8 SET BVCDAFR=0
+9 ; get from file IEN
FOR
SET BVCDAFR=$ORDER(@(BVCGLFR_BVCDAFR_")"))
IF 'BVCDAFR!POP
QUIT
Begin DoDot:2
+10 ; get ^VA 200 pointer through crosswalk . to file IEN
WRITE "."
SET BVCDATO=+$SELECT(BVCFLFR>3:$GET(^DIC(16,BVCDAFR,"A3")),BVCFLFR=3:BVCDAFR,1:0)
+11 SET BVCORD=0
SET BVCFDTO=0
SET BVCFDNM=""
+12 IF 'BVCDATO
IF BVCFLFR>3
Begin DoDot:3
+13 SET BVCERMS="NO PERSON FILE ""A3"" NODE"
+14 WRITE !!,"Comparing file "_BVCFLFR_" entry: "_BVCDAFR_" to file 200 entry "_BVCDATO
WRITE !!,BVCERMS
+15 SET BVCDATO=BVCDAFR
DO BLD(1,"","")
SET BVCOK=0
End DoDot:3
QUIT
+16 ;get backpointer for comparison
SET BVCPRPT=$PIECE($GET(^VA(200,BVCDATO,0)),U,16)
+17 IF BVCPRPT
IF BVCPRPT'=BVCDAFR
SET BVCERMS="PERSON FILE PTR ERROR"
DO BLD(8,BVCPRPT,BVCDATO)
+18 ; get field correspondences and verify match
+19 SET BVCNODE=0
+20 FOR
SET BVCNODE=$ORDER(@(BVCROOT_BVCNODE_")"))
IF 'BVCNODE!POP
QUIT
Begin DoDot:3
+21 IF IOSL-4<$Y
DO HDR0
IF POP
QUIT
+22 SET BVCDATA=@(BVCROOT_BVCNODE_")")
+23 SET BVCFDFR=$PIECE(BVCDATA,U,2)
+24 SET BVCFDTO=$PIECE(BVCDATA,U,3)
+25 SET BVCFDNM=$PIECE(BVCDATA,U)
+26 SET BVCORD=$PIECE(BVCDATA,U,4)
+27 ;W !?3,"Checking the "_BVCFDNM_" field"
+28 ; get node and piece
+29 SET BVCFROM=$PIECE(^DD(BVCFLFR,BVCFDFR,0),U,4)
+30 SET BVCTO=$PIECE(^DD(200,BVCFDTO,0),U,4)
+31 SET BVCNDFR=$PIECE(BVCFROM,";")
SET BVCPCFR=$PIECE(BVCFROM,";",2)
+32 SET BVCNDTO=$PIECE(BVCTO,";")
SET BVCPCTO=$PIECE(BVCTO,";",2)
+33 ; get field values
+34 ;from file field data
SET BVCFRIN=$PIECE($GET(@(BVCGLFR_BVCDAFR_","_BVCNDFR_")")),U,BVCPCFR)
+35 SET BVCFREX=$$VAL^XBDIQ1(BVCGLFR,BVCDAFR,BVCFDFR)
+36 SET BVCTOEX=$$VAL^XBDIQ1(200,BVCDATO,BVCFDTO)
+37 IF BVCFDFR=.01
Begin DoDot:4
+38 SET BVCTONM=BVCTOEX
+39 IF $LENGTH($GET(BVCTOEX))
NEW I,J
SET I=0
FOR J=0:1
SET I=$ORDER(^VA(200,"B",BVCTOEX,I))
IF I=""
QUIT
IF J
IF I
SET BVCERMS="DUPLICATE NAMES"
DO BLD(7,BVCFREX,BVCTOEX)
QUIT
End DoDot:4
+40 IF BVCFDNM="PROVIDER CLASS"
IF $LENGTH($GET(BVCTONM))
IF '$DATA(^VA(200,"AK.PROVIDER",BVCTONM,BVCDATO))
DO AKPROV
+41 ; compare values
+42 IF BVCFREX'=BVCTOEX
IF $LENGTH(BVCFREX)
Begin DoDot:4
+43 IF BVCDAFR'=$GET(BVCDAFH)
WRITE !!,"Comparing file "_BVCFLFR_" entry: "_BVCDAFR_" to file 200 entry "_BVCDATO
SET BVCDAFH=BVCDAFR
+44 IF BVCFDFR=.01
SET BVCNMMT=1
SET BVCERMS="NAME MISMATCH"
DO BLD(2,BVCFREX,BVCTOEX)
+45 WRITE !?3,"The "_BVCFDNM_" field does not match to file 200"
+46 WRITE !?5,"From value: "_BVCFREX,?40,"To value: "_BVCTOEX
+47 IF '$LENGTH(BVCTOEX)
IF BVCFDNM'="PROVIDER CLASS"
IF 'BVCNMMT
IF $$STUFF
QUIT
+48 IF BVCFDFR'=.01
Begin DoDot:5
+49 IF BVCNMMT
DO BLD1
QUIT
+50 SET BVCERMS="DATA MISMATCH"
DO BLD(4,BVCFREX,BVCTOEX)
End DoDot:5
End DoDot:4
End DoDot:3
+51 SET BVCNMMT=0
End DoDot:2
End DoDot:1
+52 QUIT
+53 ;
STUFF() ; put file 6 data in correspoding empty file 200 field
+1 NEW DIE,DR,DA,X
+2 WRITE !?7,"Stuffing the field in file 200 with the value of "_BVCFREX
+3 IF BVCFDNM="DEA#"
Begin DoDot:1
+4 ; delete to avoid a duplicate
NEW DIE,DR,DA
+5 SET DIE=6
SET DA=BVCDAFR
SET DR=BVCFDFR_"///@"
DO ^DIE
End DoDot:1
+6 SET DIE=200
SET DA=BVCDATO
SET DR=BVCFDTO_"///"_BVCFREX
DO ^DIE
+7 SET BVCSFTD=$PIECE(^VA(200,BVCDATO,BVCNDTO),U,BVCPCTO)=BVCFRIN
+8 WRITE !?9,"The value has "_$SELECT(BVCSFTD:"",1:"not ")_"been stuffed"
+9 IF BVCSFTD
SET BVCERMS="FILE 200 VALUE CHANGE"
DO BLD(5,BVCFREX,BVCFREX)
+10 QUIT BVCSFTD
+11 ;
INIT FOR I="BVC3","BVC6","BVC16"
KILL @I
Begin DoDot:1
+1 FOR J=1:1
SET X=$PIECE($TEXT(@I+J),";;",2)
IF X="END"
QUIT
SET @I@(J)=X
End DoDot:1
+2 KILL ^XTMP("BVCHK"),^BVCHK(1,"OK")
+3 SET ^XTMP("BVCHK",0)=$$HTFM^XLFDT($HOROLOG+1)_U_DT_U_"PRE-CONVERSION COMPILE"
+4 SET BVCNMMT=0
SET BVCHK=1
+5 SET POP=0
+6 QUIT
+7 ;
BLD(BVCERNM,BVCFROM,BVCTO) ; build error global
+1 ;
+2 SET BVCDAH=BVCDAFR
+3 IF BVCERNM=8
SET X=$PIECE($GET(^XTMP("BVCHK",BVCFLFR,BVCERNM,BVCDATO,BVCORD)),U,2)
SET BVCDAFR=X_$EXTRACT(",",$LENGTH(X)>0)_BVCDAFR
+4 SET ^XTMP("BVCHK",BVCFLFR,BVCERNM,BVCDATO,BVCORD)=BVCERMS_U_BVCDAFR_U_BVCFDNM_U_BVCFROM_U_BVCTO
+5 IF BVCERNM<5
SET BVCHK=0
+6 SET BVCDAFR=BVCDAH
+7 QUIT
+8 ;
BLD1 ; keep mismatch fields with mismatch names
+1 SET ^XTMP("BVCHK",BVCFLFR,2,BVCDATO,.01,1,BVCORD)=BVCERMS_U_BVCDAFR_U_BVCFDNM_U_BVCFREX_U_BVCTOEX
+2 QUIT
+3 ;
DEV() ; get ouput device
+1 NEW POP,%ZIS
SET %ZIS="QM"
+2 DO ^%ZIS
+3 IF 'POP
IF $DATA(IO("Q"))
Begin DoDot:1
+4 IF IO=IO(0)
WRITE !!,"You can not queue a job to the home device or a slave printer..Try again",!!,*7
QUIT
+5 SET ZTDTH=$HOROLOG
SET ZTRTN="EN1^BVCHK"
SET ZTDESC="PRE-PCC CONVERSION CHECK"
DO ^%ZTLOAD
IF $GET(ZTSK)
SET POP=1
WRITE !,"The pre-PCC Conversion is task "_ZTSK
End DoDot:1
IF 'POP
SET X=$$DEV
+6 QUIT POP
+7 ;
RPT ; print out report
+1 DO HDR
+2 USE IO
SET (BVCFLFR,BVCERNM,BVCDATO,BVCFDTO,POP)=""
+3 SET (BVCFLH,BVCERH,BVCDAH,BVCFDH)=""
+4 SET BVCGLB="^XTMP(""BVCHK"",0)"
SET BVCGLBH=$EXTRACT(BVCGLB,1,13)
+5 FOR
SET BVCGLB=$QUERY(@BVCGLB)
IF $EXTRACT(BVCGLB,1,$LENGTH(BVCGLBH))'=BVCGLBH!POP
QUIT
Begin DoDot:1
+6 SET X=@BVCGLB
+7 SET BVCERMS=$PIECE(X,U)
SET BVCDAFR=$PIECE(X,U,2)
SET BVCFDNM=$PIECE(X,U,3)
SET BVCFROM=$PIECE(X,U,4)
SET BVCTO=$PIECE(X,U,5)
+8 SET BVCERNM=$PIECE($PIECE(BVCGLB,",",3),",")
SET BVCDATO=$PIECE($PIECE(BVCGLB,",",4),",")
+9 IF BVCERNM'=BVCERH
DO SUBHDR
SET BVCERH=BVCERNM
+10 IF BVCFDNM="NAME"
WRITE !
+11 IF IOSL-4<$Y
DO HDR
DO SUBHDR
IF POP
QUIT
+12 SET X=0
IF BVCERNM=2
IF BVCFDNM'="NAME"
SET X=1
+13 WRITE !,BVCDATO,?8,BVCDAFR,?14+X,$EXTRACT(BVCFDNM,1,15-X),?30,$EXTRACT(BVCFROM,1,18),?50,$EXTRACT(BVCTO,1,18)
End DoDot:1
+14 DO ^%ZISC
+15 QUIT
+16 ;
RTN() ; press return to continue
+1 NEW POP,DIR
SET POP=0
+2 IF $EXTRACT(IOST,1,2)="C-"
IF ION'="HFS"
SET DIR(0)="E"
DO ^DIR
SET POP=$DATA(DIRUT)
+3 QUIT POP
+4 ;
HDR ; report header
+1 SET POP=$$RTN
IF POP
QUIT
+2 WRITE @IOF
+3 WRITE !!,"Field comparisons between file "_BVCFLFR_" and 200 - Categorized Listing",!!
+4 QUIT
+5 ;
SUBHDR ; print subhdrs
+1 WRITE !!,"Category: "_BVCERMS,!!
+2 WRITE "200 DA",?8,"6 DA",?14,"FIELD NAME"
+3 IF BVCERNM>1
WRITE ?30,"FILE 6 VALUE",?50,"FILE 200 VALUE"
+4 WRITE !
+5 QUIT
HDR0 ; report header
+1 SET POP=$$RTN
IF POP
QUIT
+2 WRITE @IOF
+3 WRITE !!,"Field comparisons between file "_BVCFLFR_" and 200 - Sequential Detail Listing",!!
+4 QUIT
+5 ;
AKPROV ; set AK.PROVIDER xref
+1 NEW BVCFLG,X
SET BVCFLG=0
+2 SET BVCPRKY=$ORDER(^DIC(19.1,"B","PROVIDER",0))
+3 SET BVC51=$GET(^VA(200,BVCDATO,51,BVCPRKY,0))
+4 ;no AK.PROVIDER but provider key assigned
IF BVC51
Begin DoDot:1
+5 NEW DA,DIK
SET DA=+BVC51
SET DA(1)=BVCDATO
+6 SET DIK="^VA(200,"_DA(1)_",51,"
SET DIK(1)=".01^AC^AB^AK"
DO EN^DIK
End DoDot:1
+7 ; no provider key but provider class so create the node
IF 'BVC51
IF $LENGTH(BVCTOEX)
Begin DoDot:1
+8 NEW BVCFDA
SET BVCFDA($JOB,200.051,"?+2,"_BVCDATO_",",.01)="`"_BVCPRKY
+9 DO UPDATE^DIE("E","BVCFDA($J)","BVCFDA(""ERR"")")
End DoDot:1
+10 IF $DATA(^VA(200,"AK.PROVIDER",BVCTONM,BVCDATO))
Begin DoDot:1
+11 SET BVCERMS="AK.PROVIDER XREF CREATED"
DO BLD(6,BVCFREX,BVCTOEX)
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET BVCERMS="Does not hold the Provider Key"
DO BLD(3,BVCFREX,BVCTOEX)
End DoDot:1
+14 QUIT
+15 ;
BVC3 ; file 3 to file 200 mapping
+1 ;;END
+2 ;;NAME^0;1^0;1
+3 ;;SSN^0;2^0;2
+4 ;;END
+5 ;
BVC6 ; file 6 to file 200 mapping
+1 ;;NAME^.01^.01^0
+2 ;;INACTIVATION DATE^100^53.4^1
+3 ;;INITIALS^1^1^2
+4 ;;STREET ADDRESS 1^.111^.111^3
+5 ;;STREET ADDRESS 2^.112^.112^4
+6 ;;STREET ADDRESS 3^.113^.113^5
+7 ;;CITY^.114^.114^6
+8 ;;STATE^.115^.115^7
+9 ;;ZIP CODE^.116^.116^8
+10 ;;PROVIDER CLASS^2^53.5^9
+11 ;;AFFILIATION^9999999.01^9999999.01^10
+12 ;;CODE^9999999.02^9999999.02^11
+13 ;;IHS LOCAL CODE^9999999.05^9999999.05^11.5
+14 ;;MEDICARE PROVIDER NUMBER^9999999.06^9999999.06^12
+15 ;;MEDICAID PROVIDER NUMBER^9999999.07^9999999.07^13
+16 ;;UPIN NUMBER^9999999.08^9999999.08^14
+17 ;;DEA#^5^53.2^15
+18 ;;PROVIDER TYPE^3^53.6^16
+19 ;;VA#^6^53.3^99
+20 ;;END
+21 ;;IHS ADC INDEX^9999999.09^9999999.09
BVC16 ; file 16 to file 200 mapping
+1 ;;END
+2 ;
PRECMP ;EP precompile check
+1 IF '$DATA(DUZ)
WRITE !!,"You must have the variable DUZ defined"
QUIT
+2 IF $$CONV
WRITE !,"But running this routine may identify places where correctIve action is needed."
+3 IF '$DATA(^BVCHK(1,"OK"))
WRITE !!,"The pre-conversion routine (EN^BVCHK) may clear up many of the exceptions you may get.",!,"Please run the pre-conversion routine before this call."
+4 IF $DATA(^BVCONV(0,"RUNNING"))
WRITE !!,"The conversion has already begun, so this compile is now prohibited."
QUIT
+5 IF '$LENGTH($TEXT(^BVCONV1))
WRITE !,"The conversion has completed already."
QUIT
+6 KILL ^BVCONV1(1)
+7 NEW BVCPRCP,BVCRUN
+8 SET BVCPRCP=1
SET BVCRUN=1
+9 DO PR^BVCONV
+10 KILL ^BVCONV(1,"RUNNING")
+11 QUIT
+12 ;
CNT ; CONVERSION FILDS AND RECORD COUNTS
+1 NEW X,BVCSUB,BVCZERO,BVCGL,BVCREC,BVCCT
SET BVCCT=0
+2 WRITE !,"FILE #",?15,"ROOT",?30,"RECORD COUNT"
+3 FOR BVCSUB=9000000:.01:9000099
SET BVCGL=$GET(^DIC(BVCSUB,0,"GL"))
IF $LENGTH(BVCGL)
Begin DoDot:1
+4 SET BVCZERO=@(BVCGL_0_")")
SET X=""
+5 SET BVCREC=$PIECE(BVCZERO,"^",3)
SET X=$$PTR(BVCSUB,"DIC(6,")
IF X
SET BVCCT=BVCCT+BVCREC
+6 WRITE !,BVCSUB,?15,BVCGL,?30,BVCREC,?40,X
End DoDot:1
+7 WRITE !!,"Total number of records to convert "_$FNUMBER(BVCCT,",")
+8 ;
+9 QUIT
+10 ;
PTR(SUB,STR) ; find ptr fields
+1 NEW S,RTN
SET RTN=""
SET S=0
+2 FOR
SET S=$ORDER(^DD(SUB,S))
IF 'S
QUIT
IF $PIECE($GET(^DD(SUB,S,0)),"^",3)=STR
Begin DoDot:1
+3 SET RTN=RTN_$EXTRACT(";",RTN>0)_S
End DoDot:1
+4 QUIT RTN
