Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BVCHK

BVCHK.m

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