ABMURCON ; IHS/SD/SDR - 3PB/UFMS Reconcile Sessions Option
;;2.6;IHS Third Party Billing;**1,11**;NOV 12, 2009;Build 133
; IHS/SD/SDR - v2.5 p13 - IM25924 - <UNDEF>EP+32^ABMUCAPI fix
; IHS/SD/SDR - v2.5 p13 - NO IM - Modified to add EP for recon. page display
; IHS/SD/SDR - v2.5 p13 - IM26756 - Fix for Cancel Claim total doubling
; IHS/SD/SDR - abm*2.6*1 - HEAT5977 - <SUBSCR>CASHTOTP+5^ABMUUTL
; IHS/SD/SDR - abm*2.6*1 - HEAT6686 - only allow one person to export at a time
EP ;EP
;start new code abm*2.6*1 HEAT6866
L +ABMURCON:5
I '$T W !!!,"Someone is already exporting..." H 2 Q
;end new code HEAT6866
D HEADER^ABMURCN1("CLOSED")
S ABMFLG="CLOSED"
D FINDACLS^ABMUCUTL
I '$D(ABMO) W !?5,"There are no CLOSED sessions."
D VIEWLIST^ABMURCN1
W !
I $D(ABMO) D SELSESS
I $D(ABMY("SESS",ABMSCNT)),(ABMSCNT>1) D ;they said all; put all in sel. array
.F ABMI=1:1:(ABMSCNT-1) S ABMY("SESS",ABMI)=""
.K ABMY("SESS",ABMSCNT)
S ABMI=0
F S ABMI=$O(ABMOS(ABMI)) Q:+ABMI=0 D
.I '$D(ABMY("SESS",ABMI)) D
..S ABMSDT=$P(ABMOS(ABMI),U)
..S ABMUSER=$P(ABMOS(ABMI),U,2)
..K ABMO(ABMSDT,ABMUSER,ABMSDT)
..K ABMOS(ABMI)
M ABMC=ABMO
K ABMY,ABMO,DUOUT,DIROUT
W !!!
SEL D HEADER^ABMURCN1("OPEN")
S ABMTRIBL=$P($G(^ABMDPARM(DUZ(2),1,4)),U,14)
K ABMFLG
D FINDAOPN^ABMUCUTL
I '$D(ABMO) W !?5,"There are no OPEN sessions.",! S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
Q:$D(DUOUT)!($D(DIROUT))
D VIEWLIST^ABMURCN1
K DIR,X,Y
W !!
I $D(ABMO) D SELSESS
Q:'$D(ABMY("SESS"))&('$D(ABMC)) ;no sess selected & no closed sess
D VIEWSEL^ABMURCN1 ;view selected sess
S DIR(0)="Y",DIR("A")="Do you wish to proceed (""^"" to exit)" S DIR("B")="YES" D ^DIR K DIR
Q:$D(DUOUT)!($D(DIROUT))
I +Y=0 G SEL ;go back to sel scrn
D CLOSE^ABMURCN1 ;cls selected open sess
D PTINCK ;chk if any pseudo TINs exist for btch
I ABMTRIBL=1 D
.I $G(ABMPTINF)=1 W !!,"IMPORTANT!! IMPORTANT!! Pseudo TINs will be sent in this export!"
.I $G(ABMMTINF)=1 D
..W !,"IMPORTANT!! IMPORTANT!! TINs are missing in this export!",!!
..W "DUE TO MISSING TAX IDs, EXPORT FILE WILL NOT BE CREATED. Insurers missing TINs"
..W !,"will be listed. Please record the name(s) of the Insurer for correction."
W !! S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
I ABMTRIBL=1,($G(ABMMTINF)=1) D Q ;wrt missing TIN ins & stop
.;wrt insurers w/out TINs
.W !!,"Insurers missing Tax IDs in this export selection:"
.S ABMINS=0
.F S ABMINS=$O(ABMMT(ABMINS)) Q:+ABMINS=0 D
..W !?5,$P($G(^AUTNINS(ABMINS,0)),U)," in session ID ",$G(ABMMT(ABMINS))
..W ! S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
;start new code
D ABBREVCK^ABMUUTL ;chk if any abbrevs missing
I ABMTRIBL=1 D
.I $G(ABMVDFNF)=1 W !!,"IMPORTANT!! IMPORTANT!! Visit Locations missing abbreviations!"
.I $G(ABMVDFNF)=1 D
..W !,"DUE TO MISSING ABBREVIATIONS, EXPORT FILE WILL NOT BE CREATED. Visit Locations"
..W !,"missing abbreviations will be listed."
..W !!,"Please record the Location name(s) and number(s) for correction in the Location file."
W !! S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
I ABMTRIBL=1,($G(ABMVDFNF)=1) D Q ;wrt missing abbrevs & stop
.;wrt locs w/out abbrevs
.W !!,"Locations missing abbrevs in this export selection:"
.S ABMVDFN=0
.F S ABMVDFN=$O(ABMMABB(ABMVDFN)) Q:+ABMVDFN=0 D
..W !?5,"("_ABMVDFN_") ",$P($G(^DIC(4,ABMVDFN,0)),U)," in session ID ",$G(ABMMABB(ABMVDFN))
..W ! S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
;end new code
I ABMTRIBL=1,($G(ABMPTINF)=1) D ;write pseudo TIN insurers
.;wrt insurers w/pseudo TINs
.W !!,"Insurers with pseudo Tax IDs in this export selection:"
.S ABMINS=0
.F S ABMINS=$O(ABMPT(ABMINS)) Q:+ABMINS=0 D
..W !?5,$P($G(^AUTNINS(ABMINS,0)),U)," with pseudo tax id """_$G(ABMPT(ABMINS))_""""
..W ! S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
D XSUMDISP ;export summ disp
I $P($G(^ABMDPARM(DUZ(2),1,4)),U,14)=1 D SENDBTCH ;ask export question; do if yes
I $P($G(^ABMDPARM(DUZ(2),1,4)),U,14)'=1 D NOSEND ;reconcile; don't export
S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
Q
SELSESS ;SEL SESSIONS
D SELSESS^ABMURCN1
Q
PTINCK ;EP - pseudo TINs chk
D PTINCK^ABMUUTL
Q
XSUMDISP ;EP - Summary export display
S ABMTRIBL=$P($G(^ABMDPARM(DUZ(2),1,4)),U,14)
W $$EN^ABMVDF("IOF")
I ABMTRIBL=1 S ABM("HD",0)="Export Summary Print"
E S ABM("HD",0)="Reconciliation Summary Report"
S ABM("PG")=1
D WHD^ABMDRHD G XIT:'$D(IO)!$G(POP)!$D(DTOUT)!$D(DUOUT)
K ABMRQFLG
W !,"Please ensure the following information is correct:",!
XSUM2 ;EP; called from ABMUVBCR
W ?26,"Approved",?38,"|"
I ABMTRIBL=1 D
.W ?40,"Excluded"
.W ?54,"Cancelled",?66,"Cxl'd",?75,"Ben"
I ABMTRIBL'=1 D
.W ?40,"Cancelled",?56,"Cxl'd"
.;
W !?1,$$EN^ABMVDF("ULN"),"Session/User",$$EN^ABMVDF("ULF")
W ?27,$$EN^ABMVDF("ULN"),"Bills",$$EN^ABMVDF("ULF")
W ?38,"|"
I ABMTRIBL=1 D
.W ?41,$$EN^ABMVDF("ULN"),"Bills",$$EN^ABMVDF("ULF")
.W ?56,$$EN^ABMVDF("ULN"),"Bills",$$EN^ABMVDF("ULF")
.W ?66,$$EN^ABMVDF("ULN"),"Claims",$$EN^ABMVDF("ULF")
.W ?74,$$EN^ABMVDF("ULN"),"Bills",$$EN^ABMVDF("ULF")
I ABMTRIBL'=1 D
.W ?40,$$EN^ABMVDF("ULN"),"Bills",$$EN^ABMVDF("ULF")
.W ?56,$$EN^ABMVDF("ULN"),"Claims",$$EN^ABMVDF("ULF")
W !
S ABMSESS=0
K ABMSBTOT,ABMSATOT
K ABMTCCLM
K ABMTCBIL,ABMTCBAM
K ABMEBILL,ABMTBEN
F S ABMSESS=$O(ABMC(ABMSESS)) Q:+ABMSESS=0 D
.S ABMDUZ=""
.F S ABMDUZ=$O(ABMC(ABMSESS,ABMDUZ)) Q:ABMDUZ="" D
..S ABMFD=0
..F S ABMFD=$O(ABMC(ABMSESS,ABMDUZ,ABMFD)) Q:+ABMFD=0 D
...W ?38,"|",!
...I ABMDUZ D
....W $E(ABMFD_"/"_$P($P($G(^VA(200,ABMDUZ,0)),U),",")_","_$E($P($P($G(^VA(200,ABMDUZ,0)),U),",",2),1),1,23)
....D CASHTOT^ABMUCASH(ABMDUZ)
....W ?25,+$G(ABMABILL),?27,$J($FN(+$G(ABMABAMT),",",2),10)
....W ?38,"|"
....I ABMTRIBL=1 D
.....W ?40,+$G(ABMEBILL),?42,$J($FN(+$G(ABMEBAMT),",",2),9)
.....W ?53,+$G(ABMCBILL),?55,$J($FN(+$G(ABMCBAMT),",",2),9)
.....W ?68,+$G(ABMCCLMS)
.....W ?76,+$P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMFD,0)),U,11),!
....I ABMTRIBL'=1 D
.....W ?40,+$G(ABMCBILL),?43,$J($FN(+$G(ABMCBAMT),",",2),9)
.....W ?55,+$G(ABMCCLMS),!
....S ABMTBEN=+$G(ABMTBEN)+$P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMFD,0)),U,11)
...I 'ABMDUZ D ;POS CLMS
....W ABMFD_"/POS CLAIMS"
....D CASHTOTP^ABMUCASH
....W ?25,+$G(ABMABILL),?27,$J($FN(+$G(ABMABAMT),",",2),10)
....W ?38,"|"
....W ?40,+$G(ABMEBILL),?42,$J($FN(+$G(ABMEBAMT),",",2),9),!
W ABMLINE,!,"TOTALS:"
W ?25,+$G(ABMSBTOT),?27,$J($FN(+$G(ABMSATOT),",",2),10)
W ?38,"|"
I ABMTRIBL=1 D
.W ?40,+$G(ABMTEBIL),?42,$J($FN(+$G(ABMTEBAM),",",2),9)
.W ?53,+$G(ABMTCBIL),?55,$J($FN(+$G(ABMTCBAM),",",2),9)
.W ?68,+$G(ABMTCCLM)
.W ?76,+$G(ABMTBEN)
I ABMTRIBL'=1 D
.W ?40,+$G(ABMTCBIL),?43,$J($FN(+$G(ABMTCBAM),",",2),9)
.W ?55,+$G(ABMTCCLM)
W !!
W !
I $G(ABMFILE)'="" W !!,"EXPORTED IN FILE ",ABMFILE D
.W:(+$G(XBFLG)=0) !!,"File was sent successfully"
.W:'(+$G(XBFLG)=0) !!,"File was **NOT** sent successfully"
.W:$G(XBFLG(1))'="" ?40,"- ",$G(XBFLG(1))
Q
SENDBTCH ;EP - ask export ques; export=yes
S ABMDT=0
S ABMAFLG=0
F S ABMDT=$O(ABMC(ABMDT)) Q:+ABMDT=0 D Q:ABMAFLG=1
.S ABMUSER=0
.F S ABMUSER=$O(ABMC(ABMDT,ABMUSER)) Q:+ABMUSER=0 D Q:ABMAFLG=1
..S ABMDT2=0
..F S ABMDT2=$O(ABMC(ABMDT,ABMUSER,ABMDT2)) Q:+ABMDT2=0 D
...I +$P($G(ABMC(ABMDT,ABMUSER,ABMDT2)),U,3)=1 S ABMAFLG=1
...I +$P($G(ABMC(ABMDT,ABMUSER,ABMDT2)),U,3)=0 D ;no act-mark as reconciled
....K DIC,DIE,DA,DR,X,Y
....S DA(2)=DUZ(2)
....S DA(1)=$S(ABMUSER:ABMUSER,1:1)
....S:ABMUSER DIE="^ABMUCASH("_DA(2)_",10,"_DA(1)_",20,"
....S:'ABMUSER DIE="^ABMUCASH("_DA(2)_",20,"_DA(1)_",20,"
....S DA=ABMDT
....S DR=".04///T;.08///NOW" ;transmitted status w/dt
....D ^DIE
I +$G(ABMSBTOT)=0,(+$G(ABMAFLG)=0) D Q ;there aren't any bills, don't create exp file
.W !!,"There aren't any bills to export in this selection."
.W !,"NO export file will be created"
K DIR
S DIR(0)="Y"
S DIR("A")="Do you want to SEND export now? <yes/no>"
D ^DIR K DIR
S ABMXANS=+Y
I ABMXANS=0 D Q
.W !,"EXITING Reconcile sessions option...NOTE: NOTHING IS BEING EXPORTED AT THIS TIME"
.D PRINTSUM
I ABMXANS=1 D
.D EXPORT
.D PRINTSUM
Q
PRINTSUM ;EP - print sum?
D PRINTSUM^ABMURCN1
Q
EXPORT ;EP-loop thru sess; export data
;Inv format:
; 1.Always D
; 2.<parASUFAC><satASUFAC>3P BILL IEN
; 3.Dt/Tm Approved (MM/DD/YYYY) from 3P Bill
; 4.TAX ID (.11) from Insurer file
; 5.<parASUFAC><satASUFAC>3P BILL#
; 6.Bill Amount (.21) from 3P Bill
; 7.CAN-calculated in IE
; 8.132 for HHS T-code
; 9.61704 for object class
;Trailer record format:
; 1.Always T for trailer
; 2.Number records
; 3.Total file amt
D FILENAME()
K ^ABMUFMS($J)
S ABMTOT=0
S ABMRECT="D"
S ABMTCODE=132
S ABMOCL=61704
S ABMCNT=0
S ABMMIEN=0
S ABMSESS=0
D CREATBTH ;create exp btch
;sess bills
F S ABMSESS=$O(ABMC(ABMSESS)) Q:+ABMSESS=0 D
.S ABMDUZ=""
.F S ABMDUZ=$O(ABMC(ABMSESS,ABMDUZ)) Q:ABMDUZ="" D
..S ABMSDT=0
..F S ABMSDT=$O(ABMC(ABMSESS,ABMDUZ,ABMSDT)) Q:+ABMSDT=0 D
...I ABMDUZ D
....S ABMSESID=ABMSDT
....S ABMBA=0
....F S ABMBA=$O(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,11,ABMBA)) Q:+ABMBA=0 D
.....S ABMBAOUT=$P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,11,ABMBA,0)),U)
.....I ABMBAOUT="I"!(ABMBAOUT="T") Q ;don't export ben, Third Party Liab.
.....S ABMBIEN=0
.....F S ABMBIEN=$O(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,11,ABMBA,2,ABMBIEN)) Q:+ABMBIEN=0 D
......S ABMPREC=$G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,11,ABMBA,2,ABMBIEN,0))
......D RECORD
...I 'ABMDUZ D ;POS CLMS
....S ABMUSER=0
....F S ABMUSER=$O(^ABMUCASH(ABMLOC,20,ABMUSER)) Q:+ABMUSER=0 D
.....S ABMBA=0
.....F S ABMBA=$O(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT,11,ABMBA)) Q:+ABMBA=0 D
......S ABMBAOUT=$P($G(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT,11,ABMBA,0)),U)
......S ABMBIEN=0
......F S ABMBIEN=$O(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT,11,ABMBA,2,ABMBIEN)) Q:+ABMBIEN=0 D
.......S ABMPREC=$G(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT,11,ABMBA,2,ABMBIEN,0))
.......D RECORD
...;reque'd bills
...S ABMRQB=0
...F S ABMRQB=$O(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,12,ABMRQB)) Q:+ABMRQB=0 D
....S ABMPREC=$G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,12,ABMRQB,0))
....;S ABMBAOUT=$P($G(^AUTNINS($P($G(^ABMDBILL(ABMLOC,$P(ABMPREC,U,3),0)),U,8),2)),U) ;abm*2.6*11 HEAT73780
....S ABMBAOUT=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+$P($G(^ABMDBILL(ABMLOC,$P(ABMPREC,U,3),0)),U,8),".211","I"),1,"I") ;abm*2.6*11 HEAT73780
....D RECORD
...;reque'd batches
...S ABMRQB=0
...F S ABMRQB=$O(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,13,ABMRQB)) Q:+ABMRQB=0 D
....S ABMPBTCH=$P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,13,ABMRQB,0)),U) ;batch IEN
....F ABMLOOP=1,2 D
.....S ABMBUSER=0
.....F S ABMBUSER=$O(^ABMUTXMT(ABMPBTCH,ABMLOOP,ABMBUSER)) Q:+ABMBUSER=0 D
......S ABMBSDT=0
......F S ABMBSDT=$O(^ABMUTXMT(ABMPBTCH,ABMLOOP,ABMBUSER,2,ABMBSDT)) Q:+ABMBSDT=0 D
.......S ABMBBA=0
.......F S ABMBBA=$O(^ABMUTXMT(ABMPBTCH,ABMLOOP,ABMBUSER,2,ABMBSDT,11,ABMBBA)) Q:+ABMBBA=0 D
........S ABMBAOUT=$P($G(^ABMUTXMT(ABMPBTCH,ABMLOOP,ABMBUSER,2,ABMBSDT,11,ABMBBA,0)),U)
........S ABMBBIEN=0
........F S ABMBBIEN=$O(^ABMUTXMT(ABMPBTCH,ABMLOOP,ABMBUSER,2,ABMBSDT,11,ABMBBA,2,ABMBBIEN)) Q:+ABMBBIEN=0 D
.........S ABMPREC=$G(^ABMUTXMT(ABMPBTCH,ABMLOOP,ABMBUSER,2,ABMBSDT,11,ABMBBA,2,ABMBBIEN,0))
.........D RECORD
....D REEXPB^ABMURCN1 ;3 mult entry of 3P UFMS Export file
...;mark sess as Xmitted
...K DIC,DIE,DA,DR,X,Y
...S DA(2)=ABMLOC
...S DA(1)=$S(ABMDUZ:ABMDUZ,1:1)
...S:ABMDUZ DIE="^ABMUCASH("_DA(2)_",10,"_DA(1)_",20,"
...S:'ABMDUZ DIE="^ABMUCASH("_DA(2)_",20,"_DA(1)_",20,"
...S DA=ABMSDT
...S DR=".04///T;.08///NOW" ;Xmitted status w/dt
...D ^DIE
Q:'$D(^ABMUFMS($J))
D TRAILER
D SENDFILE("ABMUFMS(",ABMFILE)
Q
TRAILER ;EP
S ABMREC="T"_$$FMT^ABMERUTL(ABMCNT,"10R")_$TR($$FMT^ABMERUTL($J(ABMTOT,".",2),"20NR"),".")
S ^ABMUFMS($J,(ABMCNT+1))=ABMREC
Q
FILENAME() ;
S ABMLOC=$$FINDLOC^ABMUCUTL
S ABMFILE=$$GETFILNM($$ASUFAC^ABMUCUTL(ABMLOC,DT))
W !,"File will be created using the following name: ",!?5,ABMFILE
I ABMFILE'="" Q 1
Q 0
GETFILNM(ASUFACS) ;EP - CREATE FILE NAME
N FNROOT,FNEXT,FN,YR,DATE,TIME
K DATETIME
S FNROOT="IHS_TPB_RPMS_INV_"
S FNEXT="_"_$P($$VERSION^XPDUTL("ABM"),".")_"." ;version piece 1 (before ".")
S FNEXT=FNEXT_$$FMT^ABMERUTL($P($$VERSION^XPDUTL("ABM"),".",2),"2NR")_"." ;version piece 2 fmt'ed (after ".")
S FNEXT=FNEXT_$S(+$$LAST^ABMENVCK("IHS 3P BILLING SYSTEM",$$VERSION^XPDUTL("ABM"))>0:+$$LAST^ABMENVCK("IHS 3P BILLING SYSTEM",$$VERSION^XPDUTL("ABM")),1:"00")_"k.DAT" ;patch#, default to 00
S FN=FNROOT
D NOW^%DTC
S YR=1700+$E(%,1,3)
S DATE=YR_$E(%,4,7)
S Y=% X ^DD("DD")
S TIME=$TR($P(Y,"@",2),":")
S DATETIME=DATE_"_"_TIME
S FN=FNROOT_ASUFACS_"_"_DATETIME
S FN=FN_FNEXT
Q FN
SENDFILE(XBGL,XBFN) ;
S:$G(XBFN)="" XBFN="UFMS.TST"
S:$G(XBGL)="" XBGL="ABMTUFMS("
S XBQSHO=""
S XBF=$J ;Beg 1st lev numeric subscr
S XBE=$J ;End 1st lev numeric subscr
S XBFLT=1 ;indicates flat file
S XBMED="F" ;Flag indicates file as media
S XBCON=1 ;Q if non-cononic
S XBS1="ABM UFMS F" ;ZISH SEND PARA entry
I $D(ZTQUEUED) S XBS1="ABM UFMS B"
S XBQ="N"
S XBUF=$P($G(^ABMDPARM(ABMLOC,1,4)),U,13)
I XBUF="" D Q
.W !!,"Before UFMS files can be created a non-public directory must be created"
.W !,"on the Host File System. This directory must be entered in to TPB Site Parameter"
.W !,"field UFMS DIRECTORY using the 'SITM Site Parameter Maintenance' option"
.K DIR
.S DIR(0)="E"
.D ^DIR
S XBFLG=0
I XBUF="" D Q
.S XBFLG=-1
.S XBFLG(1)="Missing UFMS storage directory. Please check TPB UFMS Parameters"
D ^XBGSAVE
Q
RECORD ;EP - get pieces; put together rec
D RECORD^ABMURCN2
Q
CREATBTH ;EP - create UFMS export entry
D CREATBTH^ABMURCN1
Q
BATCH ;EP - put bill in batch file
D BATCH^ABMURCN1
Q
BILL ;EP - put entry in bill mult for transmit dt & save UFMS inv#
;transmit dt
D BILL^ABMURCN1
Q
NOSEND ;EP - don't send but mark reconciled
D NOSEND^ABMURCN1
Q
RCONSESS ;mark session as transmitted
D RCONSESS^ABMURCN1
Q
XIT ;EP
K ABMBAL,ABMC,ABMO,ABMOS
K ABMSESID,ABMSESS,ABMDUZ,ABMDUZ2,ABMPASUF,ABMSASUF,ABMPREC
K ABMBAOUT,ABMSDT,ABMLINE
Q
ABMURCON ; IHS/SD/SDR - 3PB/UFMS Reconcile Sessions Option
+1 ;;2.6;IHS Third Party Billing;**1,11**;NOV 12, 2009;Build 133
+2 ; IHS/SD/SDR - v2.5 p13 - IM25924 - <UNDEF>EP+32^ABMUCAPI fix
+3 ; IHS/SD/SDR - v2.5 p13 - NO IM - Modified to add EP for recon. page display
+4 ; IHS/SD/SDR - v2.5 p13 - IM26756 - Fix for Cancel Claim total doubling
+5 ; IHS/SD/SDR - abm*2.6*1 - HEAT5977 - <SUBSCR>CASHTOTP+5^ABMUUTL
+6 ; IHS/SD/SDR - abm*2.6*1 - HEAT6686 - only allow one person to export at a time
EP ;EP
+1 ;start new code abm*2.6*1 HEAT6866
+2 LOCK +ABMURCON:5
+3 IF '$TEST
WRITE !!!,"Someone is already exporting..."
HANG 2
QUIT
+4 ;end new code HEAT6866
+5 DO HEADER^ABMURCN1("CLOSED")
+6 SET ABMFLG="CLOSED"
+7 DO FINDACLS^ABMUCUTL
+8 IF '$DATA(ABMO)
WRITE !?5,"There are no CLOSED sessions."
+9 DO VIEWLIST^ABMURCN1
+10 WRITE !
+11 IF $DATA(ABMO)
DO SELSESS
+12 ;they said all; put all in sel. array
IF $DATA(ABMY("SESS",ABMSCNT))
IF (ABMSCNT>1)
Begin DoDot:1
+13 FOR ABMI=1:1:(ABMSCNT-1)
SET ABMY("SESS",ABMI)=""
+14 KILL ABMY("SESS",ABMSCNT)
End DoDot:1
+15 SET ABMI=0
+16 FOR
SET ABMI=$ORDER(ABMOS(ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+17 IF '$DATA(ABMY("SESS",ABMI))
Begin DoDot:2
+18 SET ABMSDT=$PIECE(ABMOS(ABMI),U)
+19 SET ABMUSER=$PIECE(ABMOS(ABMI),U,2)
+20 KILL ABMO(ABMSDT,ABMUSER,ABMSDT)
+21 KILL ABMOS(ABMI)
End DoDot:2
End DoDot:1
+22 MERGE ABMC=ABMO
+23 KILL ABMY,ABMO,DUOUT,DIROUT
+24 WRITE !!!
SEL DO HEADER^ABMURCN1("OPEN")
+1 SET ABMTRIBL=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,14)
+2 KILL ABMFLG
+3 DO FINDAOPN^ABMUCUTL
+4 IF '$DATA(ABMO)
WRITE !?5,"There are no OPEN sessions.",!
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
+5 IF $DATA(DUOUT)!($DATA(DIROUT))
QUIT
+6 DO VIEWLIST^ABMURCN1
+7 KILL DIR,X,Y
+8 WRITE !!
+9 IF $DATA(ABMO)
DO SELSESS
+10 ;no sess selected & no closed sess
IF '$DATA(ABMY("SESS"))&('$DATA(ABMC))
QUIT
+11 ;view selected sess
DO VIEWSEL^ABMURCN1
+12 SET DIR(0)="Y"
SET DIR("A")="Do you wish to proceed (""^"" to exit)"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
+13 IF $DATA(DUOUT)!($DATA(DIROUT))
QUIT
+14 ;go back to sel scrn
IF +Y=0
GOTO SEL
+15 ;cls selected open sess
DO CLOSE^ABMURCN1
+16 ;chk if any pseudo TINs exist for btch
DO PTINCK
+17 IF ABMTRIBL=1
Begin DoDot:1
+18 IF $GET(ABMPTINF)=1
WRITE !!,"IMPORTANT!! IMPORTANT!! Pseudo TINs will be sent in this export!"
+19 IF $GET(ABMMTINF)=1
Begin DoDot:2
+20 WRITE !,"IMPORTANT!! IMPORTANT!! TINs are missing in this export!",!!
+21 WRITE "DUE TO MISSING TAX IDs, EXPORT FILE WILL NOT BE CREATED. Insurers missing TINs"
+22 WRITE !,"will be listed. Please record the name(s) of the Insurer for correction."
End DoDot:2
End DoDot:1
+23 WRITE !!
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
+24 ;wrt missing TIN ins & stop
IF ABMTRIBL=1
IF ($GET(ABMMTINF)=1)
Begin DoDot:1
+25 ;wrt insurers w/out TINs
+26 WRITE !!,"Insurers missing Tax IDs in this export selection:"
+27 SET ABMINS=0
+28 FOR
SET ABMINS=$ORDER(ABMMT(ABMINS))
IF +ABMINS=0
QUIT
Begin DoDot:2
+29 WRITE !?5,$PIECE($GET(^AUTNINS(ABMINS,0)),U)," in session ID ",$GET(ABMMT(ABMINS))
+30 WRITE !
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:2
End DoDot:1
QUIT
+31 ;start new code
+32 ;chk if any abbrevs missing
DO ABBREVCK^ABMUUTL
+33 IF ABMTRIBL=1
Begin DoDot:1
+34 IF $GET(ABMVDFNF)=1
WRITE !!,"IMPORTANT!! IMPORTANT!! Visit Locations missing abbreviations!"
+35 IF $GET(ABMVDFNF)=1
Begin DoDot:2
+36 WRITE !,"DUE TO MISSING ABBREVIATIONS, EXPORT FILE WILL NOT BE CREATED. Visit Locations"
+37 WRITE !,"missing abbreviations will be listed."
+38 WRITE !!,"Please record the Location name(s) and number(s) for correction in the Location file."
End DoDot:2
End DoDot:1
+39 WRITE !!
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
+40 ;wrt missing abbrevs & stop
IF ABMTRIBL=1
IF ($GET(ABMVDFNF)=1)
Begin DoDot:1
+41 ;wrt locs w/out abbrevs
+42 WRITE !!,"Locations missing abbrevs in this export selection:"
+43 SET ABMVDFN=0
+44 FOR
SET ABMVDFN=$ORDER(ABMMABB(ABMVDFN))
IF +ABMVDFN=0
QUIT
Begin DoDot:2
+45 WRITE !?5,"("_ABMVDFN_") ",$PIECE($GET(^DIC(4,ABMVDFN,0)),U)," in session ID ",$GET(ABMMABB(ABMVDFN))
+46 WRITE !
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:2
End DoDot:1
QUIT
+47 ;end new code
+48 ;write pseudo TIN insurers
IF ABMTRIBL=1
IF ($GET(ABMPTINF)=1)
Begin DoDot:1
+49 ;wrt insurers w/pseudo TINs
+50 WRITE !!,"Insurers with pseudo Tax IDs in this export selection:"
+51 SET ABMINS=0
+52 FOR
SET ABMINS=$ORDER(ABMPT(ABMINS))
IF +ABMINS=0
QUIT
Begin DoDot:2
+53 WRITE !?5,$PIECE($GET(^AUTNINS(ABMINS,0)),U)," with pseudo tax id """_$GET(ABMPT(ABMINS))_""""
+54 WRITE !
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:2
End DoDot:1
+55 ;export summ disp
DO XSUMDISP
+56 ;ask export question; do if yes
IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,14)=1
DO SENDBTCH
+57 ;reconcile; don't export
IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,14)'=1
DO NOSEND
+58 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
+59 QUIT
SELSESS ;SEL SESSIONS
+1 DO SELSESS^ABMURCN1
+2 QUIT
PTINCK ;EP - pseudo TINs chk
+1 DO PTINCK^ABMUUTL
+2 QUIT
XSUMDISP ;EP - Summary export display
+1 SET ABMTRIBL=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,14)
+2 WRITE $$EN^ABMVDF("IOF")
+3 IF ABMTRIBL=1
SET ABM("HD",0)="Export Summary Print"
+4 IF '$TEST
SET ABM("HD",0)="Reconciliation Summary Report"
+5 SET ABM("PG")=1
+6 DO WHD^ABMDRHD
IF '$DATA(IO)!$GET(POP)!$DATA(DTOUT)!$DATA(DUOUT)
GOTO XIT
+7 KILL ABMRQFLG
+8 WRITE !,"Please ensure the following information is correct:",!
XSUM2 ;EP; called from ABMUVBCR
+1 WRITE ?26,"Approved",?38,"|"
+2 IF ABMTRIBL=1
Begin DoDot:1
+3 WRITE ?40,"Excluded"
+4 WRITE ?54,"Cancelled",?66,"Cxl'd",?75,"Ben"
End DoDot:1
+5 IF ABMTRIBL'=1
Begin DoDot:1
+6 WRITE ?40,"Cancelled",?56,"Cxl'd"
+7 ;
End DoDot:1
+8 WRITE !?1,$$EN^ABMVDF("ULN"),"Session/User",$$EN^ABMVDF("ULF")
+9 WRITE ?27,$$EN^ABMVDF("ULN"),"Bills",$$EN^ABMVDF("ULF")
+10 WRITE ?38,"|"
+11 IF ABMTRIBL=1
Begin DoDot:1
+12 WRITE ?41,$$EN^ABMVDF("ULN"),"Bills",$$EN^ABMVDF("ULF")
+13 WRITE ?56,$$EN^ABMVDF("ULN"),"Bills",$$EN^ABMVDF("ULF")
+14 WRITE ?66,$$EN^ABMVDF("ULN"),"Claims",$$EN^ABMVDF("ULF")
+15 WRITE ?74,$$EN^ABMVDF("ULN"),"Bills",$$EN^ABMVDF("ULF")
End DoDot:1
+16 IF ABMTRIBL'=1
Begin DoDot:1
+17 WRITE ?40,$$EN^ABMVDF("ULN"),"Bills",$$EN^ABMVDF("ULF")
+18 WRITE ?56,$$EN^ABMVDF("ULN"),"Claims",$$EN^ABMVDF("ULF")
End DoDot:1
+19 WRITE !
+20 SET ABMSESS=0
+21 KILL ABMSBTOT,ABMSATOT
+22 KILL ABMTCCLM
+23 KILL ABMTCBIL,ABMTCBAM
+24 KILL ABMEBILL,ABMTBEN
+25 FOR
SET ABMSESS=$ORDER(ABMC(ABMSESS))
IF +ABMSESS=0
QUIT
Begin DoDot:1
+26 SET ABMDUZ=""
+27 FOR
SET ABMDUZ=$ORDER(ABMC(ABMSESS,ABMDUZ))
IF ABMDUZ=""
QUIT
Begin DoDot:2
+28 SET ABMFD=0
+29 FOR
SET ABMFD=$ORDER(ABMC(ABMSESS,ABMDUZ,ABMFD))
IF +ABMFD=0
QUIT
Begin DoDot:3
+30 WRITE ?38,"|",!
+31 IF ABMDUZ
Begin DoDot:4
+32 WRITE $EXTRACT(ABMFD_"/"_$PIECE($PIECE($GET(^VA(200,ABMDUZ,0)),U),",")_","_$EXTRACT($PIECE($PIECE($GET(^VA(200,ABMDUZ,0)),U),",",2),1),1,23)
+33 DO CASHTOT^ABMUCASH(ABMDUZ)
+34 WRITE ?25,+$GET(ABMABILL),?27,$JUSTIFY($FNUMBER(+$GET(ABMABAMT),",",2),10)
+35 WRITE ?38,"|"
+36 IF ABMTRIBL=1
Begin DoDot:5
+37 WRITE ?40,+$GET(ABMEBILL),?42,$JUSTIFY($FNUMBER(+$GET(ABMEBAMT),",",2),9)
+38 WRITE ?53,+$GET(ABMCBILL),?55,$JUSTIFY($FNUMBER(+$GET(ABMCBAMT),",",2),9)
+39 WRITE ?68,+$GET(ABMCCLMS)
+40 WRITE ?76,+$PIECE($GET(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMFD,0)),U,11),!
End DoDot:5
+41 IF ABMTRIBL'=1
Begin DoDot:5
+42 WRITE ?40,+$GET(ABMCBILL),?43,$JUSTIFY($FNUMBER(+$GET(ABMCBAMT),",",2),9)
+43 WRITE ?55,+$GET(ABMCCLMS),!
End DoDot:5
+44 SET ABMTBEN=+$GET(ABMTBEN)+$PIECE($GET(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMFD,0)),U,11)
End DoDot:4
+45 ;POS CLMS
IF 'ABMDUZ
Begin DoDot:4
+46 WRITE ABMFD_"/POS CLAIMS"
+47 DO CASHTOTP^ABMUCASH
+48 WRITE ?25,+$GET(ABMABILL),?27,$JUSTIFY($FNUMBER(+$GET(ABMABAMT),",",2),10)
+49 WRITE ?38,"|"
+50 WRITE ?40,+$GET(ABMEBILL),?42,$JUSTIFY($FNUMBER(+$GET(ABMEBAMT),",",2),9),!
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+51 WRITE ABMLINE,!,"TOTALS:"
+52 WRITE ?25,+$GET(ABMSBTOT),?27,$JUSTIFY($FNUMBER(+$GET(ABMSATOT),",",2),10)
+53 WRITE ?38,"|"
+54 IF ABMTRIBL=1
Begin DoDot:1
+55 WRITE ?40,+$GET(ABMTEBIL),?42,$JUSTIFY($FNUMBER(+$GET(ABMTEBAM),",",2),9)
+56 WRITE ?53,+$GET(ABMTCBIL),?55,$JUSTIFY($FNUMBER(+$GET(ABMTCBAM),",",2),9)
+57 WRITE ?68,+$GET(ABMTCCLM)
+58 WRITE ?76,+$GET(ABMTBEN)
End DoDot:1
+59 IF ABMTRIBL'=1
Begin DoDot:1
+60 WRITE ?40,+$GET(ABMTCBIL),?43,$JUSTIFY($FNUMBER(+$GET(ABMTCBAM),",",2),9)
+61 WRITE ?55,+$GET(ABMTCCLM)
End DoDot:1
+62 WRITE !!
+63 WRITE !
+64 IF $GET(ABMFILE)'=""
WRITE !!,"EXPORTED IN FILE ",ABMFILE
Begin DoDot:1
+65 IF (+$GET(XBFLG)=0)
WRITE !!,"File was sent successfully"
+66 IF '(+$GET(XBFLG)=0)
WRITE !!,"File was **NOT** sent successfully"
+67 IF $GET(XBFLG(1))'=""
WRITE ?40,"- ",$GET(XBFLG(1))
End DoDot:1
+68 QUIT
SENDBTCH ;EP - ask export ques; export=yes
+1 SET ABMDT=0
+2 SET ABMAFLG=0
+3 FOR
SET ABMDT=$ORDER(ABMC(ABMDT))
IF +ABMDT=0
QUIT
Begin DoDot:1
+4 SET ABMUSER=0
+5 FOR
SET ABMUSER=$ORDER(ABMC(ABMDT,ABMUSER))
IF +ABMUSER=0
QUIT
Begin DoDot:2
+6 SET ABMDT2=0
+7 FOR
SET ABMDT2=$ORDER(ABMC(ABMDT,ABMUSER,ABMDT2))
IF +ABMDT2=0
QUIT
Begin DoDot:3
+8 IF +$PIECE($GET(ABMC(ABMDT,ABMUSER,ABMDT2)),U,3)=1
SET ABMAFLG=1
+9 ;no act-mark as reconciled
IF +$PIECE($GET(ABMC(ABMDT,ABMUSER,ABMDT2)),U,3)=0
Begin DoDot:4
+10 KILL DIC,DIE,DA,DR,X,Y
+11 SET DA(2)=DUZ(2)
+12 SET DA(1)=$SELECT(ABMUSER:ABMUSER,1:1)
+13 IF ABMUSER
SET DIE="^ABMUCASH("_DA(2)_",10,"_DA(1)_",20,"
+14 IF 'ABMUSER
SET DIE="^ABMUCASH("_DA(2)_",20,"_DA(1)_",20,"
+15 SET DA=ABMDT
+16 ;transmitted status w/dt
SET DR=".04///T;.08///NOW"
+17 DO ^DIE
End DoDot:4
End DoDot:3
End DoDot:2
IF ABMAFLG=1
QUIT
End DoDot:1
IF ABMAFLG=1
QUIT
+18 ;there aren't any bills, don't create exp file
IF +$GET(ABMSBTOT)=0
IF (+$GET(ABMAFLG)=0)
Begin DoDot:1
+19 WRITE !!,"There aren't any bills to export in this selection."
+20 WRITE !,"NO export file will be created"
End DoDot:1
QUIT
+21 KILL DIR
+22 SET DIR(0)="Y"
+23 SET DIR("A")="Do you want to SEND export now? <yes/no>"
+24 DO ^DIR
KILL DIR
+25 SET ABMXANS=+Y
+26 IF ABMXANS=0
Begin DoDot:1
+27 WRITE !,"EXITING Reconcile sessions option...NOTE: NOTHING IS BEING EXPORTED AT THIS TIME"
+28 DO PRINTSUM
End DoDot:1
QUIT
+29 IF ABMXANS=1
Begin DoDot:1
+30 DO EXPORT
+31 DO PRINTSUM
End DoDot:1
+32 QUIT
PRINTSUM ;EP - print sum?
+1 DO PRINTSUM^ABMURCN1
+2 QUIT
EXPORT ;EP-loop thru sess; export data
+1 ;Inv format:
+2 ; 1.Always D
+3 ; 2.<parASUFAC><satASUFAC>3P BILL IEN
+4 ; 3.Dt/Tm Approved (MM/DD/YYYY) from 3P Bill
+5 ; 4.TAX ID (.11) from Insurer file
+6 ; 5.<parASUFAC><satASUFAC>3P BILL#
+7 ; 6.Bill Amount (.21) from 3P Bill
+8 ; 7.CAN-calculated in IE
+9 ; 8.132 for HHS T-code
+10 ; 9.61704 for object class
+11 ;Trailer record format:
+12 ; 1.Always T for trailer
+13 ; 2.Number records
+14 ; 3.Total file amt
+15 DO FILENAME()
+1 KILL ^ABMUFMS($JOB)
+2 SET ABMTOT=0
+3 SET ABMRECT="D"
+4 SET ABMTCODE=132
+5 SET ABMOCL=61704
+6 SET ABMCNT=0
+7 SET ABMMIEN=0
+8 SET ABMSESS=0
+9 ;create exp btch
DO CREATBTH
+10 ;sess bills
+11 FOR
SET ABMSESS=$ORDER(ABMC(ABMSESS))
IF +ABMSESS=0
QUIT
Begin DoDot:1
+12 SET ABMDUZ=""
+13 FOR
SET ABMDUZ=$ORDER(ABMC(ABMSESS,ABMDUZ))
IF ABMDUZ=""
QUIT
Begin DoDot:2
+14 SET ABMSDT=0
+15 FOR
SET ABMSDT=$ORDER(ABMC(ABMSESS,ABMDUZ,ABMSDT))
IF +ABMSDT=0
QUIT
Begin DoDot:3
+16 IF ABMDUZ
Begin DoDot:4
+17 SET ABMSESID=ABMSDT
+18 SET ABMBA=0
+19 FOR
SET ABMBA=$ORDER(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,11,ABMBA))
IF +ABMBA=0
QUIT
Begin DoDot:5
+20 SET ABMBAOUT=$PIECE($GET(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,11,ABMBA,0)),U)
+21 ;don't export ben, Third Party Liab.
IF ABMBAOUT="I"!(ABMBAOUT="T")
QUIT
+22 SET ABMBIEN=0
+23 FOR
SET ABMBIEN=$ORDER(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,11,ABMBA,2,ABMBIEN))
IF +ABMBIEN=0
QUIT
Begin DoDot:6
+24 SET ABMPREC=$GET(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,11,ABMBA,2,ABMBIEN,0))
+25 DO RECORD
End DoDot:6
End DoDot:5
End DoDot:4
+26 ;POS CLMS
IF 'ABMDUZ
Begin DoDot:4
+27 SET ABMUSER=0
+28 FOR
SET ABMUSER=$ORDER(^ABMUCASH(ABMLOC,20,ABMUSER))
IF +ABMUSER=0
QUIT
Begin DoDot:5
+29 SET ABMBA=0
+30 FOR
SET ABMBA=$ORDER(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT,11,ABMBA))
IF +ABMBA=0
QUIT
Begin DoDot:6
+31 SET ABMBAOUT=$PIECE($GET(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT,11,ABMBA,0)),U)
+32 SET ABMBIEN=0
+33 FOR
SET ABMBIEN=$ORDER(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT,11,ABMBA,2,ABMBIEN))
IF +ABMBIEN=0
QUIT
Begin DoDot:7
+34 SET ABMPREC=$GET(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT,11,ABMBA,2,ABMBIEN,0))
+35 DO RECORD
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
+36 ;reque'd bills
+37 SET ABMRQB=0
+38 FOR
SET ABMRQB=$ORDER(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,12,ABMRQB))
IF +ABMRQB=0
QUIT
Begin DoDot:4
+39 SET ABMPREC=$GET(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,12,ABMRQB,0))
+40 ;S ABMBAOUT=$P($G(^AUTNINS($P($G(^ABMDBILL(ABMLOC,$P(ABMPREC,U,3),0)),U,8),2)),U) ;abm*2.6*11 HEAT73780
+41 ;abm*2.6*11 HEAT73780
SET ABMBAOUT=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+$PIECE($GET(^ABMDBILL(ABMLOC,$PIECE(ABMPREC,U,3),0)),U,8),".211","I"),1,"I")
+42 DO RECORD
End DoDot:4
+43 ;reque'd batches
+44 SET ABMRQB=0
+45 FOR
SET ABMRQB=$ORDER(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,13,ABMRQB))
IF +ABMRQB=0
QUIT
Begin DoDot:4
+46 ;batch IEN
SET ABMPBTCH=$PIECE($GET(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,13,ABMRQB,0)),U)
+47 FOR ABMLOOP=1,2
Begin DoDot:5
+48 SET ABMBUSER=0
+49 FOR
SET ABMBUSER=$ORDER(^ABMUTXMT(ABMPBTCH,ABMLOOP,ABMBUSER))
IF +ABMBUSER=0
QUIT
Begin DoDot:6
+50 SET ABMBSDT=0
+51 FOR
SET ABMBSDT=$ORDER(^ABMUTXMT(ABMPBTCH,ABMLOOP,ABMBUSER,2,ABMBSDT))
IF +ABMBSDT=0
QUIT
Begin DoDot:7
+52 SET ABMBBA=0
+53 FOR
SET ABMBBA=$ORDER(^ABMUTXMT(ABMPBTCH,ABMLOOP,ABMBUSER,2,ABMBSDT,11,ABMBBA))
IF +ABMBBA=0
QUIT
Begin DoDot:8
+54 SET ABMBAOUT=$PIECE($GET(^ABMUTXMT(ABMPBTCH,ABMLOOP,ABMBUSER,2,ABMBSDT,11,ABMBBA,0)),U)
+55 SET ABMBBIEN=0
+56 FOR
SET ABMBBIEN=$ORDER(^ABMUTXMT(ABMPBTCH,ABMLOOP,ABMBUSER,2,ABMBSDT,11,ABMBBA,2,ABMBBIEN))
IF +ABMBBIEN=0
QUIT
Begin DoDot:9
+57 SET ABMPREC=$GET(^ABMUTXMT(ABMPBTCH,ABMLOOP,ABMBUSER,2,ABMBSDT,11,ABMBBA,2,ABMBBIEN,0))
+58 DO RECORD
End DoDot:9
End DoDot:8
End DoDot:7
End DoDot:6
End DoDot:5
+59 ;3 mult entry of 3P UFMS Export file
DO REEXPB^ABMURCN1
End DoDot:4
+60 ;mark sess as Xmitted
+61 KILL DIC,DIE,DA,DR,X,Y
+62 SET DA(2)=ABMLOC
+63 SET DA(1)=$SELECT(ABMDUZ:ABMDUZ,1:1)
+64 IF ABMDUZ
SET DIE="^ABMUCASH("_DA(2)_",10,"_DA(1)_",20,"
+65 IF 'ABMDUZ
SET DIE="^ABMUCASH("_DA(2)_",20,"_DA(1)_",20,"
+66 SET DA=ABMSDT
+67 ;Xmitted status w/dt
SET DR=".04///T;.08///NOW"
+68 DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+69 IF '$DATA(^ABMUFMS($JOB))
QUIT
+70 DO TRAILER
+71 DO SENDFILE("ABMUFMS(",ABMFILE)
+72 QUIT
TRAILER ;EP
+1 SET ABMREC="T"_$$FMT^ABMERUTL(ABMCNT,"10R")_$TRANSLATE($$FMT^ABMERUTL($JUSTIFY(ABMTOT,".",2),"20NR"),".")
+2 SET ^ABMUFMS($JOB,(ABMCNT+1))=ABMREC
+3 QUIT
FILENAME() ;
+1 SET ABMLOC=$$FINDLOC^ABMUCUTL
+2 SET ABMFILE=$$GETFILNM($$ASUFAC^ABMUCUTL(ABMLOC,DT))
+3 WRITE !,"File will be created using the following name: ",!?5,ABMFILE
+4 IF ABMFILE'=""
QUIT 1
+5 QUIT 0
GETFILNM(ASUFACS) ;EP - CREATE FILE NAME
+1 NEW FNROOT,FNEXT,FN,YR,DATE,TIME
+2 KILL DATETIME
+3 SET FNROOT="IHS_TPB_RPMS_INV_"
+4 ;version piece 1 (before ".")
SET FNEXT="_"_$PIECE($$VERSION^XPDUTL("ABM"),".")_"."
+5 ;version piece 2 fmt'ed (after ".")
SET FNEXT=FNEXT_$$FMT^ABMERUTL($PIECE($$VERSION^XPDUTL("ABM"),".",2),"2NR")_"."
+6 ;patch#, default to 00
SET FNEXT=FNEXT_$SELECT(+$$LAST^ABMENVCK("IHS 3P BILLING SYSTEM",$$VERSION^XPDUTL("ABM"))>0:+$$LAST^ABMENVCK("IHS 3P BILLING SYSTEM",$$VERSION^XPDUTL("ABM")),1:"00")_"k.DAT"
+7 SET FN=FNROOT
+8 DO NOW^%DTC
+9 SET YR=1700+$EXTRACT(%,1,3)
+10 SET DATE=YR_$EXTRACT(%,4,7)
+11 SET Y=%
XECUTE ^DD("DD")
+12 SET TIME=$TRANSLATE($PIECE(Y,"@",2),":")
+13 SET DATETIME=DATE_"_"_TIME
+14 SET FN=FNROOT_ASUFACS_"_"_DATETIME
+15 SET FN=FN_FNEXT
+16 QUIT FN
SENDFILE(XBGL,XBFN) ;
+1 IF $GET(XBFN)=""
SET XBFN="UFMS.TST"
+2 IF $GET(XBGL)=""
SET XBGL="ABMTUFMS("
+3 SET XBQSHO=""
+4 ;Beg 1st lev numeric subscr
SET XBF=$JOB
+5 ;End 1st lev numeric subscr
SET XBE=$JOB
+6 ;indicates flat file
SET XBFLT=1
+7 ;Flag indicates file as media
SET XBMED="F"
+8 ;Q if non-cononic
SET XBCON=1
+9 ;ZISH SEND PARA entry
SET XBS1="ABM UFMS F"
+10 IF $DATA(ZTQUEUED)
SET XBS1="ABM UFMS B"
+11 SET XBQ="N"
+12 SET XBUF=$PIECE($GET(^ABMDPARM(ABMLOC,1,4)),U,13)
+13 IF XBUF=""
Begin DoDot:1
+14 WRITE !!,"Before UFMS files can be created a non-public directory must be created"
+15 WRITE !,"on the Host File System. This directory must be entered in to TPB Site Parameter"
+16 WRITE !,"field UFMS DIRECTORY using the 'SITM Site Parameter Maintenance' option"
+17 KILL DIR
+18 SET DIR(0)="E"
+19 DO ^DIR
End DoDot:1
QUIT
+20 SET XBFLG=0
+21 IF XBUF=""
Begin DoDot:1
+22 SET XBFLG=-1
+23 SET XBFLG(1)="Missing UFMS storage directory. Please check TPB UFMS Parameters"
End DoDot:1
QUIT
+24 DO ^XBGSAVE
+25 QUIT
RECORD ;EP - get pieces; put together rec
+1 DO RECORD^ABMURCN2
+2 QUIT
CREATBTH ;EP - create UFMS export entry
+1 DO CREATBTH^ABMURCN1
+2 QUIT
BATCH ;EP - put bill in batch file
+1 DO BATCH^ABMURCN1
+2 QUIT
BILL ;EP - put entry in bill mult for transmit dt & save UFMS inv#
+1 ;transmit dt
+2 DO BILL^ABMURCN1
+3 QUIT
NOSEND ;EP - don't send but mark reconciled
+1 DO NOSEND^ABMURCN1
+2 QUIT
RCONSESS ;mark session as transmitted
+1 DO RCONSESS^ABMURCN1
+2 QUIT
XIT ;EP
+1 KILL ABMBAL,ABMC,ABMO,ABMOS
+2 KILL ABMSESID,ABMSESS,ABMDUZ,ABMDUZ2,ABMPASUF,ABMSASUF,ABMPREC
+3 KILL ABMBAOUT,ABMSDT,ABMLINE
+4 QUIT
