ABMUUTL ; IHS/SD/SDR - 3PB/UFMS Check for pseudo TIN
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
; New routine - v2.5 p12
;
; IHS/SD/SDR - v2.5 p13 - IM25962
; Fix for missing TIN check; was failing on Bens
;
PTINCK ;EP - check bills about to be exported for
; pseudo TINs
S ABMPTINF=0,ABMMTINF=0
S ABMI=0
F S ABMI=$O(ABMC(ABMI)) Q:+ABMI=0 D
.S ABMDZ=""
.F S ABMDZ=$O(ABMC(ABMI,ABMDZ)) Q:ABMDZ="" D
..S ABMFD=0
..F S ABMFD=$O(ABMC(ABMI,ABMDZ,ABMFD)) Q:+ABMFD=0 D
...S ABMBA=0
...S ABMLOOP=10
...S ABMDUZ=$S(ABMDZ="POS":1,1:ABMDZ)
...S:ABMDUZ=1 ABMLOOP=20
...F S ABMBA=$O(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA)) Q:+ABMBA=0 D
....S ABMBDAC=$P($G(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,0)),U)
....S ABMCDFN=0
....F S ABMCDFN=$O(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,2,ABMCDFN)) Q:+ABMCDFN=0 D
.....S ABMDUZ2=$P($G(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,2)
.....S ABMBIEN=$P($G(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,3)
.....S ABMAINS=$P($G(^ABMDBILL(ABMDUZ2,ABMBIEN,0)),U,8)
.....S ABMTIN=$P($G(^AUTNINS(ABMAINS,0)),U,11)
.....I $G(ABMTIN)="",($P($G(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,0)),U)'="I") D Q ;missing TIN
......S ABMMTINF=1 ;flag for missing TIN
......S ABMMT(ABMAINS)=ABMFD
.....S ABMTIN=$E(ABMTIN,$L(ABMTIN))
.....I $A(ABMTIN)>64&($A(ABMTIN)<91) S ABMPTINF=1,ABMPT(ABMAINS)=ABMTIN ;pseudo TIN
Q
ABBREVCK ;EP - check bills about to be exported for
; visit location abbreviations
S ABMVDFNF=0
S ABMI=0
F S ABMI=$O(ABMC(ABMI)) Q:+ABMI=0 D
.S ABMDZ=""
.F S ABMDZ=$O(ABMC(ABMI,ABMDZ)) Q:ABMDZ="" D
..S ABMFD=0
..F S ABMFD=$O(ABMC(ABMI,ABMDZ,ABMFD)) Q:+ABMFD=0 D
...S ABMBA=0
...S ABMLOOP=10
...S ABMDUZ=$S(ABMDZ="POS":1,1:ABMDZ)
...S:ABMDUZ=1 ABMLOOP=20
...F S ABMBA=$O(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA)) Q:+ABMBA=0 D
....S ABMBDAC=$P($G(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,0)),U)
....S ABMCDFN=0
....F S ABMCDFN=$O(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,2,ABMCDFN)) Q:+ABMCDFN=0 D
.....S ABMDUZ2=$P($G(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,2)
.....S ABMBIEN=$P($G(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,3)
.....S ABMVDFN=$P($G(^ABMDBILL(ABMDUZ2,ABMBIEN,0)),U,3)
.....S ABMVABB=$P($G(^AUTTLOC(ABMVDFN,0)),U,7)
.....I $G(ABMVABB)="",($P($G(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,0)),U)'="I") D Q ;missing abbrev
......S ABMVDFNF=1 ;flag for missing abbrev
......S ABMMABB(ABMVDFN)=ABMFD
Q
ACTIVCK(ABMLOC,ABMSDT,ABMDUZ) ;EP - check if session has activity
S ABMAFLG=0
S ABMBA=0
I +ABMDUZ'=0 D
.F S ABMBA=$O(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,11,ABMBA)) Q:+ABMBA=0 D
..F ABMSEC=1,2,3 D
...I +$O(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,11,ABMBA,ABMSEC,0))'=0 S ABMAFLG=1
.F ABMSEC=12,13 D
..I +$O(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,ABMSEC,0))'=0 S ABMAFLG=1
Q ABMAFLG
;
CASHTOTP ;EP
K ABMABILL,ABMABAMT
K ABMEBILL,ABMEBAMT
S ABMBA=0
S ABMTRIBL=$P($G(^ABMDPARM(ABMLOC,1,4)),U,14)
S ABMUSER=1
F S ABMBA=$O(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA)) Q:+ABMBA=0 D
.S ABMBDAC=$P($G(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,0)),U)
.I $G(ABMTRIBL)=1,(ABMBDAC="I") Q ;if exporting and Ben insurer type
.S ABMCDFN=0
.F S ABMCDFN=$O(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,2,ABMCDFN)) Q:+ABMCDFN=0 D
..S ABMBAL(ABMBDAC,"ABILLS")=+$G(ABMBAL(ABMBDAC,"ABILLS"))+1 ;total approved bills by budget activity
..S ABMABILL=+$G(ABMABILL)+1 ;total approved bills
..S ABMSBTOT=+$G(ABMSBTOT)+1
..S ABMDUZ2=$P($G(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,2)
..S ABMBDFN=$P($G(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,3)
..S ABMBAL(ABMBDAC,"ABAMT")=+$G(ABMBAL(ABMBDAC,"ABAMT"))+($P($G(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
..S ABMSATOT=(+$G(ABMSATOT))+($P($G(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
..S ABMABAMT=$G(ABMABAMT)+($P($G(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U)) ;total approved bill amount
..;now check if bill is part of 3P UFMS Exclusion Table
..Q:$$BILL^ABMUEAPI(ABMDUZ2,$P($G(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,3))=1
..S ABMBAL(ABMBDAC,"EBILLS")=+$G(ABMBAL(ABMBDAC,"EBILLS"))+1
..S ABMEBILL=+$G(ABMEBILL)+1
..S ABMBAL(ABMBDAC,"EBAMT")=+$G(ABMBAL(ABMBDAC,"EBAMT"))+($P($G(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
..S ABMEBAMT=+$G(ABMEBAMT)+($P($G(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
..S ABMTEBIL=+$G(ABMTEBIL)+1 ;total bills (multiple sessions)
..S ABMTEBAM=+$G(ABMTEBAM)+($P($G(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U)) ;total amount (multiple sessions)
;
;cancelled bills
K ABMCBILL,ABMCBAMT
S ABMBA=0
F S ABMBA=$O(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA)) Q:+ABMBA=0 D
.S ABMBDAC=$P($G(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,0)),U)
.S ABMCDFN=0
.F S ABMCDFN=$O(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,3,ABMCDFN)) Q:+ABMCDFN=0 D
..S ABMBAL(ABMBDAC,"CBILLS")=+$G(ABMBAL(ABMBDAC,"CBILLS"))+1
..S ABMCBILL=$G(ABMCBILL)+1 ;session total
..S ABMTCBIL=+$G(ABMTCBIL)+1 ;total bills (multiple sessions)
..S ABMDUZ2=$P($G(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,3,ABMCDFN,0)),U,2)
..S ABMBDFN=$P($G(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,3,ABMCDFN,0)),U,3)
..S ABMBAL(ABMBDAC,"CBAMT")=+$G(ABMBAL(ABMBDAC,"CBAMT"))+($P($G(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
..S ABMCBAMT=+$G(ABMCBAMT)+($P($G(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U)) ;session total
..S ABMTCBAM=+$G(ABMTCBAM)+($P($G(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U)) ;total amount (multiple sessions)
;
Q
ABMUUTL ; IHS/SD/SDR - 3PB/UFMS Check for pseudo TIN
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ; New routine - v2.5 p12
+3 ;
+4 ; IHS/SD/SDR - v2.5 p13 - IM25962
+5 ; Fix for missing TIN check; was failing on Bens
+6 ;
PTINCK ;EP - check bills about to be exported for
+1 ; pseudo TINs
+2 SET ABMPTINF=0
SET ABMMTINF=0
+3 SET ABMI=0
+4 FOR
SET ABMI=$ORDER(ABMC(ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+5 SET ABMDZ=""
+6 FOR
SET ABMDZ=$ORDER(ABMC(ABMI,ABMDZ))
IF ABMDZ=""
QUIT
Begin DoDot:2
+7 SET ABMFD=0
+8 FOR
SET ABMFD=$ORDER(ABMC(ABMI,ABMDZ,ABMFD))
IF +ABMFD=0
QUIT
Begin DoDot:3
+9 SET ABMBA=0
+10 SET ABMLOOP=10
+11 SET ABMDUZ=$SELECT(ABMDZ="POS":1,1:ABMDZ)
+12 IF ABMDUZ=1
SET ABMLOOP=20
+13 FOR
SET ABMBA=$ORDER(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA))
IF +ABMBA=0
QUIT
Begin DoDot:4
+14 SET ABMBDAC=$PIECE($GET(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,0)),U)
+15 SET ABMCDFN=0
+16 FOR
SET ABMCDFN=$ORDER(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,2,ABMCDFN))
IF +ABMCDFN=0
QUIT
Begin DoDot:5
+17 SET ABMDUZ2=$PIECE($GET(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,2)
+18 SET ABMBIEN=$PIECE($GET(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,3)
+19 SET ABMAINS=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMBIEN,0)),U,8)
+20 SET ABMTIN=$PIECE($GET(^AUTNINS(ABMAINS,0)),U,11)
+21 ;missing TIN
IF $GET(ABMTIN)=""
IF ($PIECE($GET(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,0)),U)'="I")
Begin DoDot:6
+22 ;flag for missing TIN
SET ABMMTINF=1
+23 SET ABMMT(ABMAINS)=ABMFD
End DoDot:6
QUIT
+24 SET ABMTIN=$EXTRACT(ABMTIN,$LENGTH(ABMTIN))
+25 ;pseudo TIN
IF $ASCII(ABMTIN)>64&($ASCII(ABMTIN)<91)
SET ABMPTINF=1
SET ABMPT(ABMAINS)=ABMTIN
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+26 QUIT
ABBREVCK ;EP - check bills about to be exported for
+1 ; visit location abbreviations
+2 SET ABMVDFNF=0
+3 SET ABMI=0
+4 FOR
SET ABMI=$ORDER(ABMC(ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+5 SET ABMDZ=""
+6 FOR
SET ABMDZ=$ORDER(ABMC(ABMI,ABMDZ))
IF ABMDZ=""
QUIT
Begin DoDot:2
+7 SET ABMFD=0
+8 FOR
SET ABMFD=$ORDER(ABMC(ABMI,ABMDZ,ABMFD))
IF +ABMFD=0
QUIT
Begin DoDot:3
+9 SET ABMBA=0
+10 SET ABMLOOP=10
+11 SET ABMDUZ=$SELECT(ABMDZ="POS":1,1:ABMDZ)
+12 IF ABMDUZ=1
SET ABMLOOP=20
+13 FOR
SET ABMBA=$ORDER(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA))
IF +ABMBA=0
QUIT
Begin DoDot:4
+14 SET ABMBDAC=$PIECE($GET(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,0)),U)
+15 SET ABMCDFN=0
+16 FOR
SET ABMCDFN=$ORDER(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,2,ABMCDFN))
IF +ABMCDFN=0
QUIT
Begin DoDot:5
+17 SET ABMDUZ2=$PIECE($GET(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,2)
+18 SET ABMBIEN=$PIECE($GET(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,3)
+19 SET ABMVDFN=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMBIEN,0)),U,3)
+20 SET ABMVABB=$PIECE($GET(^AUTTLOC(ABMVDFN,0)),U,7)
+21 ;missing abbrev
IF $GET(ABMVABB)=""
IF ($PIECE($GET(^ABMUCASH(ABMLOC,ABMLOOP,ABMDUZ,20,ABMFD,11,ABMBA,0)),U)'="I")
Begin DoDot:6
+22 ;flag for missing abbrev
SET ABMVDFNF=1
+23 SET ABMMABB(ABMVDFN)=ABMFD
End DoDot:6
QUIT
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
ACTIVCK(ABMLOC,ABMSDT,ABMDUZ) ;EP - check if session has activity
+1 SET ABMAFLG=0
+2 SET ABMBA=0
+3 IF +ABMDUZ'=0
Begin DoDot:1
+4 FOR
SET ABMBA=$ORDER(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,11,ABMBA))
IF +ABMBA=0
QUIT
Begin DoDot:2
+5 FOR ABMSEC=1,2,3
Begin DoDot:3
+6 IF +$ORDER(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,11,ABMBA,ABMSEC,0))'=0
SET ABMAFLG=1
End DoDot:3
End DoDot:2
+7 FOR ABMSEC=12,13
Begin DoDot:2
+8 IF +$ORDER(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,ABMSEC,0))'=0
SET ABMAFLG=1
End DoDot:2
End DoDot:1
+9 QUIT ABMAFLG
+10 ;
CASHTOTP ;EP
+1 KILL ABMABILL,ABMABAMT
+2 KILL ABMEBILL,ABMEBAMT
+3 SET ABMBA=0
+4 SET ABMTRIBL=$PIECE($GET(^ABMDPARM(ABMLOC,1,4)),U,14)
+5 SET ABMUSER=1
+6 FOR
SET ABMBA=$ORDER(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA))
IF +ABMBA=0
QUIT
Begin DoDot:1
+7 SET ABMBDAC=$PIECE($GET(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,0)),U)
+8 ;if exporting and Ben insurer type
IF $GET(ABMTRIBL)=1
IF (ABMBDAC="I")
QUIT
+9 SET ABMCDFN=0
+10 FOR
SET ABMCDFN=$ORDER(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,2,ABMCDFN))
IF +ABMCDFN=0
QUIT
Begin DoDot:2
+11 ;total approved bills by budget activity
SET ABMBAL(ABMBDAC,"ABILLS")=+$GET(ABMBAL(ABMBDAC,"ABILLS"))+1
+12 ;total approved bills
SET ABMABILL=+$GET(ABMABILL)+1
+13 SET ABMSBTOT=+$GET(ABMSBTOT)+1
+14 SET ABMDUZ2=$PIECE($GET(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,2)
+15 SET ABMBDFN=$PIECE($GET(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,3)
+16 SET ABMBAL(ABMBDAC,"ABAMT")=+$GET(ABMBAL(ABMBDAC,"ABAMT"))+($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
+17 SET ABMSATOT=(+$GET(ABMSATOT))+($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
+18 ;total approved bill amount
SET ABMABAMT=$GET(ABMABAMT)+($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
+19 ;now check if bill is part of 3P UFMS Exclusion Table
+20 IF $$BILL^ABMUEAPI(ABMDUZ2,$PIECE($GET(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,2,ABMCDFN,0)),U,3))=1
QUIT
+21 SET ABMBAL(ABMBDAC,"EBILLS")=+$GET(ABMBAL(ABMBDAC,"EBILLS"))+1
+22 SET ABMEBILL=+$GET(ABMEBILL)+1
+23 SET ABMBAL(ABMBDAC,"EBAMT")=+$GET(ABMBAL(ABMBDAC,"EBAMT"))+($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
+24 SET ABMEBAMT=+$GET(ABMEBAMT)+($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
+25 ;total bills (multiple sessions)
SET ABMTEBIL=+$GET(ABMTEBIL)+1
+26 ;total amount (multiple sessions)
SET ABMTEBAM=+$GET(ABMTEBAM)+($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
End DoDot:2
End DoDot:1
+27 ;
+28 ;cancelled bills
+29 KILL ABMCBILL,ABMCBAMT
+30 SET ABMBA=0
+31 FOR
SET ABMBA=$ORDER(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA))
IF +ABMBA=0
QUIT
Begin DoDot:1
+32 SET ABMBDAC=$PIECE($GET(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,0)),U)
+33 SET ABMCDFN=0
+34 FOR
SET ABMCDFN=$ORDER(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,3,ABMCDFN))
IF +ABMCDFN=0
QUIT
Begin DoDot:2
+35 SET ABMBAL(ABMBDAC,"CBILLS")=+$GET(ABMBAL(ABMBDAC,"CBILLS"))+1
+36 ;session total
SET ABMCBILL=$GET(ABMCBILL)+1
+37 ;total bills (multiple sessions)
SET ABMTCBIL=+$GET(ABMTCBIL)+1
+38 SET ABMDUZ2=$PIECE($GET(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,3,ABMCDFN,0)),U,2)
+39 SET ABMBDFN=$PIECE($GET(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMFD,11,ABMBA,3,ABMCDFN,0)),U,3)
+40 SET ABMBAL(ABMBDAC,"CBAMT")=+$GET(ABMBAL(ABMBDAC,"CBAMT"))+($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
+41 ;session total
SET ABMCBAMT=+$GET(ABMCBAMT)+($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
+42 ;total amount (multiple sessions)
SET ABMTCBAM=+$GET(ABMTCBAM)+($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMBDFN,2)),U))
End DoDot:2
End DoDot:1
+43 ;
+44 QUIT
