AUMSCBA ;IHS/OIT/NKD - SCB UPDATE - FULL TABLE UPDATE 12/10/2013 ;
;;15.0;TABLE MAINTENANCE;**3**;SEP 9,2014;Build 1
; 03/12/14 - SPECIAL COUNTY PRE-MERGE
; - STATION NUMBER FULL UPDATE
; 05/29/15 - CLINIC FULL UPDATE
; - QUIET PARAMETER
;
; GENERAL FRAMEWORK FOR PROCESSING
; 1) PRE
; KILL INDEXES
; RE-INDEX
; MERGE DUPLICATES (OPTIONAL)
; ATTEMPT CODE CORRECTION (OPTIONAL)
; CREATE TEMP GLOBAL OF FULL TABLE
; 2) 1ST PASS
; ITERATE THROUGH LOCAL, BY CODE_NAME
; MATCH TO TEMP GLOBAL, REMOVE FROM TEMP IF FOUND
; STORE ENTRIES NOT MATCHED
; 3) 2ND PASS
; ITERATE THROUGH STORED ENTRIES, BY CODE
; MATCH TO TEMP, REMOVE FROM TEMP IF FOUND
; STORE ENTRIES NOT MATCHED
; 4) 3RD PASS
; ITERATE THROUGH STORED ENTRIES, BY NAME
; MATCH TO TEMP, REMOVE FROM TEMP IF FOUND
; STORE ENTRIES NOT MATCH
; 5) END
; UPDATE REMAINING FROM TEMP
; INACTIVATE LOCALS NOT MATCHED
Q
ALL ;EP - PROCESS FULL TABLE UPDATE
D AREA,SU,LOC
D ST,CTY,COM
D STNM^AUMSCBA2 ; IHS/OIT/NKD AUM*14.0*2 ADDED CALL TO STNM UPDATE
D CLIN^AUMSCBA2 ; IHS/OIT/NKD AUM*15.0*3 ADDED CALL TO CLIN UPDATE
Q
AREA ; AREA FILE
; DUP/COMP/CODE/NAME
; T=TAG,GL=GLOBAL,TGL=TEMP GLOBAL,L=LIST,CNT=COUNT,FL=FILE,INFL=INACTIVE FIELD
N AUMT,AUMGL,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL
S AUMT="AREA",AUMGL="^AUTTAREA(",AUMTGL="^TMP(""AUM"","_$J_",""ALL"",""AREA""",AUMFL=9999999.21,AUMINFL=.05
Q:'$D(@(AUMTGL_")"))
D RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20)),RSLT^AUMSCBD("AREA CLEANUP")
D REINDX(AUMGL,"B^C") ; RE-INDEX
D DUP(AUMT,AUMFL,AUMGL,"C") ; MERGE DUP
;
; COMPOSITE SEARCH
; BUILD TEMP GLOBAL X-REF
D BUILD^AUMSCBA(AUMTGL,"COMP","1^2")
; TEMP GLOBAL COUNT, MATCH TEMP TO LOCAL AND STORE REMAINING
S AUMCNT=$G(@(AUMTGL_",0)")),AUML=$$MATCH(AUMT,AUMGL,AUMTGL,"C","COMP","1")
; CHECK IF MATCHING HAS FINISHED (0 TEMP OR 0 LOCAL RECORDS REMAIN)
I ($G(@(AUMTGL_",0)"))=0)!(AUML']"") D END(AUMT,AUMGL,AUMTGL,AUML) Q
;
; CODE SEARCH
D BUILD^AUMSCBA(AUMTGL,"C","1")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML2=$$MATCH(AUMT,AUMGL,AUMTGL,"C","C",,.AUML)
I ($G(@(AUMTGL_",0)"))=0)!(AUML2']"") D END(AUMT,AUMGL,AUMTGL,AUML2) Q
;
; NAME SEARCH
D BUILD^AUMSCBA(AUMTGL,"B","2")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML3=$$MATCH(AUMT,AUMGL,AUMTGL,"B","B",,.AUML2)
D END(AUMT,AUMGL,AUMTGL,AUML3)
;
Q
SU ; SERVICE UNIT FILE
; INV CODE/DUP/COMP/CODE/NAME
N AUMT,AUMGL,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL,AUMI
S AUMT="SU",AUMGL="^AUTTSU(",AUMTGL="^TMP(""AUM"","_$J_",""ALL"",""SU""",AUMFL=9999999.22,AUMINFL=.05
Q:'$D(@(AUMTGL_")"))
D RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20)),RSLT^AUMSCBD("SERVICE UNIT CLEANUP")
S AUMI=0 F S AUMI=$O(^AUTTSU(AUMI)) Q:'AUMI K:$D(^AUTTSU(AUMI,-9)) ^AUTTSU(AUMI,-9)
;
K ^TMP("AUM",$J,"INV","SU")
M ^TMP("AUM",$J,"INV","SU","C")=^AUTTSU("C")
;
D REINDX(AUMGL,"B^C")
;
N AUMCNT,AUMCNT2
S AUMCNT=0 F S AUMCNT=$O(^TMP("AUM",$J,"INV","SU","C",AUMCNT)) Q:AUMCNT']"" D
. S AUMCNT2=0 F S AUMCNT2=$O(^TMP("AUM",$J,"INV","SU","C",AUMCNT,AUMCNT2)) Q:AUMCNT2']"" D
. . Q:'$D(^AUTTSU(AUMCNT2,0))
. . I AUMCNT'=$P($G(^AUTTSU(AUMCNT2,0)),U,4) D
. . . I $L(AUMCNT)=4 D Q
. . . . N AUMCNT3,AUMCNT4,FDA
. . . . S AUMCNT3=$E(AUMCNT,1,2),AUMCNT4=$O(^AUTTAREA("C",AUMCNT3,0))
. . . . Q:AUMCNT4']""
. . . . S FDA(AUMFL,AUMCNT2_",",.02)=AUMCNT4
. . . . D UPDATE^DIE(,"FDA")
. . . . D RSLT^AUMSCBD(" CORRECTING INVALID ENTRY: "_AUMCNT2_" / TO: "_$$GET1^DIQ(AUMFL,AUMCNT2,.04,"I"))
;
K ^TMP("AUM",$J,"INV","SU")
;
D DUP(AUMT,AUMFL,AUMGL,"C")
;
D BUILD^AUMSCBA(AUMTGL,"COMP","1^2^3")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML=$$MATCH(AUMT,AUMGL,AUMTGL,"C","COMP","1")
I ($G(@(AUMTGL_",0)"))=0)!(AUML']"") D END(AUMT,AUMGL,AUMTGL,AUML) Q
;
D BUILD^AUMSCBA(AUMTGL,"C","1^2")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML2=$$MATCH(AUMT,AUMGL,AUMTGL,"C","C",,.AUML)
I ($G(@(AUMTGL_",0)"))=0)!(AUML2']"") D END(AUMT,AUMGL,AUMTGL,AUML2) Q
;
D BUILD^AUMSCBA(AUMTGL,"B","3")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML3=$$MATCH(AUMT,AUMGL,AUMTGL,"B","B",,.AUML2)
D END(AUMT,AUMGL,AUMTGL,AUML3)
;
Q
LOC ; LOCATION FILE
; INV CODE/COMP/CODE
N AUMT,AUMGL,AUMGL2,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL
S AUMT="LOC",AUMGL="^AUTTLOC(",AUMGL2="^DIC(4,",AUMTGL="^TMP(""AUM"","_$J_",""ALL"",""LOC""",AUMFL=9999999.06,AUMINFL=.27
Q:'$D(@(AUMTGL_")"))
D RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20)),RSLT^AUMSCBD("LOCATION CLEANUP")
;
K ^TMP("AUM",$J,"INV","LOC")
M ^TMP("AUM",$J,"INV","LOC","C")=^AUTTLOC("C")
;
D REINDX("^DIC(4,","B^D"),REINDX("^AUTTLOC(","AC^B^C")
;
N AUMCNT,AUMCNT2
S AUMCNT=0 F S AUMCNT=$O(^TMP("AUM",$J,"INV","LOC","C",AUMCNT)) Q:AUMCNT']"" D
. S AUMCNT2=0 F S AUMCNT2=$O(^TMP("AUM",$J,"INV","LOC","C",AUMCNT,AUMCNT2)) Q:AUMCNT2']"" D
. . Q:'$D(^AUTTLOC(AUMCNT2,0))
. . I AUMCNT'=$P($G(^AUTTLOC(AUMCNT2,0)),U,10) D
. . . I $L(AUMCNT)=6 D Q
. . . . N AUMCNT3,AUMCNT4,FDA
. . . . S AUMCNT3=$E(AUMCNT,1,4),AUMCNT4=$O(^AUTTSU("C",AUMCNT3,0))
. . . . Q:AUMCNT4']""
. . . . S FDA(AUMFL,AUMCNT2_",",.04)=$$GET1^DIQ(9999999.22,AUMCNT4,.02,"I")
. . . . S FDA(AUMFL,AUMCNT2_",",.05)=AUMCNT4
. . . . D UPDATE^DIE(,"FDA")
. . . . D RSLT^AUMSCBD(" CORRECTING INVALID ENTRY: "_AUMCNT2_" / TO: "_$$GET1^DIQ(AUMFL,AUMCNT2,.12,"I"))
;
K ^TMP("AUM",$J,"INV","LOC")
;
D BUILD^AUMSCBA(AUMTGL,"COMP","1^2^3^4")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML=$$MATCH(AUMT,AUMGL,AUMTGL,"C","COMP","1")
I ($G(@(AUMTGL_",0)"))=0)!(AUML']"") D END(AUMT,AUMGL,AUMTGL,AUML) Q
;
D BUILD^AUMSCBA(AUMTGL,"C","1^2^3")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML2=$$MATCH(AUMT,AUMGL,AUMTGL,"C","C",,.AUML)
D END(AUMT,AUMGL,AUMTGL,AUML2)
;
Q
ST ; STATE FILE
; DUP/COMP/CODE/NAME
N AUMT,AUMGL,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL
S AUMT="STATE",AUMGL="^DIC(5,",AUMTGL="^TMP(""AUM"","_$J_",""ALL"",""STATE""",AUMFL=5,AUMINFL=9999999.02
Q:'$D(@(AUMTGL_")"))
D RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20)),RSLT^AUMSCBD("STATE CLEANUP")
D REINDX(AUMGL,"B^C")
D DUP(AUMT,AUMFL,AUMGL,"C")
;
D BUILD^AUMSCBA(AUMTGL,"COMP","3^1")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML=$$MATCH(AUMT,AUMGL,AUMTGL,"C","COMP","1")
I ($G(@(AUMTGL_",0)"))=0)!(AUML']"") D END(AUMT,AUMGL,AUMTGL,AUML) Q
;
D BUILD^AUMSCBA(AUMTGL,"C","3")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML2=$$MATCH(AUMT,AUMGL,AUMTGL,"C","C",,.AUML)
I ($G(@(AUMTGL_",0)"))=0)!(AUML2']"") D END(AUMT,AUMGL,AUMTGL,AUML2) Q
;
D BUILD^AUMSCBA(AUMTGL,"B","1")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML3=$$MATCH(AUMT,AUMGL,AUMTGL,"B","B",,.AUML2)
D END(AUMT,AUMGL,AUMTGL,AUML3)
;
Q
CTY ; COUNTY FILE
; INV CODE/DUP/COMP/CODE
N AUMT,AUMGL,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL
S AUMT="CNTY",AUMGL="^AUTTCTY(",AUMTGL="^TMP(""AUM"","_$J_",""ALL"",""CNTY""",AUMFL=9999999.23,AUMINFL=.08
Q:'$D(@(AUMTGL_")"))
D RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20)),RSLT^AUMSCBD("COUNTY CLEANUP")
;
K ^TMP("AUM",$J,"INV","CTY")
M ^TMP("AUM",$J,"INV","CTY","C")=^AUTTCTY("C")
;
D REINDX(AUMGL,"B^C")
;
N AUMCNT,AUMCNT2
S AUMCNT=0 F S AUMCNT=$O(^TMP("AUM",$J,"INV","CTY","C",AUMCNT)) Q:AUMCNT']"" D
. S AUMCNT2=0 F S AUMCNT2=$O(^TMP("AUM",$J,"INV","CTY","C",AUMCNT,AUMCNT2)) Q:AUMCNT2']"" D
. . Q:'$D(^AUTTCTY(AUMCNT2,0))
. . I AUMCNT'=$P($G(^AUTTCTY(AUMCNT2,0)),U,4) D
. . . I $L(AUMCNT)=4 D Q
. . . . N AUMCNT3,AUMCNT4,FDA
. . . . S AUMCNT3=$E(AUMCNT,1,2),AUMCNT4=$O(^DIC(5,"C",AUMCNT3,0))
. . . . Q:AUMCNT4']""
. . . . S FDA(AUMFL,AUMCNT2_",",.02)=AUMCNT4
. . . . D UPDATE^DIE(,"FDA")
. . . . D RSLT^AUMSCBD(" CORRECTING INVALID ENTRY: "_AUMCNT2_" / TO: "_$$GET1^DIQ(AUMFL,AUMCNT2,.04,"I"))
;
K ^TMP("AUM",$J,"INV","CTY")
;
D DUP(AUMT,AUMFL,AUMGL,"C")
;
D BUILD^AUMSCBA(AUMTGL,"COMP","1^2^3")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML=$$MATCH(AUMT,AUMGL,AUMTGL,"C","COMP","1")
I ($G(@(AUMTGL_",0)"))=0)!(AUML']"") D END(AUMT,AUMGL,AUMTGL,AUML) Q
;
D BUILD^AUMSCBA(AUMTGL,"C","1^2")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML2=$$MATCH(AUMT,AUMGL,AUMTGL,"C","C",,.AUML)
D END(AUMT,AUMGL,AUMTGL,AUML2)
;
Q
COM ; COMMUNITY FILE
; INV CODE/COMP/CODE
N AUMT,AUMGL,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL
S AUMT="COM",AUMGL="^AUTTCOM(",AUMTGL="^TMP(""AUM"","_$J_",""ALL"",""COM""",AUMFL=9999999.05,AUMINFL=.18
Q:'$D(@(AUMTGL_")"))
D RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20)),RSLT^AUMSCBD("COMMUNITY CLEANUP")
;
K ^TMP("AUM",$J,"INV","COM")
M ^TMP("AUM",$J,"INV","COM","C")=^AUTTCOM("C")
;
D REINDX(AUMGL,"B^C")
;
N AUMCNT,AUMCNT2
S AUMCNT=0 F S AUMCNT=$O(^TMP("AUM",$J,"INV","COM","C",AUMCNT)) Q:AUMCNT']"" D
. S AUMCNT2=0 F S AUMCNT2=$O(^TMP("AUM",$J,"INV","COM","C",AUMCNT,AUMCNT2)) Q:AUMCNT2']"" D
. . Q:'$D(^AUTTCOM(AUMCNT2,0))
. . I AUMCNT'=$P($G(^AUTTCOM(AUMCNT2,0)),U,8) D
. . . I $L(AUMCNT)=7 D Q
. . . . N AUMCNT3,AUMCNT4,FDA
. . . . S AUMCNT3=$E(AUMCNT,1,4),AUMCNT4=$O(^AUTTCTY("C",AUMCNT3,0))
. . . . Q:AUMCNT4']""
. . . . S FDA(AUMFL,AUMCNT2_",",.03)=$$GET1^DIQ(9999999.23,AUMCNT4,.02,"I")
. . . . S FDA(AUMFL,AUMCNT2_",",.02)=AUMCNT4
. . . . D UPDATE^DIE(,"FDA")
. . . . D RSLT^AUMSCBD(" CORRECTING INVALID ENTRY: "_AUMCNT2_" / TO: "_$$GET1^DIQ(AUMFL,AUMCNT2,.08,"I"))
;
K ^TMP("AUM",$J,"INV","COM")
;
D BUILD^AUMSCBA(AUMTGL,"COMP","1^2^3^4")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML=$$MATCH(AUMT,AUMGL,AUMTGL,"C","COMP","1")
I ($G(@(AUMTGL_",0)"))=0)!(AUML']"") D END(AUMT,AUMGL,AUMTGL,AUML) Q
;
D BUILD^AUMSCBA(AUMTGL,"C","1^2^3")
S AUMCNT=$G(@(AUMTGL_",0)")),AUML2=$$MATCH(AUMT,AUMGL,AUMTGL,"C","C",,.AUML)
D END(AUMT,AUMGL,AUMTGL,AUML2)
;
Q
;
BUILD(AUMGL,AUMIN,AUMD) ; BUILD X-REFS - TEMP GLOBAL
; GL=GLOBAL,IN=INDEX,D=PIECES TO BUILD X-REF
N CNT,CNT2
S CNT=0 F S CNT=$O(@(AUMGL_")")@(CNT)) Q:'CNT D
. N AUMDD,AUMDA
. S AUMDD=""
. F CNT2=1:1:$L(AUMD,U) S AUMDD=AUMDD_$E($P(@(AUMGL_")")@(CNT),U,$P(AUMD,U,CNT2)),1,30)
. S AUMDA=AUMGL_","""_AUMIN_""","""_AUMDD_""","_CNT_")"
. S @(AUMDA)=""
Q
;
MATCH(AUMT,AUMGL,AUMTGL,AUMIN,AUMTIN,AUMC,AUML,AUMQ) ; SEARCH/MATCH/UPDATE - IHS/OIT/NKD AUM*15.0*3 ADDED QUIET
; T=TAG,GL=GLOBAL,TGL=TEMP GLOBAL,IN=INDEX,TIN=TEMP INDEX,C=ADDITIONAL PIECE FOR X-REF,AUML=IENS TO PROCESS,AUMQ=QUIET
S AUMQ=$G(AUMQ,1) ; IHS/OIT/NKD AUM*15.0*3 QUIET, DEFAULT TO 1
N CNT,CNT2,TMP,TMP2,AUMR
S AUMR=U
; ITERATE THROUGH LOCAL INDEX
S CNT=0 F S CNT=$O(@(AUMGL_""""_AUMIN_""")")@(CNT)) Q:CNT']"" D
. I AUMGL="^DIC(5,",AUMIN="C",CNT'?2N Q ; EXCEPTION FOR STATE (C X-REF BUILT FROM 2 FIELDS)
. ; ITERATE THROUGH IENS
. S CNT2=0 F S CNT2=$O(@(AUMGL_""""_AUMIN_""")")@(CNT,CNT2)) Q:CNT2']"" D
. . I $D(AUML),(AUML'[("^"_CNT2_"^")) Q ; SKIP OVER CODES NOT IN AUML
. . N TMP,TMP2
. . S TMP=CNT_$S($D(AUMC):$E($P($G(@(AUMGL_CNT2_",0)")),U,AUMC),1,30),1:"") ; BUILD KEY TO COMPARE
. . S:(AUMGL="^AUTTLOC(")&(AUMTIN="COMP") TMP=CNT_$E($P($G(^DIC(4,CNT2,0)),U,AUMC),1,30) ; EXCEPTION FOR LOCATION/INSTITUTION NAME
. . S TMP2=$O(@(AUMTGL_","""_AUMTIN_""")")@(TMP,0)) ; CHECK IF KEY MATCHES IN TEMP GLOBAL
. . I TMP2']"" S AUMR=AUMR_CNT2_"^" Q ; IF NO, ADD TO RESULT AS UNMATCHED
. . ; UPDATE THE ENTRY - IF ENTRY WAS ALREADY INACTIVE, USE THAT DATE INSTEAD
. . I $$GET1^DID(AUMFL,AUMINFL,"","LABEL")]"",$$GET1^DIQ(AUMFL,CNT2,AUMINFL)]"",$P($G(@(AUMTGL_","_TMP2_")")),U,7)]"" D
. . . S $P(@(AUMTGL_","_TMP2_")"),U,7)=17000000+$$GET1^DIQ(AUMFL,CNT2,AUMINFL,"I")
. . D ENTRY^AUMSCBD(AUMT,"ALL",$G(@(AUMTGL_","_TMP2_")")),CNT2,AUMQ) ; IHS/OIT/NKD AUM*15.0*3 QUIET
. . K @(AUMTGL_","_TMP2_")"),@(AUMTGL_","""_AUMTIN_""")")@(TMP,TMP2) ; REMOVE FROM TEMP GLOBAL AND DECREMENT COUNT
. . S @(AUMTGL_",0)")=@(AUMTGL_",0)")-1
S:AUMR=U AUMR="" ; IF NO RESULTS, SET BACK TO EMPTY STRING
K @(AUMTGL_","""_AUMTIN_""")") ; CLEAR OUT REMAINING ENTRIES IN TEMP GLOBAL INDEX
Q AUMR
;
END(AUMT,AUMGL,AUMTGL,AUML) ; END PROCESSING
; UPDATE REMAINING IN TEMP GLOBAL
; INACTIVATE LOCALS NOT MATCHED
N CNT
; TMP REMAINING
I ($G(@(AUMTGL_",0)"))'=0) D
. S CNT=0 F S CNT=$O(@(AUMTGL_")")@(CNT)) Q:CNT']"" D
. . ; ONCE TO ADD, THEN TO UPDATE/INACTIVATE
. . I $P($G(@(AUMTGL_","_CNT_")")),U,7)]"" D ENTRY^AUMSCBD(AUMT,"ALL",$P($G(@(AUMTGL_","_CNT_")")),U,1,6),,2)
. . D ENTRY^AUMSCBD(AUMT,"ALL",$G(@(AUMTGL_","_CNT_")")),,1)
; LOCAL REMAINING
I (AUML]"") D
. N CNT,CNT2,FDA,AUMLI
. S CNT2=0
. Q:AUMT="LOC"
. Q:$$GET1^DID(AUMFL,AUMINFL,"","LABEL")']""
. F CNT=1:1:$L(AUML,U) D
. . S AUMLI=$P(AUML,U,CNT)
. . Q:AUMLI']""
. . Q:$$GET1^DIQ(AUMFL,AUMLI,AUMINFL)]""
. . S FDA(AUMFL,AUMLI_",",AUMINFL)=AUMDT,CNT2=CNT2+1
. I $D(FDA) D UPDATE^DIE(,"FDA")
. D RSLT^AUMSCBD(" INACTIVATING "_CNT2_" UNMATCHED LOCAL ENTRIES")
;
K @(AUMTGL_")")
Q
;
REINDX(AUMGL,AUMIN) ; RE-INDEX FILE
; GL=GLOBAL,IN=LIST OF INDEXES
Q:AUMIN']""
N CNT,DIK,DA,DIC
F CNT=1:1:$L(AUMIN,"^") Q:$P(AUMIN,"^",CNT)']"" K @(AUMGL_""""_$P(AUMIN,"^",CNT)_""")")
S DIK=AUMGL
D IXALL^DIK
D ^XBFMK
Q
;
DUP(AUMT,AUMFL,AUMGL,AUMIN) ; SEARCH FOR DUPLICATE ENTRIES AND MERGE
N AUMCNT,AUMCNT2,AUMTMP,AUMTMP2
S AUMCNT=0 F S AUMCNT=$O(@(AUMGL_""""_AUMIN_""")")@(AUMCNT)) Q:AUMCNT']"" D
. I AUMGL="^DIC(5,",AUMIN="C",AUMCNT'?2N Q ; EXCEPTION FOR STATE (C X-REF BUILT FROM 2 FIELDS)
. S AUMCNT2=0,AUMCNT2=$O(@(AUMGL_""""_AUMIN_""")")@(AUMCNT,AUMCNT2))
. Q:$O(@(AUMGL_""""_AUMIN_""")")@(AUMCNT,AUMCNT2))']""
. S AUMTMP(AUMCNT,AUMCNT2)=""
. F S AUMCNT2=$O(@(AUMGL_""""_AUMIN_""")")@(AUMCNT,AUMCNT2)) Q:AUMCNT2']"" S AUMTMP(AUMCNT,AUMCNT2)=""
S AUMCNT=0 F S AUMCNT=$O(AUMTMP(AUMCNT)) Q:AUMCNT']"" D
. S AUMTMP2=""
. D RSLT^AUMSCBD(" RESOLVING DUPLICATES FOR CODE: "_AUMCNT)
. S AUMCNT2=0 F S AUMCNT2=$O(AUMTMP(AUMCNT,AUMCNT2)) Q:AUMCNT2']"" S AUMTMP2=AUMTMP2_$S($L(AUMTMP2):U,1:"")_AUMCNT2 ;D RSLT^AUMSCBD(" IEN: "_AUMCNT2_$J("",$L(AUMCNT2)-8)_" - 0 NODE: "_$G(@(AUMGL_AUMCNT2_",0)")))
. F AUMCNT2=1:1:$L(AUMTMP2,U)-1 Q:$P(AUMTMP2,U,AUMCNT2)']"" D
. . D MERG(AUMFL,AUMGL,$P(AUMTMP2,U,AUMCNT2),$P(AUMTMP2,U,$L(AUMTMP2,U)))
Q
;
MERG(AUMFL,AUMGL,AUMFROM,AUMTO) ; COMPARE/MERGE
N DILN,DITM,L
I AUMGL="^AUTTCTY(" D CTYMERG(AUMFROM,AUMTO) S DITM("EXCLUDE",9002073.31)="" ; IHS/OIT/NKD AUM*14.0*2 - SPECIAL COUNTY PRE-MERGE
S DILN=21,DITM=0,L=1
S DITM("DDEF")=2,DITM("DDIF")=1,DITM("DELETE")=""
S DITM("DFF")=AUMFL,DITM("DIC")=AUMGL,DITM("DIMERGE")=1
S DITM("DIT(1)")=AUMFROM,DITM("DIT(2)")=AUMTO
S DITM("NON-INTERACTIVE")="",DITM("NOTALK")="",DITM("REPOINT")=""
D ^DITM2,END^DITM,^XBFMK
Q
;
; IHS/OIT/NKD AUM*14.0*2 - SPECIAL COUNTY PRE-MERGE
CTYMERG(AUMFROM,AUMTO) ; CHS SERVICE DELIVERY AREA MERGE
N FDA,AUMCNT,AUMCNT2
S AUMCNT=0 F S AUMCNT=$O(^ACHSSDA(AUMCNT)) Q:'AUMCNT D
. Q:'$D(^ACHSSDA(AUMCNT,30,"B",AUMFROM))
. S AUMCNT2=0 F S AUMCNT2=$O(^ACHSSDA(AUMCNT,30,"B",AUMFROM,AUMCNT2)) Q:'AUMCNT2 D
. . Q:(+$G(^ACHSSDA(AUMCNT,30,AUMCNT2,0))'=AUMFROM)
. . S FDA(9002073.31,AUMCNT2_","_AUMCNT_",",.01)=AUMTO
I $D(FDA) D UPDATE^DIE(,"FDA")
Q
AUMSCBA ;IHS/OIT/NKD - SCB UPDATE - FULL TABLE UPDATE 12/10/2013 ;
+1 ;;15.0;TABLE MAINTENANCE;**3**;SEP 9,2014;Build 1
+2 ; 03/12/14 - SPECIAL COUNTY PRE-MERGE
+3 ; - STATION NUMBER FULL UPDATE
+4 ; 05/29/15 - CLINIC FULL UPDATE
+5 ; - QUIET PARAMETER
+6 ;
+7 ; GENERAL FRAMEWORK FOR PROCESSING
+8 ; 1) PRE
+9 ; KILL INDEXES
+10 ; RE-INDEX
+11 ; MERGE DUPLICATES (OPTIONAL)
+12 ; ATTEMPT CODE CORRECTION (OPTIONAL)
+13 ; CREATE TEMP GLOBAL OF FULL TABLE
+14 ; 2) 1ST PASS
+15 ; ITERATE THROUGH LOCAL, BY CODE_NAME
+16 ; MATCH TO TEMP GLOBAL, REMOVE FROM TEMP IF FOUND
+17 ; STORE ENTRIES NOT MATCHED
+18 ; 3) 2ND PASS
+19 ; ITERATE THROUGH STORED ENTRIES, BY CODE
+20 ; MATCH TO TEMP, REMOVE FROM TEMP IF FOUND
+21 ; STORE ENTRIES NOT MATCHED
+22 ; 4) 3RD PASS
+23 ; ITERATE THROUGH STORED ENTRIES, BY NAME
+24 ; MATCH TO TEMP, REMOVE FROM TEMP IF FOUND
+25 ; STORE ENTRIES NOT MATCH
+26 ; 5) END
+27 ; UPDATE REMAINING FROM TEMP
+28 ; INACTIVATE LOCALS NOT MATCHED
+29 QUIT
ALL ;EP - PROCESS FULL TABLE UPDATE
+1 DO AREA
DO SU
DO LOC
+2 DO ST
DO CTY
DO COM
+3 ; IHS/OIT/NKD AUM*14.0*2 ADDED CALL TO STNM UPDATE
DO STNM^AUMSCBA2
+4 ; IHS/OIT/NKD AUM*15.0*3 ADDED CALL TO CLIN UPDATE
DO CLIN^AUMSCBA2
+5 QUIT
AREA ; AREA FILE
+1 ; DUP/COMP/CODE/NAME
+2 ; T=TAG,GL=GLOBAL,TGL=TEMP GLOBAL,L=LIST,CNT=COUNT,FL=FILE,INFL=INACTIVE FIELD
+3 NEW AUMT,AUMGL,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL
+4 SET AUMT="AREA"
SET AUMGL="^AUTTAREA("
SET AUMTGL="^TMP(""AUM"","_$JOB_",""ALL"",""AREA"""
SET AUMFL=9999999.21
SET AUMINFL=.05
+5 IF '$DATA(@(AUMTGL_")"))
QUIT
+6 DO RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20))
DO RSLT^AUMSCBD("AREA CLEANUP")
+7 ; RE-INDEX
DO REINDX(AUMGL,"B^C")
+8 ; MERGE DUP
DO DUP(AUMT,AUMFL,AUMGL,"C")
+9 ;
+10 ; COMPOSITE SEARCH
+11 ; BUILD TEMP GLOBAL X-REF
+12 DO BUILD^AUMSCBA(AUMTGL,"COMP","1^2")
+13 ; TEMP GLOBAL COUNT, MATCH TEMP TO LOCAL AND STORE REMAINING
+14 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML=$$MATCH(AUMT,AUMGL,AUMTGL,"C","COMP","1")
+15 ; CHECK IF MATCHING HAS FINISHED (0 TEMP OR 0 LOCAL RECORDS REMAIN)
+16 IF ($GET(@(AUMTGL_",0)"))=0)!(AUML']"")
DO END(AUMT,AUMGL,AUMTGL,AUML)
QUIT
+17 ;
+18 ; CODE SEARCH
+19 DO BUILD^AUMSCBA(AUMTGL,"C","1")
+20 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML2=$$MATCH(AUMT,AUMGL,AUMTGL,"C","C",,.AUML)
+21 IF ($GET(@(AUMTGL_",0)"))=0)!(AUML2']"")
DO END(AUMT,AUMGL,AUMTGL,AUML2)
QUIT
+22 ;
+23 ; NAME SEARCH
+24 DO BUILD^AUMSCBA(AUMTGL,"B","2")
+25 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML3=$$MATCH(AUMT,AUMGL,AUMTGL,"B","B",,.AUML2)
+26 DO END(AUMT,AUMGL,AUMTGL,AUML3)
+27 ;
+28 QUIT
SU ; SERVICE UNIT FILE
+1 ; INV CODE/DUP/COMP/CODE/NAME
+2 NEW AUMT,AUMGL,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL,AUMI
+3 SET AUMT="SU"
SET AUMGL="^AUTTSU("
SET AUMTGL="^TMP(""AUM"","_$JOB_",""ALL"",""SU"""
SET AUMFL=9999999.22
SET AUMINFL=.05
+4 IF '$DATA(@(AUMTGL_")"))
QUIT
+5 DO RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20))
DO RSLT^AUMSCBD("SERVICE UNIT CLEANUP")
+6 SET AUMI=0
FOR
SET AUMI=$ORDER(^AUTTSU(AUMI))
IF 'AUMI
QUIT
IF $DATA(^AUTTSU(AUMI,-9))
KILL ^AUTTSU(AUMI,-9)
+7 ;
+8 KILL ^TMP("AUM",$JOB,"INV","SU")
+9 MERGE ^TMP("AUM",$JOB,"INV","SU","C")=^AUTTSU("C")
+10 ;
+11 DO REINDX(AUMGL,"B^C")
+12 ;
+13 NEW AUMCNT,AUMCNT2
+14 SET AUMCNT=0
FOR
SET AUMCNT=$ORDER(^TMP("AUM",$JOB,"INV","SU","C",AUMCNT))
IF AUMCNT']""
QUIT
Begin DoDot:1
+15 SET AUMCNT2=0
FOR
SET AUMCNT2=$ORDER(^TMP("AUM",$JOB,"INV","SU","C",AUMCNT,AUMCNT2))
IF AUMCNT2']""
QUIT
Begin DoDot:2
+16 IF '$DATA(^AUTTSU(AUMCNT2,0))
QUIT
+17 IF AUMCNT'=$PIECE($GET(^AUTTSU(AUMCNT2,0)),U,4)
Begin DoDot:3
+18 IF $LENGTH(AUMCNT)=4
Begin DoDot:4
+19 NEW AUMCNT3,AUMCNT4,FDA
+20 SET AUMCNT3=$EXTRACT(AUMCNT,1,2)
SET AUMCNT4=$ORDER(^AUTTAREA("C",AUMCNT3,0))
+21 IF AUMCNT4']""
QUIT
+22 SET FDA(AUMFL,AUMCNT2_",",.02)=AUMCNT4
+23 DO UPDATE^DIE(,"FDA")
+24 DO RSLT^AUMSCBD(" CORRECTING INVALID ENTRY: "_AUMCNT2_" / TO: "_$$GET1^DIQ(AUMFL,AUMCNT2,.04,"I"))
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 KILL ^TMP("AUM",$JOB,"INV","SU")
+27 ;
+28 DO DUP(AUMT,AUMFL,AUMGL,"C")
+29 ;
+30 DO BUILD^AUMSCBA(AUMTGL,"COMP","1^2^3")
+31 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML=$$MATCH(AUMT,AUMGL,AUMTGL,"C","COMP","1")
+32 IF ($GET(@(AUMTGL_",0)"))=0)!(AUML']"")
DO END(AUMT,AUMGL,AUMTGL,AUML)
QUIT
+33 ;
+34 DO BUILD^AUMSCBA(AUMTGL,"C","1^2")
+35 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML2=$$MATCH(AUMT,AUMGL,AUMTGL,"C","C",,.AUML)
+36 IF ($GET(@(AUMTGL_",0)"))=0)!(AUML2']"")
DO END(AUMT,AUMGL,AUMTGL,AUML2)
QUIT
+37 ;
+38 DO BUILD^AUMSCBA(AUMTGL,"B","3")
+39 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML3=$$MATCH(AUMT,AUMGL,AUMTGL,"B","B",,.AUML2)
+40 DO END(AUMT,AUMGL,AUMTGL,AUML3)
+41 ;
+42 QUIT
LOC ; LOCATION FILE
+1 ; INV CODE/COMP/CODE
+2 NEW AUMT,AUMGL,AUMGL2,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL
+3 SET AUMT="LOC"
SET AUMGL="^AUTTLOC("
SET AUMGL2="^DIC(4,"
SET AUMTGL="^TMP(""AUM"","_$JOB_",""ALL"",""LOC"""
SET AUMFL=9999999.06
SET AUMINFL=.27
+4 IF '$DATA(@(AUMTGL_")"))
QUIT
+5 DO RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20))
DO RSLT^AUMSCBD("LOCATION CLEANUP")
+6 ;
+7 KILL ^TMP("AUM",$JOB,"INV","LOC")
+8 MERGE ^TMP("AUM",$JOB,"INV","LOC","C")=^AUTTLOC("C")
+9 ;
+10 DO REINDX("^DIC(4,","B^D")
DO REINDX("^AUTTLOC(","AC^B^C")
+11 ;
+12 NEW AUMCNT,AUMCNT2
+13 SET AUMCNT=0
FOR
SET AUMCNT=$ORDER(^TMP("AUM",$JOB,"INV","LOC","C",AUMCNT))
IF AUMCNT']""
QUIT
Begin DoDot:1
+14 SET AUMCNT2=0
FOR
SET AUMCNT2=$ORDER(^TMP("AUM",$JOB,"INV","LOC","C",AUMCNT,AUMCNT2))
IF AUMCNT2']""
QUIT
Begin DoDot:2
+15 IF '$DATA(^AUTTLOC(AUMCNT2,0))
QUIT
+16 IF AUMCNT'=$PIECE($GET(^AUTTLOC(AUMCNT2,0)),U,10)
Begin DoDot:3
+17 IF $LENGTH(AUMCNT)=6
Begin DoDot:4
+18 NEW AUMCNT3,AUMCNT4,FDA
+19 SET AUMCNT3=$EXTRACT(AUMCNT,1,4)
SET AUMCNT4=$ORDER(^AUTTSU("C",AUMCNT3,0))
+20 IF AUMCNT4']""
QUIT
+21 SET FDA(AUMFL,AUMCNT2_",",.04)=$$GET1^DIQ(9999999.22,AUMCNT4,.02,"I")
+22 SET FDA(AUMFL,AUMCNT2_",",.05)=AUMCNT4
+23 DO UPDATE^DIE(,"FDA")
+24 DO RSLT^AUMSCBD(" CORRECTING INVALID ENTRY: "_AUMCNT2_" / TO: "_$$GET1^DIQ(AUMFL,AUMCNT2,.12,"I"))
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 KILL ^TMP("AUM",$JOB,"INV","LOC")
+27 ;
+28 DO BUILD^AUMSCBA(AUMTGL,"COMP","1^2^3^4")
+29 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML=$$MATCH(AUMT,AUMGL,AUMTGL,"C","COMP","1")
+30 IF ($GET(@(AUMTGL_",0)"))=0)!(AUML']"")
DO END(AUMT,AUMGL,AUMTGL,AUML)
QUIT
+31 ;
+32 DO BUILD^AUMSCBA(AUMTGL,"C","1^2^3")
+33 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML2=$$MATCH(AUMT,AUMGL,AUMTGL,"C","C",,.AUML)
+34 DO END(AUMT,AUMGL,AUMTGL,AUML2)
+35 ;
+36 QUIT
ST ; STATE FILE
+1 ; DUP/COMP/CODE/NAME
+2 NEW AUMT,AUMGL,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL
+3 SET AUMT="STATE"
SET AUMGL="^DIC(5,"
SET AUMTGL="^TMP(""AUM"","_$JOB_",""ALL"",""STATE"""
SET AUMFL=5
SET AUMINFL=9999999.02
+4 IF '$DATA(@(AUMTGL_")"))
QUIT
+5 DO RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20))
DO RSLT^AUMSCBD("STATE CLEANUP")
+6 DO REINDX(AUMGL,"B^C")
+7 DO DUP(AUMT,AUMFL,AUMGL,"C")
+8 ;
+9 DO BUILD^AUMSCBA(AUMTGL,"COMP","3^1")
+10 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML=$$MATCH(AUMT,AUMGL,AUMTGL,"C","COMP","1")
+11 IF ($GET(@(AUMTGL_",0)"))=0)!(AUML']"")
DO END(AUMT,AUMGL,AUMTGL,AUML)
QUIT
+12 ;
+13 DO BUILD^AUMSCBA(AUMTGL,"C","3")
+14 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML2=$$MATCH(AUMT,AUMGL,AUMTGL,"C","C",,.AUML)
+15 IF ($GET(@(AUMTGL_",0)"))=0)!(AUML2']"")
DO END(AUMT,AUMGL,AUMTGL,AUML2)
QUIT
+16 ;
+17 DO BUILD^AUMSCBA(AUMTGL,"B","1")
+18 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML3=$$MATCH(AUMT,AUMGL,AUMTGL,"B","B",,.AUML2)
+19 DO END(AUMT,AUMGL,AUMTGL,AUML3)
+20 ;
+21 QUIT
CTY ; COUNTY FILE
+1 ; INV CODE/DUP/COMP/CODE
+2 NEW AUMT,AUMGL,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL
+3 SET AUMT="CNTY"
SET AUMGL="^AUTTCTY("
SET AUMTGL="^TMP(""AUM"","_$JOB_",""ALL"",""CNTY"""
SET AUMFL=9999999.23
SET AUMINFL=.08
+4 IF '$DATA(@(AUMTGL_")"))
QUIT
+5 DO RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20))
DO RSLT^AUMSCBD("COUNTY CLEANUP")
+6 ;
+7 KILL ^TMP("AUM",$JOB,"INV","CTY")
+8 MERGE ^TMP("AUM",$JOB,"INV","CTY","C")=^AUTTCTY("C")
+9 ;
+10 DO REINDX(AUMGL,"B^C")
+11 ;
+12 NEW AUMCNT,AUMCNT2
+13 SET AUMCNT=0
FOR
SET AUMCNT=$ORDER(^TMP("AUM",$JOB,"INV","CTY","C",AUMCNT))
IF AUMCNT']""
QUIT
Begin DoDot:1
+14 SET AUMCNT2=0
FOR
SET AUMCNT2=$ORDER(^TMP("AUM",$JOB,"INV","CTY","C",AUMCNT,AUMCNT2))
IF AUMCNT2']""
QUIT
Begin DoDot:2
+15 IF '$DATA(^AUTTCTY(AUMCNT2,0))
QUIT
+16 IF AUMCNT'=$PIECE($GET(^AUTTCTY(AUMCNT2,0)),U,4)
Begin DoDot:3
+17 IF $LENGTH(AUMCNT)=4
Begin DoDot:4
+18 NEW AUMCNT3,AUMCNT4,FDA
+19 SET AUMCNT3=$EXTRACT(AUMCNT,1,2)
SET AUMCNT4=$ORDER(^DIC(5,"C",AUMCNT3,0))
+20 IF AUMCNT4']""
QUIT
+21 SET FDA(AUMFL,AUMCNT2_",",.02)=AUMCNT4
+22 DO UPDATE^DIE(,"FDA")
+23 DO RSLT^AUMSCBD(" CORRECTING INVALID ENTRY: "_AUMCNT2_" / TO: "_$$GET1^DIQ(AUMFL,AUMCNT2,.04,"I"))
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;
+25 KILL ^TMP("AUM",$JOB,"INV","CTY")
+26 ;
+27 DO DUP(AUMT,AUMFL,AUMGL,"C")
+28 ;
+29 DO BUILD^AUMSCBA(AUMTGL,"COMP","1^2^3")
+30 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML=$$MATCH(AUMT,AUMGL,AUMTGL,"C","COMP","1")
+31 IF ($GET(@(AUMTGL_",0)"))=0)!(AUML']"")
DO END(AUMT,AUMGL,AUMTGL,AUML)
QUIT
+32 ;
+33 DO BUILD^AUMSCBA(AUMTGL,"C","1^2")
+34 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML2=$$MATCH(AUMT,AUMGL,AUMTGL,"C","C",,.AUML)
+35 DO END(AUMT,AUMGL,AUMTGL,AUML2)
+36 ;
+37 QUIT
COM ; COMMUNITY FILE
+1 ; INV CODE/COMP/CODE
+2 NEW AUMT,AUMGL,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL
+3 SET AUMT="COM"
SET AUMGL="^AUTTCOM("
SET AUMTGL="^TMP(""AUM"","_$JOB_",""ALL"",""COM"""
SET AUMFL=9999999.05
SET AUMINFL=.18
+4 IF '$DATA(@(AUMTGL_")"))
QUIT
+5 DO RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20))
DO RSLT^AUMSCBD("COMMUNITY CLEANUP")
+6 ;
+7 KILL ^TMP("AUM",$JOB,"INV","COM")
+8 MERGE ^TMP("AUM",$JOB,"INV","COM","C")=^AUTTCOM("C")
+9 ;
+10 DO REINDX(AUMGL,"B^C")
+11 ;
+12 NEW AUMCNT,AUMCNT2
+13 SET AUMCNT=0
FOR
SET AUMCNT=$ORDER(^TMP("AUM",$JOB,"INV","COM","C",AUMCNT))
IF AUMCNT']""
QUIT
Begin DoDot:1
+14 SET AUMCNT2=0
FOR
SET AUMCNT2=$ORDER(^TMP("AUM",$JOB,"INV","COM","C",AUMCNT,AUMCNT2))
IF AUMCNT2']""
QUIT
Begin DoDot:2
+15 IF '$DATA(^AUTTCOM(AUMCNT2,0))
QUIT
+16 IF AUMCNT'=$PIECE($GET(^AUTTCOM(AUMCNT2,0)),U,8)
Begin DoDot:3
+17 IF $LENGTH(AUMCNT)=7
Begin DoDot:4
+18 NEW AUMCNT3,AUMCNT4,FDA
+19 SET AUMCNT3=$EXTRACT(AUMCNT,1,4)
SET AUMCNT4=$ORDER(^AUTTCTY("C",AUMCNT3,0))
+20 IF AUMCNT4']""
QUIT
+21 SET FDA(AUMFL,AUMCNT2_",",.03)=$$GET1^DIQ(9999999.23,AUMCNT4,.02,"I")
+22 SET FDA(AUMFL,AUMCNT2_",",.02)=AUMCNT4
+23 DO UPDATE^DIE(,"FDA")
+24 DO RSLT^AUMSCBD(" CORRECTING INVALID ENTRY: "_AUMCNT2_" / TO: "_$$GET1^DIQ(AUMFL,AUMCNT2,.08,"I"))
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 KILL ^TMP("AUM",$JOB,"INV","COM")
+27 ;
+28 DO BUILD^AUMSCBA(AUMTGL,"COMP","1^2^3^4")
+29 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML=$$MATCH(AUMT,AUMGL,AUMTGL,"C","COMP","1")
+30 IF ($GET(@(AUMTGL_",0)"))=0)!(AUML']"")
DO END(AUMT,AUMGL,AUMTGL,AUML)
QUIT
+31 ;
+32 DO BUILD^AUMSCBA(AUMTGL,"C","1^2^3")
+33 SET AUMCNT=$GET(@(AUMTGL_",0)"))
SET AUML2=$$MATCH(AUMT,AUMGL,AUMTGL,"C","C",,.AUML)
+34 DO END(AUMT,AUMGL,AUMTGL,AUML2)
+35 ;
+36 QUIT
+37 ;
BUILD(AUMGL,AUMIN,AUMD) ; BUILD X-REFS - TEMP GLOBAL
+1 ; GL=GLOBAL,IN=INDEX,D=PIECES TO BUILD X-REF
+2 NEW CNT,CNT2
+3 SET CNT=0
FOR
SET CNT=$ORDER(@(AUMGL_")")@(CNT))
IF 'CNT
QUIT
Begin DoDot:1
+4 NEW AUMDD,AUMDA
+5 SET AUMDD=""
+6 FOR CNT2=1:1:$LENGTH(AUMD,U)
SET AUMDD=AUMDD_$EXTRACT($PIECE(@(AUMGL_")")@(CNT),U,$PIECE(AUMD,U,CNT2)),1,30)
+7 SET AUMDA=AUMGL_","""_AUMIN_""","""_AUMDD_""","_CNT_")"
+8 SET @(AUMDA)=""
End DoDot:1
+9 QUIT
+10 ;
MATCH(AUMT,AUMGL,AUMTGL,AUMIN,AUMTIN,AUMC,AUML,AUMQ) ; SEARCH/MATCH/UPDATE - IHS/OIT/NKD AUM*15.0*3 ADDED QUIET
+1 ; T=TAG,GL=GLOBAL,TGL=TEMP GLOBAL,IN=INDEX,TIN=TEMP INDEX,C=ADDITIONAL PIECE FOR X-REF,AUML=IENS TO PROCESS,AUMQ=QUIET
+2 ; IHS/OIT/NKD AUM*15.0*3 QUIET, DEFAULT TO 1
SET AUMQ=$GET(AUMQ,1)
+3 NEW CNT,CNT2,TMP,TMP2,AUMR
+4 SET AUMR=U
+5 ; ITERATE THROUGH LOCAL INDEX
+6 SET CNT=0
FOR
SET CNT=$ORDER(@(AUMGL_""""_AUMIN_""")")@(CNT))
IF CNT']""
QUIT
Begin DoDot:1
+7 ; EXCEPTION FOR STATE (C X-REF BUILT FROM 2 FIELDS)
IF AUMGL="^DIC(5,"
IF AUMIN="C"
IF CNT'?2N
QUIT
+8 ; ITERATE THROUGH IENS
+9 SET CNT2=0
FOR
SET CNT2=$ORDER(@(AUMGL_""""_AUMIN_""")")@(CNT,CNT2))
IF CNT2']""
QUIT
Begin DoDot:2
+10 ; SKIP OVER CODES NOT IN AUML
IF $DATA(AUML)
IF (AUML'[("^"_CNT2_"^"))
QUIT
+11 NEW TMP,TMP2
+12 ; BUILD KEY TO COMPARE
SET TMP=CNT_$SELECT($DATA(AUMC):$EXTRACT($PIECE($GET(@(AUMGL_CNT2_",0)")),U,AUMC),1,30),1:"")
+13 ; EXCEPTION FOR LOCATION/INSTITUTION NAME
IF (AUMGL="^AUTTLOC(")&(AUMTIN="COMP")
SET TMP=CNT_$EXTRACT($PIECE($GET(^DIC(4,CNT2,0)),U,AUMC),1,30)
+14 ; CHECK IF KEY MATCHES IN TEMP GLOBAL
SET TMP2=$ORDER(@(AUMTGL_","""_AUMTIN_""")")@(TMP,0))
+15 ; IF NO, ADD TO RESULT AS UNMATCHED
IF TMP2']""
SET AUMR=AUMR_CNT2_"^"
QUIT
+16 ; UPDATE THE ENTRY - IF ENTRY WAS ALREADY INACTIVE, USE THAT DATE INSTEAD
+17 IF $$GET1^DID(AUMFL,AUMINFL,"","LABEL")]""
IF $$GET1^DIQ(AUMFL,CNT2,AUMINFL)]""
IF $PIECE($GET(@(AUMTGL_","_TMP2_")")),U,7)]""
Begin DoDot:3
+18 SET $PIECE(@(AUMTGL_","_TMP2_")"),U,7)=17000000+$$GET1^DIQ(AUMFL,CNT2,AUMINFL,"I")
End DoDot:3
+19 ; IHS/OIT/NKD AUM*15.0*3 QUIET
DO ENTRY^AUMSCBD(AUMT,"ALL",$GET(@(AUMTGL_","_TMP2_")")),CNT2,AUMQ)
+20 ; REMOVE FROM TEMP GLOBAL AND DECREMENT COUNT
KILL @(AUMTGL_","_TMP2_")"),@(AUMTGL_","""_AUMTIN_""")")@(TMP,TMP2)
+21 SET @(AUMTGL_",0)")=@(AUMTGL_",0)")-1
End DoDot:2
End DoDot:1
+22 ; IF NO RESULTS, SET BACK TO EMPTY STRING
IF AUMR=U
SET AUMR=""
+23 ; CLEAR OUT REMAINING ENTRIES IN TEMP GLOBAL INDEX
KILL @(AUMTGL_","""_AUMTIN_""")")
+24 QUIT AUMR
+25 ;
END(AUMT,AUMGL,AUMTGL,AUML) ; END PROCESSING
+1 ; UPDATE REMAINING IN TEMP GLOBAL
+2 ; INACTIVATE LOCALS NOT MATCHED
+3 NEW CNT
+4 ; TMP REMAINING
+5 IF ($GET(@(AUMTGL_",0)"))'=0)
Begin DoDot:1
+6 SET CNT=0
FOR
SET CNT=$ORDER(@(AUMTGL_")")@(CNT))
IF CNT']""
QUIT
Begin DoDot:2
+7 ; ONCE TO ADD, THEN TO UPDATE/INACTIVATE
+8 IF $PIECE($GET(@(AUMTGL_","_CNT_")")),U,7)]""
DO ENTRY^AUMSCBD(AUMT,"ALL",$PIECE($GET(@(AUMTGL_","_CNT_")")),U,1,6),,2)
+9 DO ENTRY^AUMSCBD(AUMT,"ALL",$GET(@(AUMTGL_","_CNT_")")),,1)
End DoDot:2
End DoDot:1
+10 ; LOCAL REMAINING
+11 IF (AUML]"")
Begin DoDot:1
+12 NEW CNT,CNT2,FDA,AUMLI
+13 SET CNT2=0
+14 IF AUMT="LOC"
QUIT
+15 IF $$GET1^DID(AUMFL,AUMINFL,"","LABEL")']""
QUIT
+16 FOR CNT=1:1:$LENGTH(AUML,U)
Begin DoDot:2
+17 SET AUMLI=$PIECE(AUML,U,CNT)
+18 IF AUMLI']""
QUIT
+19 IF $$GET1^DIQ(AUMFL,AUMLI,AUMINFL)]""
QUIT
+20 SET FDA(AUMFL,AUMLI_",",AUMINFL)=AUMDT
SET CNT2=CNT2+1
End DoDot:2
+21 IF $DATA(FDA)
DO UPDATE^DIE(,"FDA")
+22 DO RSLT^AUMSCBD(" INACTIVATING "_CNT2_" UNMATCHED LOCAL ENTRIES")
End DoDot:1
+23 ;
+24 KILL @(AUMTGL_")")
+25 QUIT
+26 ;
REINDX(AUMGL,AUMIN) ; RE-INDEX FILE
+1 ; GL=GLOBAL,IN=LIST OF INDEXES
+2 IF AUMIN']""
QUIT
+3 NEW CNT,DIK,DA,DIC
+4 FOR CNT=1:1:$LENGTH(AUMIN,"^")
IF $PIECE(AUMIN,"^",CNT)']""
QUIT
KILL @(AUMGL_""""_$PIECE(AUMIN,"^",CNT)_""")")
+5 SET DIK=AUMGL
+6 DO IXALL^DIK
+7 DO ^XBFMK
+8 QUIT
+9 ;
DUP(AUMT,AUMFL,AUMGL,AUMIN) ; SEARCH FOR DUPLICATE ENTRIES AND MERGE
+1 NEW AUMCNT,AUMCNT2,AUMTMP,AUMTMP2
+2 SET AUMCNT=0
FOR
SET AUMCNT=$ORDER(@(AUMGL_""""_AUMIN_""")")@(AUMCNT))
IF AUMCNT']""
QUIT
Begin DoDot:1
+3 ; EXCEPTION FOR STATE (C X-REF BUILT FROM 2 FIELDS)
IF AUMGL="^DIC(5,"
IF AUMIN="C"
IF AUMCNT'?2N
QUIT
+4 SET AUMCNT2=0
SET AUMCNT2=$ORDER(@(AUMGL_""""_AUMIN_""")")@(AUMCNT,AUMCNT2))
+5 IF $ORDER(@(AUMGL_""""_AUMIN_""")")@(AUMCNT,AUMCNT2))']""
QUIT
+6 SET AUMTMP(AUMCNT,AUMCNT2)=""
+7 FOR
SET AUMCNT2=$ORDER(@(AUMGL_""""_AUMIN_""")")@(AUMCNT,AUMCNT2))
IF AUMCNT2']""
QUIT
SET AUMTMP(AUMCNT,AUMCNT2)=""
End DoDot:1
+8 SET AUMCNT=0
FOR
SET AUMCNT=$ORDER(AUMTMP(AUMCNT))
IF AUMCNT']""
QUIT
Begin DoDot:1
+9 SET AUMTMP2=""
+10 DO RSLT^AUMSCBD(" RESOLVING DUPLICATES FOR CODE: "_AUMCNT)
+11 ;D RSLT^AUMSCBD(" IEN: "_AUMCNT2_$J("",$L(AUMCNT2)-8)_" - 0 NODE: "_$G(@(AUMGL_AUMCNT2_",0)")))
SET AUMCNT2=0
FOR
SET AUMCNT2=$ORDER(AUMTMP(AUMCNT,AUMCNT2))
IF AUMCNT2']""
QUIT
SET AUMTMP2=AUMTMP2_$SELECT($LENGTH(AUMTMP2):U,1:"")_AUMCNT2
+12 FOR AUMCNT2=1:1:$LENGTH(AUMTMP2,U)-1
IF $PIECE(AUMTMP2,U,AUMCNT2)']""
QUIT
Begin DoDot:2
+13 DO MERG(AUMFL,AUMGL,$PIECE(AUMTMP2,U,AUMCNT2),$PIECE(AUMTMP2,U,$LENGTH(AUMTMP2,U)))
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
MERG(AUMFL,AUMGL,AUMFROM,AUMTO) ; COMPARE/MERGE
+1 NEW DILN,DITM,L
+2 ; IHS/OIT/NKD AUM*14.0*2 - SPECIAL COUNTY PRE-MERGE
IF AUMGL="^AUTTCTY("
DO CTYMERG(AUMFROM,AUMTO)
SET DITM("EXCLUDE",9002073.31)=""
+3 SET DILN=21
SET DITM=0
SET L=1
+4 SET DITM("DDEF")=2
SET DITM("DDIF")=1
SET DITM("DELETE")=""
+5 SET DITM("DFF")=AUMFL
SET DITM("DIC")=AUMGL
SET DITM("DIMERGE")=1
+6 SET DITM("DIT(1)")=AUMFROM
SET DITM("DIT(2)")=AUMTO
+7 SET DITM("NON-INTERACTIVE")=""
SET DITM("NOTALK")=""
SET DITM("REPOINT")=""
+8 DO ^DITM2
DO END^DITM
DO ^XBFMK
+9 QUIT
+10 ;
+11 ; IHS/OIT/NKD AUM*14.0*2 - SPECIAL COUNTY PRE-MERGE
CTYMERG(AUMFROM,AUMTO) ; CHS SERVICE DELIVERY AREA MERGE
+1 NEW FDA,AUMCNT,AUMCNT2
+2 SET AUMCNT=0
FOR
SET AUMCNT=$ORDER(^ACHSSDA(AUMCNT))
IF 'AUMCNT
QUIT
Begin DoDot:1
+3 IF '$DATA(^ACHSSDA(AUMCNT,30,"B",AUMFROM))
QUIT
+4 SET AUMCNT2=0
FOR
SET AUMCNT2=$ORDER(^ACHSSDA(AUMCNT,30,"B",AUMFROM,AUMCNT2))
IF 'AUMCNT2
QUIT
Begin DoDot:2
+5 IF (+$GET(^ACHSSDA(AUMCNT,30,AUMCNT2,0))'=AUMFROM)
QUIT
+6 SET FDA(9002073.31,AUMCNT2_","_AUMCNT_",",.01)=AUMTO
End DoDot:2
End DoDot:1
+7 IF $DATA(FDA)
DO UPDATE^DIE(,"FDA")
+8 QUIT
