- AUMSCBA2 ;IHS/OIT/NKD - SCB UPDATE - FULL TABLE UPDATE CONT. 03/12/2014 ;
- ;;15.0;TABLE MAINTENANCE;**3**;SEP 9,2014;Build 1
- ; 05/28/15 - CLINIC FULL UPDATE
- ;
- Q
- STNM ; EP - STATION NUMBER - INSTITUTION FILE
- N AUMT,AUMGL,AUMTGL,AUMCNT,AUMCNT2,AUMP1,AUMP2,AUMP3
- S AUMT="STNM",AUMGL="^DIC(4,",AUMTGL="^TMP(""AUM"","_$J_",""ALL"",""STNM"""
- Q:'$D(@(AUMTGL_")"))
- ;
- I ($G(@(AUMTGL_",0)"))'=0) D
- . S AUMCNT=0 F S AUMCNT=$O(@(AUMTGL_")")@(AUMCNT)) Q:AUMCNT']"" D
- . . S AUMP1=$P($G(@(AUMTGL_","_AUMCNT_")")),U,1) ;NAME
- . . S AUMP2=$P($G(@(AUMTGL_","_AUMCNT_")")),U,2) ;ASUFAC
- . . S AUMP3=$P($G(@(AUMTGL_","_AUMCNT_")")),U,3) ;STNM
- . . ; DELETE FROM INCORRECT ENTRIES
- . . S AUMCNT2=0 F S AUMCNT2=$O(^DIC(4,"D",AUMP3,AUMCNT2)) Q:'AUMCNT2 D
- . . . Q:($$GET1^DIQ(9999999.06,AUMCNT2,.0799,"I")=AUMP2)
- . . . S ^TMP("AUM",$J,"COUNT",AUMT)=$G(^TMP("AUM",$J,"COUNT",AUMT))+1
- . . . D ENTRY^AUMSCBD(AUMT,"DEL",$$GET1^DIQ(4,AUMCNT2,.01,"I")_U_$$GET1^DIQ(9999999.06,AUMCNT2,.0799,"I")_U_AUMP3,,)
- . . ; ADD TO CORRECT ENTRY
- . . D ENTRY^AUMSCBD(AUMT,"ADD",$G(@(AUMTGL_","_AUMCNT_")")),,1)
- ;
- K @(AUMTGL_")")
- Q
- ; IHS/OIT/NKD AUM*15.0*3 FULL CLINIC UPDATE
- CLIN ; EP - CLINIC STOP FILE
- ; 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="CLIN",AUMGL="^DIC(40.7,",AUMTGL="^TMP(""AUM"","_$J_",""ALL"",""CLIN""",AUMFL=40.7,AUMINFL=2
- Q:'$D(@(AUMTGL_")"))
- D RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20)),RSLT^AUMSCBD("CLINIC STOP FILE CLEANUP")
- D REINDX^AUMSCBA(AUMGL,"B^C") ; RE-INDEX
- ;
- ; 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^AUMSCBA(AUMT,AUMGL,AUMTGL,"C","COMP","1",,0)
- ; CHECK IF MATCHING HAS FINISHED (0 TEMP OR 0 LOCAL RECORDS REMAIN)
- I ($G(@(AUMTGL_",0)"))=0)!(AUML']"") D CLINEND(AUMT,AUMGL,AUMTGL,AUML) Q
- ;
- ; CODE SEARCH
- D BUILD^AUMSCBA(AUMTGL,"C","1")
- S AUMCNT=$G(@(AUMTGL_",0)")),AUML2=$$MATCH^AUMSCBA(AUMT,AUMGL,AUMTGL,"C","C",,.AUML,0)
- I ($G(@(AUMTGL_",0)"))=0)!(AUML2']"") D CLINEND(AUMT,AUMGL,AUMTGL,AUML2) Q
- ;
- ; NAME SEARCH
- D BUILD^AUMSCBA(AUMTGL,"B","2")
- S AUMCNT=$G(@(AUMTGL_",0)")),AUML3=$$MATCH^AUMSCBA(AUMT,AUMGL,AUMTGL,"B","B",,.AUML2,0)
- D CLINEND(AUMT,AUMGL,AUMTGL,AUML3)
- ;
- Q
- CLINEND(AUMT,AUMGL,AUMTGL,AUML) ; END PROCESSING
- ; UPDATE REMAINING IN TEMP GLOBAL
- ; INACTIVATE LOCALS NOT MATCHED
- N CNT,CNT2,IEN,DAT
- ; 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_")")),,0)
- ; LOCAL REMAINING
- I (AUML]"") D
- . D RSLT^AUMSCBD(""),RSLT^AUMSCBD("Inactivating local duplicate/invalid entries")
- . D RSLT^AUMSCBD(" CODE NAME PC 1A INA")
- . D RSLT^AUMSCBD(" ==== ==== == == ===")
- . F CNT=1:1:$L(AUML,U) S IEN=$P(AUML,U,CNT) D
- . . Q:'IEN
- . . S DAT=$$GET1^DIQ(40.7,IEN,1,"I")
- . . S $P(DAT,U,2)=$$GET1^DIQ(40.7,IEN,.01,"I")
- . . S $P(DAT,U,4)=$S($$GET1^DIQ(40.7,IEN,999999902,"I"):"Y",1:"N")
- . . S $P(DAT,U,5)=$S($$GET1^DIQ(40.7,IEN,90000.01,"I")="Y":"Y",1:"N")
- . . S $P(DAT,U,7)=$$DT^XLFDT+17000000
- . . D ENTRY^AUMSCBD(AUMT,"INA",DAT,IEN)
- ;
- K @(AUMTGL_")")
- ;
- Q
- AUMSCBA2 ;IHS/OIT/NKD - SCB UPDATE - FULL TABLE UPDATE CONT. 03/12/2014 ;
- +1 ;;15.0;TABLE MAINTENANCE;**3**;SEP 9,2014;Build 1
- +2 ; 05/28/15 - CLINIC FULL UPDATE
- +3 ;
- +4 QUIT
- STNM ; EP - STATION NUMBER - INSTITUTION FILE
- +1 NEW AUMT,AUMGL,AUMTGL,AUMCNT,AUMCNT2,AUMP1,AUMP2,AUMP3
- +2 SET AUMT="STNM"
- SET AUMGL="^DIC(4,"
- SET AUMTGL="^TMP(""AUM"","_$JOB_",""ALL"",""STNM"""
- +3 IF '$DATA(@(AUMTGL_")"))
- QUIT
- +4 ;
- +5 IF ($GET(@(AUMTGL_",0)"))'=0)
- Begin DoDot:1
- +6 SET AUMCNT=0
- FOR
- SET AUMCNT=$ORDER(@(AUMTGL_")")@(AUMCNT))
- IF AUMCNT']""
- QUIT
- Begin DoDot:2
- +7 ;NAME
- SET AUMP1=$PIECE($GET(@(AUMTGL_","_AUMCNT_")")),U,1)
- +8 ;ASUFAC
- SET AUMP2=$PIECE($GET(@(AUMTGL_","_AUMCNT_")")),U,2)
- +9 ;STNM
- SET AUMP3=$PIECE($GET(@(AUMTGL_","_AUMCNT_")")),U,3)
- +10 ; DELETE FROM INCORRECT ENTRIES
- +11 SET AUMCNT2=0
- FOR
- SET AUMCNT2=$ORDER(^DIC(4,"D",AUMP3,AUMCNT2))
- IF 'AUMCNT2
- QUIT
- Begin DoDot:3
- +12 IF ($$GET1^DIQ(9999999.06,AUMCNT2,.0799,"I")=AUMP2)
- QUIT
- +13 SET ^TMP("AUM",$JOB,"COUNT",AUMT)=$GET(^TMP("AUM",$JOB,"COUNT",AUMT))+1
- +14 DO ENTRY^AUMSCBD(AUMT,"DEL",$$GET1^DIQ(4,AUMCNT2,.01,"I")_U_$$GET1^DIQ(9999999.06,AUMCNT2,.0799,"I")_U_AUMP3,,)
- End DoDot:3
- +15 ; ADD TO CORRECT ENTRY
- +16 DO ENTRY^AUMSCBD(AUMT,"ADD",$GET(@(AUMTGL_","_AUMCNT_")")),,1)
- End DoDot:2
- End DoDot:1
- +17 ;
- +18 KILL @(AUMTGL_")")
- +19 QUIT
- +20 ; IHS/OIT/NKD AUM*15.0*3 FULL CLINIC UPDATE
- CLIN ; EP - CLINIC STOP FILE
- +1 ; T=TAG,GL=GLOBAL,TGL=TEMP GLOBAL,L=LIST,CNT=COUNT,FL=FILE,INFL=INACTIVE FIELD
- +2 NEW AUMT,AUMGL,AUMTGL,AUML,AUML2,AUML3,AUMCNT,AUMFL,AUMINFL
- +3 SET AUMT="CLIN"
- SET AUMGL="^DIC(40.7,"
- SET AUMTGL="^TMP(""AUM"","_$JOB_",""ALL"",""CLIN"""
- SET AUMFL=40.7
- SET AUMINFL=2
- +4 IF '$DATA(@(AUMTGL_")"))
- QUIT
- +5 DO RSLT^AUMSCBD($$REPEAT^XLFSTR("-",20))
- DO RSLT^AUMSCBD("CLINIC STOP FILE CLEANUP")
- +6 ; RE-INDEX
- DO REINDX^AUMSCBA(AUMGL,"B^C")
- +7 ;
- +8 ; COMPOSITE SEARCH
- +9 ; BUILD TEMP GLOBAL X-REF
- +10 DO BUILD^AUMSCBA(AUMTGL,"COMP","1^2")
- +11 ; TEMP GLOBAL COUNT, MATCH TEMP TO LOCAL AND STORE REMAINING
- +12 SET AUMCNT=$GET(@(AUMTGL_",0)"))
- SET AUML=$$MATCH^AUMSCBA(AUMT,AUMGL,AUMTGL,"C","COMP","1",,0)
- +13 ; CHECK IF MATCHING HAS FINISHED (0 TEMP OR 0 LOCAL RECORDS REMAIN)
- +14 IF ($GET(@(AUMTGL_",0)"))=0)!(AUML']"")
- DO CLINEND(AUMT,AUMGL,AUMTGL,AUML)
- QUIT
- +15 ;
- +16 ; CODE SEARCH
- +17 DO BUILD^AUMSCBA(AUMTGL,"C","1")
- +18 SET AUMCNT=$GET(@(AUMTGL_",0)"))
- SET AUML2=$$MATCH^AUMSCBA(AUMT,AUMGL,AUMTGL,"C","C",,.AUML,0)
- +19 IF ($GET(@(AUMTGL_",0)"))=0)!(AUML2']"")
- DO CLINEND(AUMT,AUMGL,AUMTGL,AUML2)
- QUIT
- +20 ;
- +21 ; NAME SEARCH
- +22 DO BUILD^AUMSCBA(AUMTGL,"B","2")
- +23 SET AUMCNT=$GET(@(AUMTGL_",0)"))
- SET AUML3=$$MATCH^AUMSCBA(AUMT,AUMGL,AUMTGL,"B","B",,.AUML2,0)
- +24 DO CLINEND(AUMT,AUMGL,AUMTGL,AUML3)
- +25 ;
- +26 QUIT
- CLINEND(AUMT,AUMGL,AUMTGL,AUML) ; END PROCESSING
- +1 ; UPDATE REMAINING IN TEMP GLOBAL
- +2 ; INACTIVATE LOCALS NOT MATCHED
- +3 NEW CNT,CNT2,IEN,DAT
- +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_")")),,0)
- End DoDot:2
- End DoDot:1
- +10 ; LOCAL REMAINING
- +11 IF (AUML]"")
- Begin DoDot:1
- +12 DO RSLT^AUMSCBD("")
- DO RSLT^AUMSCBD("Inactivating local duplicate/invalid entries")
- +13 DO RSLT^AUMSCBD(" CODE NAME PC 1A INA")
- +14 DO RSLT^AUMSCBD(" ==== ==== == == ===")
- +15 FOR CNT=1:1:$LENGTH(AUML,U)
- SET IEN=$PIECE(AUML,U,CNT)
- Begin DoDot:2
- +16 IF 'IEN
- QUIT
- +17 SET DAT=$$GET1^DIQ(40.7,IEN,1,"I")
- +18 SET $PIECE(DAT,U,2)=$$GET1^DIQ(40.7,IEN,.01,"I")
- +19 SET $PIECE(DAT,U,4)=$SELECT($$GET1^DIQ(40.7,IEN,999999902,"I"):"Y",1:"N")
- +20 SET $PIECE(DAT,U,5)=$SELECT($$GET1^DIQ(40.7,IEN,90000.01,"I")="Y":"Y",1:"N")
- +21 SET $PIECE(DAT,U,7)=$$DT^XLFDT+17000000
- +22 DO ENTRY^AUMSCBD(AUMT,"INA",DAT,IEN)
- End DoDot:2
- End DoDot:1
- +23 ;
- +24 KILL @(AUMTGL_")")
- +25 ;
- +26 QUIT
