ABMUCUTL ; IHS/SD/SDR - 3PB/UFMS Cashiering Utilities
;;2.6;IHS Third Party Billing;**1,3,4,6,8,10,11,21**;NOV 12, 2009;Build 379
; New routine - v2.5 p12 SDD item 4.9.1
; Cashiering Utilities
;
; IHS/SD/SDR - v2.5 p13 - IM25924 - <UNDEF>EP+32^ABMUCAPI
; IHS/SD/SDR - abm*2.6*1 - HEAT4323 - Added Quit if tribal to ADDBENTR
; IHS/SD/SDR - abm*2.6*1 - FIXPMS10011 - Added DOS to GETBILL
; IHS/SD/SDR - abm*2.6*4 - NOHEAT - fix for duplicate bills when ITYP changes
; IHS/SD/SDR - abm*2.6*6 - HEAT27136 - Bug found when two parents on same database.
;IHS/SD/SDR - 2.6*21 - HEAT121470 - Updated to use a new x-ref for session status. Taking
; too long to look through all sessions and causing <STORE>FINDACLS+22^ABMUCUTL
;
FINDOPEN(ABMDUZ) ;EP - look for open session for one user
; 0 returned means no open session found
; anything else means there's an open session (IEN of session will be returned)
;
I $G(SDRAML)'="" Q 1
S:+$G(ABMLOC)=0 ABMLOC=$$FINDLOC ;what location to look under
S ABMFD=0
S ABMSDT=0
F S ABMSDT=$O(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0
.I $P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,3)'="" Q
.S ABMFD=ABMSDT
Q ABMFD
FINDAOPN ;EP - look for all open sessions
D FINDAOPN^ABMUCUT2 ;abm*2.6*21 IHS/SD/SDR HEAT121470 split routine
Q
FINDACLS ;EP - look for all closed sessions
; 0 returned means no closed sessions found
; anything else is list of closed sessions (ABMO(SESSION#,DUZ,SDT)
D FINDACLS^ABMUCUT2 ;abm*2.6*21 IHS/SD/SDR HEAT121470 split routine
Q
FINDALLS ;EP - look for all sessions
; 0 returned means no sessions found
; anything else is list of sessions (ABMO(SESSION#,DUZ,SDT)
;
K ABMO
S ABMLOC=$$FINDLOC ;what location to look under
S ABMFD=0
S ABMDUZ=0
F S ABMDUZ=$O(^ABMUCASH(ABMLOC,10,ABMDUZ)) Q:+ABMDUZ=0 D
.S ABMSDT=0
.F S ABMSDT=$O(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0
..I $P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,3)="" Q
..S ABMO(ABMSDT,ABMDUZ,ABMSDT)=""
Q
;
CR8SESS() ;EP - create new session in file
;location
S ABMLOC=$$FINDLOC
K DIC,DIE,X,Y,DA
S DIC="^ABMUCASH("
S DIC(0)="LMN"
S (X,DINUM)="`"_ABMLOC
D ^DIC
I Y<0 Q 0
S ABMLOC=+Y
;
;user
K DIC,DIE,X,Y,DA
S DA(1)=ABMLOC
S DIC="^ABMUCASH(DA(1),10,"
S DIC(0)="LMN"
S DIC("P")=$P(^DD(9002274.45,".02",0),U,2)
S (X,DINUM)="`"_DUZ
D ^DIC
I Y<0 Q 0
S ABMUSER=+Y
;
;sign in date
K DIC,DIE,X,Y,DA
S DA(2)=ABMLOC
S DA(1)=ABMUSER
S DIC="^ABMUCASH("_DA(2)_",10,"_DA(1)_",20,"
S X="NOW"
S DIC(0)="LMO"
S DIC("P")=$P(^DD(9002274.4502,".02",0),U,2)
S DIC("DR")=".04////O"
D ^DIC
I Y<0 Q 0
Q Y
;
CLOSESES(ABMLOC,ABMDUZ,ABMFD) ;EP - close session
K DIC,DIE,X,Y,DA
I ABMDUZ D
.S DA(2)=ABMLOC
.S DA(1)=ABMDUZ
.S DIE="^ABMUCASH("_DA(2)_",10,"_DA(1)_",20,"
.S DA=ABMFD
.S DR=".03///NOW;.04////C"
.S DR=DR_";.05////"_+$G(ABMSBTOT)_";.06////"_+$G(ABMSATOT)
I 'ABMDUZ D ;POS session
.S DA(2)=ABMLOC
.S DA(1)=1
.S DIE="^ABMUCASH("_DA(2)_",20,"_DA(1)_",20,"
.S DA=ABMFD
.S DR=".03///NOW;.04////C"
.S DR=DR_";.05////"_+$G(ABMSBTOT)_";.06////"_+$G(ABMSATOT)
D ^DIE
Q
;
ADDBENTR(ABMGRP,ABMBIEN) ;EP - Add claim/bill to session log
;ABMGRP=can claim/can bill/appr bill
;ABMBIEN=bill IEN
I $D(ZTQUEUED),($G(ABMAUTOF)=1) D AUTOUFMS^ABMEAUTO Q ;create/update entry for auto-approve claims
S ABMLOC=$$FINDLOC() ;find location to file bill for
S ABMTRIBL=$P($G(^ABMDPARM(DUZ(2),1,4)),U,14)
;Q:ABMTRIBL=0 ;abm*2.6*1 HEAT4323 ;abm*2.6*3 HEAT13663
S ABMSDT=$$FINDOPEN(DUZ) ;find open session
Q:+$G(ABMSDT)=0 ;no open session
;I ABMGRP["BILL" S ABMITYP=$P($G(^AUTNINS($P($G(^ABMDBILL(DUZ(2),ABMBIEN,0)),U,8),2)),U) ;abm*2.6*4 NOHEAT
I ABMGRP["BILL" S ABMITYP=$P($G(^ABMDBILL(DUZ(2),ABMBIEN,2)),U,2) ;abm*2.6*4 NOHEAT
;E S ABMITYP=$P($G(^AUTNINS($P($G(^ABMDCLM(DUZ(2),ABMBIEN,0)),U,8),2)),U)
E D
.S ABMITYP=""
.;S:$P($G(^ABMDCLM(DUZ(2),ABMBIEN,0)),U,8) ABMITYP=$P($G(^AUTNINS($P($G(^ABMDCLM(DUZ(2),ABMBIEN,0)),U,8),2)),U) ;abm*2.6*10 HEAT73780
.S:$P($G(^ABMDCLM(DUZ(2),ABMBIEN,0)),U,8) ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P($G(^ABMDCLM(DUZ(2),ABMBIEN,0)),U,8),".211","I"),1,"I") ;abm*2.6*10 HEAT73780
.I ABMITYP="" S ABMITYP=$S($P($G(^AUPNPAT($P(^ABMDCLM(DUZ(2),ABMBIEN,0),U),11)),U,12)="I":"N",1:"I")
I ABMITYP="I" D
.K DIC,DIE,X,Y,DA
.S DA(2)=ABMLOC
.S DA(1)=DUZ
.S DA=ABMSDT
.S DIE="^ABMUCASH("_DA(2)_",10,"_DA(1)_",20,"
.S DR=".11////"_($P($G(^ABMUCASH(DA(2),10,DA(1),20,DA,0)),U,11)+1) ;ben count
.D ^DIE
;
K DIC,DIE,X,Y,DA
S DA(3)=ABMLOC
S DA(2)=DUZ
S DA(1)=ABMSDT
S DIC="^ABMUCASH("_DA(3)_",10,"_DA(2)_",20,"_DA(1)_",11,"
S DIC(0)="LM" ;insurer type
S X=ABMITYP
D ^DIC
I +Y<0 W !,"NO ENTRY IN CASHIERING SESSION MADE",! H 2 Q
S ABMBA=+Y
K DIC,DIE,X,Y,DA
S DA(4)=ABMLOC
S DA(3)=DUZ
S DA(2)=ABMSDT
S DA(1)=ABMBA
S:ABMGRP="ABILL"!(ABMGRP="CBILL") X=$P($G(^ABMDBILL(DUZ(2),ABMBIEN,0)),U)
S:ABMGRP="CCLM" X=ABMBIEN
S ABMGRP=$S(ABMGRP="CCLM":1,ABMGRP="ABILL":2,1:3) ;what multiple to file in
S DIC="^ABMUCASH("_DA(4)_",10,"_DA(3)_",20,"_DA(2)_",11,"_DA(1)_","_ABMGRP_","
S DIC("P")=$P(^DD(9002274.4510211,ABMGRP,0),U,2)
S DIC(0)="LM"
S DIC("DR")=".02////"_DUZ(2)_";.03////"_ABMBIEN
D ^DIC
Q
REQBILL(ABMBIEN) ;EP - Add bill to requeue session log
;ABMBIEN=bill IEN
S ABMLOC=$$FINDLOC() ;find location to file bill for
S ABMSDT=$$FINDOPEN(DUZ) ;find open session
I ABMSDT=0 D Q:ABMANS=0 ;no open session found; ask if they want to create one
.K DIR,DIC,DIE,X,Y,DA
.S DIR(0)="Y"
.W !
.S DIR("A",1)="No open session was found for you."
.S DIR("A")="Would you like to open a session"
.D ^DIR K DIR
.S ABMANS=+Y
I ABMSDT=0 S ABMSDT=$P($$CR8SESS^ABMUCUTL,U) ;create session
K DIC,DIE,X,Y,DA
S DA(3)=ABMLOC
S DA(2)=DUZ
S DA(1)=ABMSDT
S DIC="^ABMUCASH("_DA(3)_",10,"_DA(2)_",20,"_DA(1)_",12,"
S DIC(0)="LM"
S X=$P($G(^ABMDBILL(DUZ(2),ABMBIEN,0)),U)
S DIC("DR")=".02////"_DUZ(2)_";.03////"_ABMBIEN
D ^DIC
I +Y<0 W !,"NO ENTRY IN CASHIERING SESSION MADE",! H 2 Q
Q
;
BDISPLAY(ABMXMIT) ;EP - view batch info
;ABMXMIT=batch IEN into 3P UFMS EXPORTS file
D HOME^%ZIS
S $P(ABMLINE,"-",80)="-"
W $$EN^ABMVDF("IOF")
W !
D CENTER("UFMS EXPORT SUMMARY")
W !!,"EXPORT DATE: ",$$CDT^ABMDUTL($P($G(^ABMUTXMT(ABMXMIT,0)),U))
W !,"FILE NAME: ",$P($G(^ABMUTXMT(ABMXMIT,0)),U,2)
W !!?5,"BUDGET ACTIVITY"
W ?32,"BILL COUNT"
W ?48,"AMOUNT"
W !,ABMLINE,!
D GETBTDTL(ABMXMIT) ;get batch detail
S ABMSESSN=0
F S ABMSESSN=$O(ABMO(ABMSESSN)) Q:+ABMSESSN=0 D
.S ABMUSER=""
.F S ABMUSER=$O(ABMO(ABMSESSN,ABMUSER)) Q:ABMUSER="" D
..W !,"SESSION ID: ",ABMSESSN
..W ?30,"BILLER: ",$S(ABMUSER:$P($G(^VA(200,ABMUSER,0)),U),1:"POS CLAIMS"),!
..S ABMBAU=""
..F S ABMBAU=$O(ABMO(ABMSESSN,ABMUSER,ABMBAU)) Q:ABMBAU="" D
...S ABMBACNT=+$P($G(ABMO(ABMSESSN,ABMUSER,ABMBAU)),U)
...S ABMBATOT=+$P($G(ABMO(ABMSESSN,ABMUSER,ABMBAU)),U,2)
...W !
...;W ?5,$P($T(@ABMBAU^ABMUCASH),";;",2) ;abm*2.6*11 insurer type
...W ?5,$$INSTYP^ABMUCASH(ABMBAU) ;abm*2.6*11 insurer type
...W ?32,ABMBACNT,$S(ABMBACNT=1:" bill",1:" bills")
...W ?45,$$FMT^ABMERUTL($J(ABMBATOT,".",2),"10R")
W !!,"TOTAL BILLS FOR THIS SESSION: ",?32,$P($G(ABMO("TOTAL")),U),$S($P($G(ABMO("TOTAL")),U)=1:" BILL",1:" BILLS"),?45,$$FMT^ABMERUTL($J($P($G(ABMO("TOTAL")),U,2),".",2),"10R")
Q
GETBTDTL(ABMXMIT) ;EP - get batch detail; return in array
; ABMO(SESSION#,DUZ,BUDGETACT)=COUNT^AMOUNT
; ABMO("TOTAL")=TOTALCOUNT^TOTALAMOUNT
;
K ABMO
F ABMLOOP=1,2 D
.S ABMUSER=0
.F S ABMUSER=$O(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER)) Q:+ABMUSER=0 D
..S ABMUSERU=ABMUSER
..I ABMLOOP=2 S ABMUSERU="POS"
..S ABMSDT=0
..F S ABMSDT=$O(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER,2,ABMSDT)) Q:+ABMSDT=0 D
...S ABMBA=0
...F S ABMBA=$O(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER,2,ABMSDT,11,ABMBA)) Q:+ABMBA=0 D
....S ABMBAU=$P($G(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER,2,ABMSDT,11,ABMBA,0)),U)
....S ABMBILL=0
....F S ABMBILL=$O(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER,2,ABMSDT,11,ABMBA,2,ABMBILL)) Q:+ABMBILL=0 D
.....S ABMBIEN=$P($G(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER,2,ABMSDT,11,ABMBA,2,ABMBILL,0)),U,3)
.....S ABMBAMT=$P($G(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER,2,ABMSDT,11,ABMBA,2,ABMBILL,0)),U,4)
.....S $P(ABMO(ABMSDT,ABMUSERU,ABMBAU),U)=+$P($G(ABMO(ABMSDT,ABMUSERU,ABMBAU)),U)+1
.....S $P(ABMO(ABMSDT,ABMUSERU,ABMBAU),U,2)=+$P($G(ABMO(ABMSDT,ABMUSERU,ABMBAU)),U,2)+ABMBAMT
.....S $P(ABMO("TOTAL"),U)=+$P($G(ABMO("TOTAL")),U)+1
.....S $P(ABMO("TOTAL"),U,2)=+$P($G(ABMO("TOTAL")),U,2)+ABMBAMT
K ABMUSER,ABMSDT,ABMBA,ABMBILL,ABMBIEN,ABMBAU,ABMUSERU
Q
REQBTCH(ABMBIEN) ;EP - Add bill to requeue session log
;ABMBIEN=batch IEN
S ABMLOC=$$FINDLOC() ;find location to file bill for
S ABMSDT=$$FINDOPEN(DUZ) ;find open session
I ABMSDT=0 D Q:ABMANS=0 ;no open session found; ask if they want to create one
.K DIR,DIC,DIE,X,Y,DA
.S DIR(0)="Y"
.W !
.S DIR("A",1)="No open session was found for you."
.S DIR("A")="Would you like to open a session"
.D ^DIR K DIR
.S ABMANS=+Y
I ABMSDT=0 S ABMSDT=$P($$CR8SESS^ABMUCUTL,U) ;create session
K DIC,DIE,X,Y,DA
S DA(3)=ABMLOC
S DA(2)=DUZ
S DA(1)=ABMSDT
S DIC="^ABMUCASH(DA(3),10,DA(2),20,DA(1),13,"
S DIC(0)="LM"
S X="`"_ABMBIEN
D ^DIC
I +Y<0 W !,"NO ENTRY IN CASHIERING SESSION MADE",! H 2 Q
Q
;
FINDLOC() ;EP - return what site should bills be filed under for export
K ABMPSFLG
;S ABMLOC=DUZ(2) ;abm*2.6*6 HEAT27136
S ABMBLOC=DUZ(2) ;abm*2.6*6 HEAT27136
S:$G(ABMP("LDFN"))="" ABMP("LDFN")=DUZ(2)
S:$G(ABMP("VDT"))="" ABMP("VDT")=DT
S ABMPAR=0
F S ABMPAR=$O(^BAR(90052.05,ABMPAR)) Q:+ABMPAR=0 D Q:($G(ABMPSFLG)=1)
.I $D(^BAR(90052.05,ABMPAR,ABMP("LDFN"))) D
..; Use A/R parent/sat is yes, but DUZ(2) is not the parent for this
..; visit location
..Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,3)'=ABMPAR
..Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,6)>ABMP("VDT")
..Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,7)&($P(^(0),U,7)<ABMP("VDT"))
..;S ABMLOC=ABMPAR,ABMPSFLG=1 ;abm*2.6*6 HEAT27136
..S ABMBLOC=ABMPAR,ABMPSFLG=1 ;abm*2.6*6 HEAT27136
;Q ABMLOC ;abm*2.6*6 HEAT27136
Q ABMBLOC ;abm*2.6*6 HEAT27136
GETBILL(ABMPREC) ;EP - get bill info from appropriate 3P Bill file
S ABMHOLD=DUZ(2)
S DUZ(2)=$P(ABMPREC,U,2)
;S ABMLOC=$$FINDLOC^ABMUCUTL ;abm*2.6*8 HEAT27136
S ABMBLOC=$$FINDLOC^ABMUCUTL ;abm*2.6*8 HEAT27136
S ABMP("BDFN")=$P(ABMPREC,U,3)
S ABMDTAPP=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,5) ;date/time approved
S ABMP("INS")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8) ;active insurer
S ABMTAXID=$TR($P($G(^AUTNINS(ABMP("INS"),0)),U,11),"-") ;TAX ID
S ABMP("LDFN")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,3) ;visit location
S ABMPDOS=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,1) ;service date
;S ABMPASUF=$$ASUFAC(ABMLOC,ABMPDOS) ;abm*2.6*6 HEAT27136
S ABMPASUF=$$ASUFAC(ABMBLOC,ABMPDOS) ;abm*2.6*6 HEAT27136
S ABMUAOF=$P($G(^ABMDPARM(ABMP("LDFN"),1,4)),U,17) ;use asufac of
S ABMSASUF=$$ASUFAC($S(+$G(ABMUAOF)'=0:ABMUAOF,1:ABMP("LDFN")),ABMPDOS)
S ABMPBNUM=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U) ;Bill Number
S ABMP("BAMT")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U) ;bill amount
;S ABMP("ITYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ;abm*2.6*10 HEAT73780
S ABMP("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I") ;abm*2.6*10 HEAT73780
S ABMCLN=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10)
S ABMP("VTYP")=$P($G(^ABMDVTYP($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,7),0)),U) ;abm*2.6*1 visit type description FIXPMS10011
S ABMP("DOS")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U) ;DOS abm*2.6*1 FIXPMS10011
S DUZ(2)=ABMHOLD
Q
;
ASUFAC(X,Y) ;EP - get ASUFAC for DOS
K ASUFAC
S ASUFAC=0
S ABMDT=0
S ABMDTFLG=0
S ASUFAC=$P($G(^AUTTLOC(X,0)),U,10) ;ASUFAC index
Q:+$G(ASUFAC)'=0 ASUFAC ;ASUFAC found; stop here
F S ABMDT=$O(^AUTTLOC(X,11,ABMDT)) Q:ABMDT=""!(ABMDTFLG=1) D
.I Y>$P($G(^AUTTLOC(X,11,ABMDT,0)),U) D
..S ASUFAC=$P($G(^AUTTLOC(X,11,ABMDT,0)),U,6)
..S ABMDTFLG=1
Q ASUFAC
;
CENTER(X) ;EP
S CENTER=IOM/2
W ?CENTER-($L(X)/2),X
Q
ABMUCUTL ; IHS/SD/SDR - 3PB/UFMS Cashiering Utilities
+1 ;;2.6;IHS Third Party Billing;**1,3,4,6,8,10,11,21**;NOV 12, 2009;Build 379
+2 ; New routine - v2.5 p12 SDD item 4.9.1
+3 ; Cashiering Utilities
+4 ;
+5 ; IHS/SD/SDR - v2.5 p13 - IM25924 - <UNDEF>EP+32^ABMUCAPI
+6 ; IHS/SD/SDR - abm*2.6*1 - HEAT4323 - Added Quit if tribal to ADDBENTR
+7 ; IHS/SD/SDR - abm*2.6*1 - FIXPMS10011 - Added DOS to GETBILL
+8 ; IHS/SD/SDR - abm*2.6*4 - NOHEAT - fix for duplicate bills when ITYP changes
+9 ; IHS/SD/SDR - abm*2.6*6 - HEAT27136 - Bug found when two parents on same database.
+10 ;IHS/SD/SDR - 2.6*21 - HEAT121470 - Updated to use a new x-ref for session status. Taking
+11 ; too long to look through all sessions and causing <STORE>FINDACLS+22^ABMUCUTL
+12 ;
FINDOPEN(ABMDUZ) ;EP - look for open session for one user
+1 ; 0 returned means no open session found
+2 ; anything else means there's an open session (IEN of session will be returned)
+3 ;
+4 IF $GET(SDRAML)'=""
QUIT 1
+5 ;what location to look under
IF +$GET(ABMLOC)=0
SET ABMLOC=$$FINDLOC
+6 SET ABMFD=0
+7 SET ABMSDT=0
+8 FOR
SET ABMSDT=$ORDER(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT))
IF +ABMSDT=0
QUIT
Begin DoDot:1
+9 IF $PIECE($GET(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,3)'=""
QUIT
+10 SET ABMFD=ABMSDT
End DoDot:1
IF ABMFD'=0
QUIT
+11 QUIT ABMFD
FINDAOPN ;EP - look for all open sessions
+1 ;abm*2.6*21 IHS/SD/SDR HEAT121470 split routine
DO FINDAOPN^ABMUCUT2
+2 QUIT
FINDACLS ;EP - look for all closed sessions
+1 ; 0 returned means no closed sessions found
+2 ; anything else is list of closed sessions (ABMO(SESSION#,DUZ,SDT)
+3 ;abm*2.6*21 IHS/SD/SDR HEAT121470 split routine
DO FINDACLS^ABMUCUT2
+4 QUIT
FINDALLS ;EP - look for all sessions
+1 ; 0 returned means no sessions found
+2 ; anything else is list of sessions (ABMO(SESSION#,DUZ,SDT)
+3 ;
+4 KILL ABMO
+5 ;what location to look under
SET ABMLOC=$$FINDLOC
+6 SET ABMFD=0
+7 SET ABMDUZ=0
+8 FOR
SET ABMDUZ=$ORDER(^ABMUCASH(ABMLOC,10,ABMDUZ))
IF +ABMDUZ=0
QUIT
Begin DoDot:1
+9 SET ABMSDT=0
+10 FOR
SET ABMSDT=$ORDER(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT))
IF +ABMSDT=0
QUIT
Begin DoDot:2
+11 IF $PIECE($GET(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,3)=""
QUIT
+12 SET ABMO(ABMSDT,ABMDUZ,ABMSDT)=""
End DoDot:2
IF ABMFD'=0
QUIT
End DoDot:1
+13 QUIT
+14 ;
CR8SESS() ;EP - create new session in file
+1 ;location
+2 SET ABMLOC=$$FINDLOC
+3 KILL DIC,DIE,X,Y,DA
+4 SET DIC="^ABMUCASH("
+5 SET DIC(0)="LMN"
+6 SET (X,DINUM)="`"_ABMLOC
+7 DO ^DIC
+8 IF Y<0
QUIT 0
+9 SET ABMLOC=+Y
+10 ;
+11 ;user
+12 KILL DIC,DIE,X,Y,DA
+13 SET DA(1)=ABMLOC
+14 SET DIC="^ABMUCASH(DA(1),10,"
+15 SET DIC(0)="LMN"
+16 SET DIC("P")=$PIECE(^DD(9002274.45,".02",0),U,2)
+17 SET (X,DINUM)="`"_DUZ
+18 DO ^DIC
+19 IF Y<0
QUIT 0
+20 SET ABMUSER=+Y
+21 ;
+22 ;sign in date
+23 KILL DIC,DIE,X,Y,DA
+24 SET DA(2)=ABMLOC
+25 SET DA(1)=ABMUSER
+26 SET DIC="^ABMUCASH("_DA(2)_",10,"_DA(1)_",20,"
+27 SET X="NOW"
+28 SET DIC(0)="LMO"
+29 SET DIC("P")=$PIECE(^DD(9002274.4502,".02",0),U,2)
+30 SET DIC("DR")=".04////O"
+31 DO ^DIC
+32 IF Y<0
QUIT 0
+33 QUIT Y
+34 ;
CLOSESES(ABMLOC,ABMDUZ,ABMFD) ;EP - close session
+1 KILL DIC,DIE,X,Y,DA
+2 IF ABMDUZ
Begin DoDot:1
+3 SET DA(2)=ABMLOC
+4 SET DA(1)=ABMDUZ
+5 SET DIE="^ABMUCASH("_DA(2)_",10,"_DA(1)_",20,"
+6 SET DA=ABMFD
+7 SET DR=".03///NOW;.04////C"
+8 SET DR=DR_";.05////"_+$GET(ABMSBTOT)_";.06////"_+$GET(ABMSATOT)
End DoDot:1
+9 ;POS session
IF 'ABMDUZ
Begin DoDot:1
+10 SET DA(2)=ABMLOC
+11 SET DA(1)=1
+12 SET DIE="^ABMUCASH("_DA(2)_",20,"_DA(1)_",20,"
+13 SET DA=ABMFD
+14 SET DR=".03///NOW;.04////C"
+15 SET DR=DR_";.05////"_+$GET(ABMSBTOT)_";.06////"_+$GET(ABMSATOT)
End DoDot:1
+16 DO ^DIE
+17 QUIT
+18 ;
ADDBENTR(ABMGRP,ABMBIEN) ;EP - Add claim/bill to session log
+1 ;ABMGRP=can claim/can bill/appr bill
+2 ;ABMBIEN=bill IEN
+3 ;create/update entry for auto-approve claims
IF $DATA(ZTQUEUED)
IF ($GET(ABMAUTOF)=1)
DO AUTOUFMS^ABMEAUTO
QUIT
+4 ;find location to file bill for
SET ABMLOC=$$FINDLOC()
+5 SET ABMTRIBL=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,14)
+6 ;Q:ABMTRIBL=0 ;abm*2.6*1 HEAT4323 ;abm*2.6*3 HEAT13663
+7 ;find open session
SET ABMSDT=$$FINDOPEN(DUZ)
+8 ;no open session
IF +$GET(ABMSDT)=0
QUIT
+9 ;I ABMGRP["BILL" S ABMITYP=$P($G(^AUTNINS($P($G(^ABMDBILL(DUZ(2),ABMBIEN,0)),U,8),2)),U) ;abm*2.6*4 NOHEAT
+10 ;abm*2.6*4 NOHEAT
IF ABMGRP["BILL"
SET ABMITYP=$PIECE($GET(^ABMDBILL(DUZ(2),ABMBIEN,2)),U,2)
+11 ;E S ABMITYP=$P($G(^AUTNINS($P($G(^ABMDCLM(DUZ(2),ABMBIEN,0)),U,8),2)),U)
+12 IF '$TEST
Begin DoDot:1
+13 SET ABMITYP=""
+14 ;S:$P($G(^ABMDCLM(DUZ(2),ABMBIEN,0)),U,8) ABMITYP=$P($G(^AUTNINS($P($G(^ABMDCLM(DUZ(2),ABMBIEN,0)),U,8),2)),U) ;abm*2.6*10 HEAT73780
+15 ;abm*2.6*10 HEAT73780
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMBIEN,0)),U,8)
SET ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$PIECE($GET(^ABMDCLM(DUZ(2),ABMBIEN,0)),U,8),".211","I"),1,"I")
+16 IF ABMITYP=""
SET ABMITYP=$SELECT($PIECE($GET(^AUPNPAT($PIECE(^ABMDCLM(DUZ(2),ABMBIEN,0),U),11)),U,12)="I":"N",1:"I")
End DoDot:1
+17 IF ABMITYP="I"
Begin DoDot:1
+18 KILL DIC,DIE,X,Y,DA
+19 SET DA(2)=ABMLOC
+20 SET DA(1)=DUZ
+21 SET DA=ABMSDT
+22 SET DIE="^ABMUCASH("_DA(2)_",10,"_DA(1)_",20,"
+23 ;ben count
SET DR=".11////"_($PIECE($GET(^ABMUCASH(DA(2),10,DA(1),20,DA,0)),U,11)+1)
+24 DO ^DIE
End DoDot:1
+25 ;
+26 KILL DIC,DIE,X,Y,DA
+27 SET DA(3)=ABMLOC
+28 SET DA(2)=DUZ
+29 SET DA(1)=ABMSDT
+30 SET DIC="^ABMUCASH("_DA(3)_",10,"_DA(2)_",20,"_DA(1)_",11,"
+31 ;insurer type
SET DIC(0)="LM"
+32 SET X=ABMITYP
+33 DO ^DIC
+34 IF +Y<0
WRITE !,"NO ENTRY IN CASHIERING SESSION MADE",!
HANG 2
QUIT
+35 SET ABMBA=+Y
+36 KILL DIC,DIE,X,Y,DA
+37 SET DA(4)=ABMLOC
+38 SET DA(3)=DUZ
+39 SET DA(2)=ABMSDT
+40 SET DA(1)=ABMBA
+41 IF ABMGRP="ABILL"!(ABMGRP="CBILL")
SET X=$PIECE($GET(^ABMDBILL(DUZ(2),ABMBIEN,0)),U)
+42 IF ABMGRP="CCLM"
SET X=ABMBIEN
+43 ;what multiple to file in
SET ABMGRP=$SELECT(ABMGRP="CCLM":1,ABMGRP="ABILL":2,1:3)
+44 SET DIC="^ABMUCASH("_DA(4)_",10,"_DA(3)_",20,"_DA(2)_",11,"_DA(1)_","_ABMGRP_","
+45 SET DIC("P")=$PIECE(^DD(9002274.4510211,ABMGRP,0),U,2)
+46 SET DIC(0)="LM"
+47 SET DIC("DR")=".02////"_DUZ(2)_";.03////"_ABMBIEN
+48 DO ^DIC
+49 QUIT
REQBILL(ABMBIEN) ;EP - Add bill to requeue session log
+1 ;ABMBIEN=bill IEN
+2 ;find location to file bill for
SET ABMLOC=$$FINDLOC()
+3 ;find open session
SET ABMSDT=$$FINDOPEN(DUZ)
+4 ;no open session found; ask if they want to create one
IF ABMSDT=0
Begin DoDot:1
+5 KILL DIR,DIC,DIE,X,Y,DA
+6 SET DIR(0)="Y"
+7 WRITE !
+8 SET DIR("A",1)="No open session was found for you."
+9 SET DIR("A")="Would you like to open a session"
+10 DO ^DIR
KILL DIR
+11 SET ABMANS=+Y
End DoDot:1
IF ABMANS=0
QUIT
+12 ;create session
IF ABMSDT=0
SET ABMSDT=$PIECE($$CR8SESS^ABMUCUTL,U)
+13 KILL DIC,DIE,X,Y,DA
+14 SET DA(3)=ABMLOC
+15 SET DA(2)=DUZ
+16 SET DA(1)=ABMSDT
+17 SET DIC="^ABMUCASH("_DA(3)_",10,"_DA(2)_",20,"_DA(1)_",12,"
+18 SET DIC(0)="LM"
+19 SET X=$PIECE($GET(^ABMDBILL(DUZ(2),ABMBIEN,0)),U)
+20 SET DIC("DR")=".02////"_DUZ(2)_";.03////"_ABMBIEN
+21 DO ^DIC
+22 IF +Y<0
WRITE !,"NO ENTRY IN CASHIERING SESSION MADE",!
HANG 2
QUIT
+23 QUIT
+24 ;
BDISPLAY(ABMXMIT) ;EP - view batch info
+1 ;ABMXMIT=batch IEN into 3P UFMS EXPORTS file
+2 DO HOME^%ZIS
+3 SET $PIECE(ABMLINE,"-",80)="-"
+4 WRITE $$EN^ABMVDF("IOF")
+5 WRITE !
+6 DO CENTER("UFMS EXPORT SUMMARY")
+7 WRITE !!,"EXPORT DATE: ",$$CDT^ABMDUTL($PIECE($GET(^ABMUTXMT(ABMXMIT,0)),U))
+8 WRITE !,"FILE NAME: ",$PIECE($GET(^ABMUTXMT(ABMXMIT,0)),U,2)
+9 WRITE !!?5,"BUDGET ACTIVITY"
+10 WRITE ?32,"BILL COUNT"
+11 WRITE ?48,"AMOUNT"
+12 WRITE !,ABMLINE,!
+13 ;get batch detail
DO GETBTDTL(ABMXMIT)
+14 SET ABMSESSN=0
+15 FOR
SET ABMSESSN=$ORDER(ABMO(ABMSESSN))
IF +ABMSESSN=0
QUIT
Begin DoDot:1
+16 SET ABMUSER=""
+17 FOR
SET ABMUSER=$ORDER(ABMO(ABMSESSN,ABMUSER))
IF ABMUSER=""
QUIT
Begin DoDot:2
+18 WRITE !,"SESSION ID: ",ABMSESSN
+19 WRITE ?30,"BILLER: ",$SELECT(ABMUSER:$PIECE($GET(^VA(200,ABMUSER,0)),U),1:"POS CLAIMS"),!
+20 SET ABMBAU=""
+21 FOR
SET ABMBAU=$ORDER(ABMO(ABMSESSN,ABMUSER,ABMBAU))
IF ABMBAU=""
QUIT
Begin DoDot:3
+22 SET ABMBACNT=+$PIECE($GET(ABMO(ABMSESSN,ABMUSER,ABMBAU)),U)
+23 SET ABMBATOT=+$PIECE($GET(ABMO(ABMSESSN,ABMUSER,ABMBAU)),U,2)
+24 WRITE !
+25 ;W ?5,$P($T(@ABMBAU^ABMUCASH),";;",2) ;abm*2.6*11 insurer type
+26 ;abm*2.6*11 insurer type
WRITE ?5,$$INSTYP^ABMUCASH(ABMBAU)
+27 WRITE ?32,ABMBACNT,$SELECT(ABMBACNT=1:" bill",1:" bills")
+28 WRITE ?45,$$FMT^ABMERUTL($JUSTIFY(ABMBATOT,".",2),"10R")
End DoDot:3
End DoDot:2
End DoDot:1
+29 WRITE !!,"TOTAL BILLS FOR THIS SESSION: ",?32,$PIECE($GET(ABMO("TOTAL")),U),$SELECT($PIECE($GET(ABMO("TOTAL")),U)=1:" BILL",1:" BILLS"),?45,$$FMT^ABMERUTL($JUSTIFY($PIECE($GET(ABMO("TOTAL")),U,2),".",2),"10R")
+30 QUIT
GETBTDTL(ABMXMIT) ;EP - get batch detail; return in array
+1 ; ABMO(SESSION#,DUZ,BUDGETACT)=COUNT^AMOUNT
+2 ; ABMO("TOTAL")=TOTALCOUNT^TOTALAMOUNT
+3 ;
+4 KILL ABMO
+5 FOR ABMLOOP=1,2
Begin DoDot:1
+6 SET ABMUSER=0
+7 FOR
SET ABMUSER=$ORDER(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER))
IF +ABMUSER=0
QUIT
Begin DoDot:2
+8 SET ABMUSERU=ABMUSER
+9 IF ABMLOOP=2
SET ABMUSERU="POS"
+10 SET ABMSDT=0
+11 FOR
SET ABMSDT=$ORDER(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER,2,ABMSDT))
IF +ABMSDT=0
QUIT
Begin DoDot:3
+12 SET ABMBA=0
+13 FOR
SET ABMBA=$ORDER(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER,2,ABMSDT,11,ABMBA))
IF +ABMBA=0
QUIT
Begin DoDot:4
+14 SET ABMBAU=$PIECE($GET(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER,2,ABMSDT,11,ABMBA,0)),U)
+15 SET ABMBILL=0
+16 FOR
SET ABMBILL=$ORDER(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER,2,ABMSDT,11,ABMBA,2,ABMBILL))
IF +ABMBILL=0
QUIT
Begin DoDot:5
+17 SET ABMBIEN=$PIECE($GET(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER,2,ABMSDT,11,ABMBA,2,ABMBILL,0)),U,3)
+18 SET ABMBAMT=$PIECE($GET(^ABMUTXMT(ABMXMIT,ABMLOOP,ABMUSER,2,ABMSDT,11,ABMBA,2,ABMBILL,0)),U,4)
+19 SET $PIECE(ABMO(ABMSDT,ABMUSERU,ABMBAU),U)=+$PIECE($GET(ABMO(ABMSDT,ABMUSERU,ABMBAU)),U)+1
+20 SET $PIECE(ABMO(ABMSDT,ABMUSERU,ABMBAU),U,2)=+$PIECE($GET(ABMO(ABMSDT,ABMUSERU,ABMBAU)),U,2)+ABMBAMT
+21 SET $PIECE(ABMO("TOTAL"),U)=+$PIECE($GET(ABMO("TOTAL")),U)+1
+22 SET $PIECE(ABMO("TOTAL"),U,2)=+$PIECE($GET(ABMO("TOTAL")),U,2)+ABMBAMT
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 KILL ABMUSER,ABMSDT,ABMBA,ABMBILL,ABMBIEN,ABMBAU,ABMUSERU
+24 QUIT
REQBTCH(ABMBIEN) ;EP - Add bill to requeue session log
+1 ;ABMBIEN=batch IEN
+2 ;find location to file bill for
SET ABMLOC=$$FINDLOC()
+3 ;find open session
SET ABMSDT=$$FINDOPEN(DUZ)
+4 ;no open session found; ask if they want to create one
IF ABMSDT=0
Begin DoDot:1
+5 KILL DIR,DIC,DIE,X,Y,DA
+6 SET DIR(0)="Y"
+7 WRITE !
+8 SET DIR("A",1)="No open session was found for you."
+9 SET DIR("A")="Would you like to open a session"
+10 DO ^DIR
KILL DIR
+11 SET ABMANS=+Y
End DoDot:1
IF ABMANS=0
QUIT
+12 ;create session
IF ABMSDT=0
SET ABMSDT=$PIECE($$CR8SESS^ABMUCUTL,U)
+13 KILL DIC,DIE,X,Y,DA
+14 SET DA(3)=ABMLOC
+15 SET DA(2)=DUZ
+16 SET DA(1)=ABMSDT
+17 SET DIC="^ABMUCASH(DA(3),10,DA(2),20,DA(1),13,"
+18 SET DIC(0)="LM"
+19 SET X="`"_ABMBIEN
+20 DO ^DIC
+21 IF +Y<0
WRITE !,"NO ENTRY IN CASHIERING SESSION MADE",!
HANG 2
QUIT
+22 QUIT
+23 ;
FINDLOC() ;EP - return what site should bills be filed under for export
+1 KILL ABMPSFLG
+2 ;S ABMLOC=DUZ(2) ;abm*2.6*6 HEAT27136
+3 ;abm*2.6*6 HEAT27136
SET ABMBLOC=DUZ(2)
+4 IF $GET(ABMP("LDFN"))=""
SET ABMP("LDFN")=DUZ(2)
+5 IF $GET(ABMP("VDT"))=""
SET ABMP("VDT")=DT
+6 SET ABMPAR=0
+7 FOR
SET ABMPAR=$ORDER(^BAR(90052.05,ABMPAR))
IF +ABMPAR=0
QUIT
Begin DoDot:1
+8 IF $DATA(^BAR(90052.05,ABMPAR,ABMP("LDFN")))
Begin DoDot:2
+9 ; Use A/R parent/sat is yes, but DUZ(2) is not the parent for this
+10 ; visit location
+11 IF $PIECE($GET(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,3)'=ABMPAR
QUIT
+12 IF $PIECE($GET(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,6)>ABMP("VDT")
QUIT
+13 IF $PIECE($GET(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,7)&($PIECE(^(0),U,7)<ABMP("VDT"))
QUIT
+14 ;S ABMLOC=ABMPAR,ABMPSFLG=1 ;abm*2.6*6 HEAT27136
+15 ;abm*2.6*6 HEAT27136
SET ABMBLOC=ABMPAR
SET ABMPSFLG=1
End DoDot:2
End DoDot:1
IF ($GET(ABMPSFLG)=1)
QUIT
+16 ;Q ABMLOC ;abm*2.6*6 HEAT27136
+17 ;abm*2.6*6 HEAT27136
QUIT ABMBLOC
GETBILL(ABMPREC) ;EP - get bill info from appropriate 3P Bill file
+1 SET ABMHOLD=DUZ(2)
+2 SET DUZ(2)=$PIECE(ABMPREC,U,2)
+3 ;S ABMLOC=$$FINDLOC^ABMUCUTL ;abm*2.6*8 HEAT27136
+4 ;abm*2.6*8 HEAT27136
SET ABMBLOC=$$FINDLOC^ABMUCUTL
+5 SET ABMP("BDFN")=$PIECE(ABMPREC,U,3)
+6 ;date/time approved
SET ABMDTAPP=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,5)
+7 ;active insurer
SET ABMP("INS")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)
+8 ;TAX ID
SET ABMTAXID=$TRANSLATE($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U,11),"-")
+9 ;visit location
SET ABMP("LDFN")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,3)
+10 ;service date
SET ABMPDOS=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,1)
+11 ;S ABMPASUF=$$ASUFAC(ABMLOC,ABMPDOS) ;abm*2.6*6 HEAT27136
+12 ;abm*2.6*6 HEAT27136
SET ABMPASUF=$$ASUFAC(ABMBLOC,ABMPDOS)
+13 ;use asufac of
SET ABMUAOF=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,4)),U,17)
+14 SET ABMSASUF=$$ASUFAC($SELECT(+$GET(ABMUAOF)'=0:ABMUAOF,1:ABMP("LDFN")),ABMPDOS)
+15 ;Bill Number
SET ABMPBNUM=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U)
+16 ;bill amount
SET ABMP("BAMT")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U)
+17 ;S ABMP("ITYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ;abm*2.6*10 HEAT73780
+18 ;abm*2.6*10 HEAT73780
SET ABMP("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
+19 SET ABMCLN=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10)
+20 ;abm*2.6*1 visit type description FIXPMS10011
SET ABMP("VTYP")=$PIECE($GET(^ABMDVTYP($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,7),0)),U)
+21 ;DOS abm*2.6*1 FIXPMS10011
SET ABMP("DOS")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
+22 SET DUZ(2)=ABMHOLD
+23 QUIT
+24 ;
ASUFAC(X,Y) ;EP - get ASUFAC for DOS
+1 KILL ASUFAC
+2 SET ASUFAC=0
+3 SET ABMDT=0
+4 SET ABMDTFLG=0
+5 ;ASUFAC index
SET ASUFAC=$PIECE($GET(^AUTTLOC(X,0)),U,10)
+6 ;ASUFAC found; stop here
IF +$GET(ASUFAC)'=0
QUIT ASUFAC
+7 FOR
SET ABMDT=$ORDER(^AUTTLOC(X,11,ABMDT))
IF ABMDT=""!(ABMDTFLG=1)
QUIT
Begin DoDot:1
+8 IF Y>$PIECE($GET(^AUTTLOC(X,11,ABMDT,0)),U)
Begin DoDot:2
+9 SET ASUFAC=$PIECE($GET(^AUTTLOC(X,11,ABMDT,0)),U,6)
+10 SET ABMDTFLG=1
End DoDot:2
End DoDot:1
+11 QUIT ASUFAC
+12 ;
CENTER(X) ;EP
+1 SET CENTER=IOM/2
+2 WRITE ?CENTER-($LENGTH(X)/2),X
+3 QUIT
