ABMUCUTL.m

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))