ABMASPLT ; IHS/SD/SDR - Auto-Split check ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/SD/SDR - V2.5 P8 - task 8
; new routine for auto-splitting of claims
;
MAIN(ABMCDFN) ;EP - Check if replacement and auto-split
Q:+$G(ABMAINS)=0
D REPLACE ;replace active insurer
D SPLIT ;split into multiple bills
Q
REPLACE ;
S ABMAINS=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,8) ;active insurer
S ABMVTYP=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,7) ;visit type
S ABMVTE=$G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,0))
Q:ABMVTE="" ;visit type isn't set up for insurer
Q:$O(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,0))=0 ;no replacement entry
S ABMENC=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,8) ;encounter/service date?
;find which entry in insurer multiple is the active insurer
S ABMINSI=0,ABMRPFLG=0
F S ABMINSI=$O(^ABMDCLM(DUZ(2),ABMCDFN,13,ABMINSI)) Q:+ABMINSI=0 D Q:$G(ABMRPFLG)=1
.S:(ABMAINS=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,13,ABMINSI,0)),U)) ABMRPFLG=1
; a replacement exists; now let's see if there's an active one
;S ABMVTEDT="",ABMVFLG=0
S ABMVTEDT=ABMENC+1,ABMVFLG=0
F S ABMVTEDT=$O(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,"B",ABMVTEDT),-1) Q:ABMVTEDT="" D Q:ABMVFLG=1
.S ABMVIEN=0
.F S ABMVIEN=$O(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,"B",ABMVTEDT,ABMVIEN)) Q:ABMVIEN="" D Q:ABMVFLG=1
..I $$ISACTIVE($P($G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U),$P($G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U,2),ABMENC) S ABMVFLG=1
Q:ABMVFLG=0 ;no active replacement--quit
;change active insurer
K DA,DIE,DR,DIC,DD,DO
S DA=ABMP("CDFN")
S DIE="^ABMDCLM(DUZ(2),"
S DR=".08////"_$P($G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U,3)
D ^DIE
S ABMPINS=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,8) ;active insurer
;stuff replacenment insurer
K DA,DIE,DR,DIC,DD,DO
S DA(1)=ABMCDFN
S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
S DA=ABMINSI
S DR=".011////"_$P($G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U,3)
D ^DIE
;
;change visit type - need a new field called 'replacement visit type" ?
K DA,DIE,DR,DIC,DD,DO
S DA=ABMP("CDFN")
S DIE="^ABMDCLM(DUZ(2),"
S DR=".07////"_$P($G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U,4)
D ^DIE
Q
;now do splitting if auto-split is YES
SPLIT ;
I $P($G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,0)),U,23)="Y" D
.S ABMVFL=0
.F S ABMVFL=$O(^ABMDVTYP(ABMVTYP,2,ABMVFL)) Q:+ABMVFL=0 D
..S ABMVFLN=$P($G(^ABMDVTYP(ABMVTYP,2,ABMVFL,0)),U)
..K ABMMULT
..S:ABMVFLN="8A" ABMMULT=27
..S:ABMVFLN="8B" ABMMULT=21
..S:ABMVFLN="8C" ABMMULT=25
..S:ABMVFLN="8D" ABMMULT=23
..S:ABMVFLN="8E" ABMMULT=37
..S:ABMVFLN="8F" ABMMULT=35
..S:ABMVFLN="8G" ABMMULT=39
..S:ABMVFLN="8H" ABMMULT=43
..S:ABMVFLN="8I" ABMMULT=33
..S:ABMVFLN="8J" ABMMULT=45
..I $O(^ABMDCLM(DUZ(2),ABMCDFN,ABMMULT,0))="" Q ;no entry for multiple on this claim
..S X=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,1)
..Q:'X
..K DIC,DA,DR,DIE
..S DINUM=$$NXNM^ABMDUTL
..Q:DINUM=""
..S DIC="^ABMDCLM(DUZ(2),"
..S DIC(0)="L"
..K DD,DO
..D FILE^DICN
..Q:+Y<0
..S ABMC2=+Y
..; standard data for all claims
..M ^ABMDCLM(DUZ(2),ABMC2,0)=^ABMDCLM(DUZ(2),ABMCDFN,0)
..M ^ABMDCLM(DUZ(2),ABMC2,4)=^ABMDCLM(DUZ(2),ABMCDFN,4)
..M ^ABMDCLM(DUZ(2),ABMC2,5)=^ABMDCLM(DUZ(2),ABMCDFN,5)
..M ^ABMDCLM(DUZ(2),ABMC2,6)=^ABMDCLM(DUZ(2),ABMCDFN,6)
..M ^ABMDCLM(DUZ(2),ABMC2,7)=^ABMDCLM(DUZ(2),ABMCDFN,7)
..M ^ABMDCLM(DUZ(2),ABMC2,8)=^ABMDCLM(DUZ(2),ABMCDFN,8)
..M ^ABMDCLM(DUZ(2),ABMC2,9)=^ABMDCLM(DUZ(2),ABMCDFN,9)
..M ^ABMDCLM(DUZ(2),ABMC2,10)=^ABMDCLM(DUZ(2),ABMCDFN,10)
..;
..M ^ABMDCLM(DUZ(2),ABMC2,11)=^ABMDCLM(DUZ(2),ABMCDFN,11) ;pcc visits
..M ^ABMDCLM(DUZ(2),ABMC2,13)=^ABMDCLM(DUZ(2),ABMCDFN,13) ;insurers
..M ^ABMDCLM(DUZ(2),ABMC2,17)=^ABMDCLM(DUZ(2),ABMCDFN,17) ;icds
..M ^ABMDCLM(DUZ(2),ABMC2,41)=^ABMDCLM(DUZ(2),ABMCDFN,41) ;providers
..;the specified multiple to be split
..I $G(ABMMULT)'="" D
...M ^ABMDCLM(DUZ(2),ABMC2,ABMMULT)=^ABMDCLM(DUZ(2),ABMCDFN,ABMMULT)
...;should multiple be removed from original claim?
...I $P($G(^ABMDVTYP(ABMVTYP,2,ABMVFL,0)),U,2)="Y" D
....K DA
....S DA=0,DA(1)=ABMCDFN
....F S DA=$O(^ABMDCLM(DUZ(2),ABMCDFN,ABMMULT,DA)) Q:+DA=0 D
.....S DIK="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMMULT_","
.....D ^DIK
..I $G(ABMMULT)="" M ^ABMDCLM(DUZ(2),ABMC2)=^ABMDCLM(DUZ(2),ABMCDFN)
Q
;GIVEN A ENCOUNTER/SERVICE DATE AND BEGIN/END DATES OF REPLACEMENT INSURER
;WHICH REPLACEMENT INSURER IS ACTIVE. NOTE: THERE SHOULD NOT BE MORE THAN ONE
;REPLACEMENT INSURER ACTIVE FOR ANY GIVEN DATE
ISACTIVE(EFFDT,ENDDT,TARDATE) ;
NEW OPENEND
I EFFDT="",(ENDDT="") Q 0
S ENDDT=ENDDT ;TRUE IF ENDING DATE IS AT COB OF ENDING DATE - ANSWER FROM ADRIAN IS IT IS
; IN FORCE FOR ALL OF TODAY
S OPENEND=ENDDT=""
I OPENEND I TARDATE=EFFDT!(TARDATE>EFFDT) Q 1
I TARDATE=EFFDT!(TARDATE=ENDDT) Q 1
I TARDATE>EFFDT&(TARDATE<ENDDT) Q 1
Q 0
ABMASPLT ; IHS/SD/SDR - Auto-Split check ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - V2.5 P8 - task 8
+4 ; new routine for auto-splitting of claims
+5 ;
MAIN(ABMCDFN) ;EP - Check if replacement and auto-split
+1 IF +$GET(ABMAINS)=0
QUIT
+2 ;replace active insurer
DO REPLACE
+3 ;split into multiple bills
DO SPLIT
+4 QUIT
REPLACE ;
+1 ;active insurer
SET ABMAINS=$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,8)
+2 ;visit type
SET ABMVTYP=$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,7)
+3 SET ABMVTE=$GET(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,0))
+4 ;visit type isn't set up for insurer
IF ABMVTE=""
QUIT
+5 ;no replacement entry
IF $ORDER(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,0))=0
QUIT
+6 ;encounter/service date?
SET ABMENC=$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,8)
+7 ;find which entry in insurer multiple is the active insurer
+8 SET ABMINSI=0
SET ABMRPFLG=0
+9 FOR
SET ABMINSI=$ORDER(^ABMDCLM(DUZ(2),ABMCDFN,13,ABMINSI))
IF +ABMINSI=0
QUIT
Begin DoDot:1
+10 IF (ABMAINS=$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,13,ABMINSI,0)),U))
SET ABMRPFLG=1
End DoDot:1
IF $GET(ABMRPFLG)=1
QUIT
+11 ; a replacement exists; now let's see if there's an active one
+12 ;S ABMVTEDT="",ABMVFLG=0
+13 SET ABMVTEDT=ABMENC+1
SET ABMVFLG=0
+14 FOR
SET ABMVTEDT=$ORDER(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,"B",ABMVTEDT),-1)
IF ABMVTEDT=""
QUIT
Begin DoDot:1
+15 SET ABMVIEN=0
+16 FOR
SET ABMVIEN=$ORDER(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,"B",ABMVTEDT,ABMVIEN))
IF ABMVIEN=""
QUIT
Begin DoDot:2
+17 IF $$ISACTIVE($PIECE($GET(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U),$PIECE($GET(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U,2),ABMENC)
SET ABMVFLG=1
End DoDot:2
IF ABMVFLG=1
QUIT
End DoDot:1
IF ABMVFLG=1
QUIT
+18 ;no active replacement--quit
IF ABMVFLG=0
QUIT
+19 ;change active insurer
+20 KILL DA,DIE,DR,DIC,DD,DO
+21 SET DA=ABMP("CDFN")
+22 SET DIE="^ABMDCLM(DUZ(2),"
+23 SET DR=".08////"_$PIECE($GET(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U,3)
+24 DO ^DIE
+25 ;active insurer
SET ABMPINS=$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,8)
+26 ;stuff replacenment insurer
+27 KILL DA,DIE,DR,DIC,DD,DO
+28 SET DA(1)=ABMCDFN
+29 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
+30 SET DA=ABMINSI
+31 SET DR=".011////"_$PIECE($GET(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U,3)
+32 DO ^DIE
+33 ;
+34 ;change visit type - need a new field called 'replacement visit type" ?
+35 KILL DA,DIE,DR,DIC,DD,DO
+36 SET DA=ABMP("CDFN")
+37 SET DIE="^ABMDCLM(DUZ(2),"
+38 SET DR=".07////"_$PIECE($GET(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U,4)
+39 DO ^DIE
+40 QUIT
+41 ;now do splitting if auto-split is YES
SPLIT ;
+1 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,0)),U,23)="Y"
Begin DoDot:1
+2 SET ABMVFL=0
+3 FOR
SET ABMVFL=$ORDER(^ABMDVTYP(ABMVTYP,2,ABMVFL))
IF +ABMVFL=0
QUIT
Begin DoDot:2
+4 SET ABMVFLN=$PIECE($GET(^ABMDVTYP(ABMVTYP,2,ABMVFL,0)),U)
+5 KILL ABMMULT
+6 IF ABMVFLN="8A"
SET ABMMULT=27
+7 IF ABMVFLN="8B"
SET ABMMULT=21
+8 IF ABMVFLN="8C"
SET ABMMULT=25
+9 IF ABMVFLN="8D"
SET ABMMULT=23
+10 IF ABMVFLN="8E"
SET ABMMULT=37
+11 IF ABMVFLN="8F"
SET ABMMULT=35
+12 IF ABMVFLN="8G"
SET ABMMULT=39
+13 IF ABMVFLN="8H"
SET ABMMULT=43
+14 IF ABMVFLN="8I"
SET ABMMULT=33
+15 IF ABMVFLN="8J"
SET ABMMULT=45
+16 ;no entry for multiple on this claim
IF $ORDER(^ABMDCLM(DUZ(2),ABMCDFN,ABMMULT,0))=""
QUIT
+17 SET X=$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,1)
+18 IF 'X
QUIT
+19 KILL DIC,DA,DR,DIE
+20 SET DINUM=$$NXNM^ABMDUTL
+21 IF DINUM=""
QUIT
+22 SET DIC="^ABMDCLM(DUZ(2),"
+23 SET DIC(0)="L"
+24 KILL DD,DO
+25 DO FILE^DICN
+26 IF +Y<0
QUIT
+27 SET ABMC2=+Y
+28 ; standard data for all claims
+29 MERGE ^ABMDCLM(DUZ(2),ABMC2,0)=^ABMDCLM(DUZ(2),ABMCDFN,0)
+30 MERGE ^ABMDCLM(DUZ(2),ABMC2,4)=^ABMDCLM(DUZ(2),ABMCDFN,4)
+31 MERGE ^ABMDCLM(DUZ(2),ABMC2,5)=^ABMDCLM(DUZ(2),ABMCDFN,5)
+32 MERGE ^ABMDCLM(DUZ(2),ABMC2,6)=^ABMDCLM(DUZ(2),ABMCDFN,6)
+33 MERGE ^ABMDCLM(DUZ(2),ABMC2,7)=^ABMDCLM(DUZ(2),ABMCDFN,7)
+34 MERGE ^ABMDCLM(DUZ(2),ABMC2,8)=^ABMDCLM(DUZ(2),ABMCDFN,8)
+35 MERGE ^ABMDCLM(DUZ(2),ABMC2,9)=^ABMDCLM(DUZ(2),ABMCDFN,9)
+36 MERGE ^ABMDCLM(DUZ(2),ABMC2,10)=^ABMDCLM(DUZ(2),ABMCDFN,10)
+37 ;
+38 ;pcc visits
MERGE ^ABMDCLM(DUZ(2),ABMC2,11)=^ABMDCLM(DUZ(2),ABMCDFN,11)
+39 ;insurers
MERGE ^ABMDCLM(DUZ(2),ABMC2,13)=^ABMDCLM(DUZ(2),ABMCDFN,13)
+40 ;icds
MERGE ^ABMDCLM(DUZ(2),ABMC2,17)=^ABMDCLM(DUZ(2),ABMCDFN,17)
+41 ;providers
MERGE ^ABMDCLM(DUZ(2),ABMC2,41)=^ABMDCLM(DUZ(2),ABMCDFN,41)
+42 ;the specified multiple to be split
+43 IF $GET(ABMMULT)'=""
Begin DoDot:3
+44 MERGE ^ABMDCLM(DUZ(2),ABMC2,ABMMULT)=^ABMDCLM(DUZ(2),ABMCDFN,ABMMULT)
+45 ;should multiple be removed from original claim?
+46 IF $PIECE($GET(^ABMDVTYP(ABMVTYP,2,ABMVFL,0)),U,2)="Y"
Begin DoDot:4
+47 KILL DA
+48 SET DA=0
SET DA(1)=ABMCDFN
+49 FOR
SET DA=$ORDER(^ABMDCLM(DUZ(2),ABMCDFN,ABMMULT,DA))
IF +DA=0
QUIT
Begin DoDot:5
+50 SET DIK="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMMULT_","
+51 DO ^DIK
End DoDot:5
End DoDot:4
End DoDot:3
+52 IF $GET(ABMMULT)=""
MERGE ^ABMDCLM(DUZ(2),ABMC2)=^ABMDCLM(DUZ(2),ABMCDFN)
End DoDot:2
End DoDot:1
+53 QUIT
+54 ;GIVEN A ENCOUNTER/SERVICE DATE AND BEGIN/END DATES OF REPLACEMENT INSURER
+55 ;WHICH REPLACEMENT INSURER IS ACTIVE. NOTE: THERE SHOULD NOT BE MORE THAN ONE
+56 ;REPLACEMENT INSURER ACTIVE FOR ANY GIVEN DATE
ISACTIVE(EFFDT,ENDDT,TARDATE) ;
+1 NEW OPENEND
+2 IF EFFDT=""
IF (ENDDT="")
QUIT 0
+3 ;TRUE IF ENDING DATE IS AT COB OF ENDING DATE - ANSWER FROM ADRIAN IS IT IS
SET ENDDT=ENDDT
+4 ; IN FORCE FOR ALL OF TODAY
+5 SET OPENEND=ENDDT=""
+6 IF OPENEND
IF TARDATE=EFFDT!(TARDATE>EFFDT)
QUIT 1
+7 IF TARDATE=EFFDT!(TARDATE=ENDDT)
QUIT 1
+8 IF TARDATE>EFFDT&(TARDATE<ENDDT)
QUIT 1
+9 QUIT 0
