ABMPUEXT ; IHS/SD/SDR - UFMS Re-extract of bills
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
Q
;Invoice file format:
; 1. Always D for Invoice (Bill)
; 2. <parent ASUFAC><satellite ASUFAC>3P BILL IEN
; 3. Date/Time Approved (MM/DD/YYYY) from 3P Bill file
; 4. TAX ID (.11) from Insurer file
; 5. <parent ASUFAC><satellite ASUFAC>3P BILL NUMBER
; 6. Bill Amount (.21) from 3P Bill file
; 7. CAN--for test set based on insurer type
; 8. Always (for now) 132 for HHS T-code
; 9. Always (for now) 61704 for object class
;
;Trailer record format:
; 1. Always T for trailer
; 2. Number of records
; 3. Total file amount
;
FROMDT ;EP
S ABMFROM=3071001
TODT ;
I $G(DT)="" D NOW^%DTC S DT=%
S ABMTO=DT
;
D FILENAME()
D OPENLIST ;compile list of bills in open sessions
;
D CREATBTH ;create entry in 3P UFMS Export file
;
K ^ABMTUFMS($J)
S ABMTOT=0
S ABMRECT="D"
S ABMTCODE=132
S ABMOCL=61704
S ABMCNT=1
D NOW^%DTC
S ABMSTART=%
S ABMDUZ2=0
F S ABMDUZ2=$O(^ABMDBILL(ABMDUZ2)) Q:+ABMDUZ2=0 D
.Q:$D(^ABMDPARM(ABMDUZ2,1))'=10
.S ABMADIEN=$O(^AUTTLOC(ABMDUZ2,11,9999999),-1)
.Q:+ABMADIEN=0
.Q:$P($G(^AUTTLOC(ABMDUZ2,11,ABMADIEN,0)),U,3)'=1 ;not IHS affiliation
.S ABMLDT=(ABMFROM-.5)
.F S ABMLDT=$O(^ABMDBILL(ABMDUZ2,"AP",ABMLDT)) Q:ABMLDT=""!(($P(ABMLDT,"."))>ABMTO) D
..S ABMP("BDFN")=0
..F S ABMP("BDFN")=$O(^ABMDBILL(ABMDUZ2,"AP",ABMLDT,ABMP("BDFN"))) Q:+ABMP("BDFN")=0 D
...Q:$D(^TMP($J,"ABMUB",ABMDUZ2,ABMP("BDFN"))) ;quit if bill is on open list
...S ABMDTAPP=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),1)),U,5) ;date/time approved
...S ABMP("INS")=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8) ;active insurer
...Q:$P($G(^AUTNINS(ABMP("INS"),2)),U)="I"!($P($G(^AUTNINS(ABMP("INS"),2)),U)="T") ;no Ben or Third Party Liab.
...S ABMDUZ=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),1)),U,4) ;approving offical
...;
...S ABMTAXID=$TR($P($G(^AUTNINS(ABMP("INS"),0)),U,11),"-") ;TAX ID
...;
...S ABMEXCLD=$$BILL^ABMUEAPI(ABMDUZ2,ABMP("BDFN")) ;exclusion table entry?
...I ABMEXCLD<1 D BATCH,BILL Q ;flag as excluded data in batch/on bill & quit
...;
...S ABMP("LDFN")=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,3) ;visit location
...S ABMPDOS=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),7)),U,1) ;service date
...S ABMPRNTL=0
...S ABMPFLG=0
...F S ABMPRNTL=$O(^BAR(90052.05,ABMPRNTL)) Q:+ABMPRNTL=0 D Q:ABMPFLG=1
....I $D(^BAR(90052.05,ABMPRNTL,DUZ(2))) D
.....I ABMPDOS<$P($G(^BAR(90052.05,ABMPRNTL,DUZ(2),0)),U,6) Q
.....S ABMPFLG=1
...S ABMPASUF=$$ASUFAC($S(+$G(ABMPRNTL)'=0:ABMPRNTL,1:DUZ(2)),ABMPDOS)
...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(ABMDUZ2,ABMP("BDFN"),0)),U) ;Bill Number
...S ABMP("BAMT")=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U) ;bill amount
...S ABMP("ITYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U)
...S ABMCLN=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,10)
...;
...;CAN number
...S ABMCAN=$$EP^ABMUCAPI(ABMP("ITYP"),ABMCLN,ABMDTAPP,ABMSASUF)
...;
...S ABMCNT=ABMCNT+1
...S ABMP(ABMDUZ2)=+$G(ABMP(ABMDUZ2))+1
...;
...S ABMUAOF=$P($G(^ABMDPARM(ABMP("LDFN"),1,4)),U,17) ;use asufac of
...;
...S ABMINV=$$FMT^ABMERUTL(ABMPASUF_$S(+$G(ABMUAOF)'=0:$$ASUFAC(ABMUAOF)_$E($P($G(^DIC(4,ABMP("LDFN"),0)),U),1),+$G(ABMUAOF)=0:ABMSASUF,1:"")_ABMP("BDFN"),20)
...S ABMREC=ABMRECT_ABMINV
...S ABMREC=ABMREC_$$SDT^ABMDUTL(ABMDTAPP)
...S ABMREC=ABMREC_$$FMT^ABMERUTL(ABMTAXID,10)
...S ABMDESC=ABMPASUF_$S(+$G(ABMUAOF)'=0:$$ASUFAC(ABMUAOF)_$E($P($G(^DIC(4,ABMP("LDFN"),0)),U),1),+$G(ABMUAOF)=0:ABMSASUF,1:"")_ABMPBNUM
...S ABMREC=ABMREC_$$FMT^ABMERUTL(ABMDESC,100)
...S ABMREC=ABMREC_$$FMT^ABMERUTL($TR($J(ABMP("BAMT"),".",2),"."),"20NR")
...S ABMREC=ABMREC_$$FMT^ABMERUTL("","10R") ;no CAN
...S ABMREC=ABMREC_$$FMT^ABMERUTL(ABMTCODE,"10R")
...S ABMREC=ABMREC_ABMOCL
...S ABMREC=ABMREC_ABMCAN ;ba/cc
...I "^R^MD^MH^"[("^"_ABMP("ITYP")_"^") S ABMPTIN="MCR"
...I "^D^K^"[("^"_ABMP("ITYP")_"^") S ABMPTIN="MCD"
...I "^H^M^P^F^"[("^"_ABMP("ITYP")_"^") S ABMPTIN="PRV"
...I "^W^C^N^"[("^"_ABMP("ITYP")_"^") S ABMPTIN="OTH"
...S ABMPTIN=ABMSASUF_ABMPTIN
...S ABMREC=ABMREC_ABMPTIN
...;
...S ^ABMTUFMS($J,ABMCNT)=ABMREC
...;set vars for BATCH tag
...S ABMDUZ=DUZ
...S ABMSDT=ABMSTART
...S ABMBAOUT=ABMP("ITYP")
...S ABMPREC=ABMPBNUM_"^"_ABMDUZ2_"^"_ABMP("BDFN")_"^"_ABMP("BAMT")
...D BATCH,BILL ;put exported entry in batch/bill
...S ABMTOT=+$G(ABMTOT)+(ABMP("BAMT"))
...D DOTS(ABMCNT)
;
Q:'$D(^ABMTUFMS($J))
K ^TMP($J)
D TRAILER
D SENDFILE("ABMTUFMS(",ABMFILE)
D NOW^%DTC
S ABMEND=%
W !,"START ",ABMSTART
W !,"END ",ABMEND
W !,"RECORD COUNTS"
S ABMDUZ2=0
F S ABMDUZ2=$O(ABMP(ABMDUZ2)) Q:+ABMDUZ2=0 D
.W !,ABMDUZ2,?6,+$G(ABMP(ABMDUZ2))
S ^ABMUFEXP("EXPORT COMPLETE")=ABMEND
Q
;
TRAILER ;EP
S ABMREC="T"_$$FMT^ABMERUTL(ABMCNT,"10R")_$TR($$FMT^ABMERUTL(ABMTOT,"20NR"),".")
S ^ABMTUFMS($J,(ABMCNT+1))=ABMREC
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
;
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,DATETIME
S FNROOT="IHS_TPB_RPMS_INV_POST_INIT_"
S FNEXT="_"_$P($$VERSION^XPDUTL("ABM"),".")_"."_$$FMT^ABMERUTL($P($$VERSION^XPDUTL("ABM"),".",2),"2NR")_"."_+$$LAST^ABMENVCK("IHS 3P BILLING SYSTEM",$$VERSION^XPDUTL("ABM"))_"k.DAT" ;version/patch in format 2.05.13
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
;
OPENLIST ;EP - compile list of bills in open sessions
S ABMCL=0
F S ABMCL=$O(^ABMUCASH(ABMCL)) Q:+ABMCL=0 D ;location loop
.F ABMULP=10,20 D ;user then POS entries
..S ABMUSER=0
..F S ABMUSER=$O(^ABMUCASH(ABMCL,ABMULP,ABMUSER)) Q:+ABMUSER=0 D ;user loop
...S ABMSDT=0
...F S ABMSDT=$O(^ABMUCASH(ABMCL,ABMULP,ABMUSER,20,ABMSDT)) Q:+ABMSDT=0 D ;sign-in dt loop
....Q:$P($G(^ABMUCASH(ABMCL,ABMULP,ABMUSER,20,ABMSDT,0)),U,8)'="" ;has transmission date
....Q:$P($G(^ABMUCASH(ABMCL,ABMULP,ABMUSER,20,ABMSDT,0)),U,7)'="" ;has reconciled date (tribal)
....S ABMBA=0
....F S ABMBA=$O(^ABMUCASH(ABMCL,ABMULP,ABMUSER,20,ABMSDT,11,ABMBA)) Q:+ABMBA=0 D ;budget act.loop
.....S ABMABIL=0
.....F S ABMABIL=$O(^ABMUCASH(ABMCL,ABMULP,ABMUSER,20,ABMSDT,11,ABMBA,2,ABMABIL)) Q:+ABMABIL=0 D ;appr. bill loop
......S ABMREC=$G(^ABMUCASH(ABMCL,ABMULP,ABMUSER,20,ABMSDT,11,ABMBA,2,ABMABIL,0))
......S ^TMP($J,"ABMUB",$P(ABMREC,U,2),$P(ABMREC,U,3))=$P(ABMREC,U)
Q
;
CREATBTH ;EP - create UFMS export entry
S DIC="^ABMUTXMT("
S DIC("DR")=".02////"_ABMFILE_";.03////"_DUZ_";.04////"_ABMLOC
S DIC(0)="L"
D NOW^%DTC
S X=%
D ^DIC
K DIC
Q:Y<0
S ABMPXMIT=+Y
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
;
;remove all current entries
K DIC,DIE,X,Y,DA
S DA(1)=ABMP("BDFN")
S DIK="^ABMDBILL("_ABMDUZ2_",DA(1),69,"
S ABMDA=0
F S ABMDA=$O(^ABMDBILL(ABMDUZ2,DA(1),69,ABMDA)) Q:+ABMDA=0 D
.S DA=ABMDA
.D ^DIK
;
;creates entry
K DIC,DIE,X,Y,DA
S DIC(0)="L"
S DA(1)=ABMP("BDFN")
S DIC="^ABMDBILL("_ABMDUZ2_",DA(1),69,"
S DIC("P")=$P(^DD(9002274.4,69,0),U,2)
S X=ABMPXMIT ;date from batch
S DIC("DR")=".02////"_ABMPASUF_ABMSASUF_$S(+$G(ABMUAOF)'=0:$E($P($G(^DIC(4,ABMP("LDFN"),0)),U),1),1:"")_ABMP("BDFN")
I ABMEXCLD<1 S DIC("DR")=DIC("DR")_";.03////1" ;excluded data
D ^DIC
Q
;
SENDFILE(XBGL,XBFN) ;
S:$G(XBFN)="" XBFN="UFMS.TST"
S:$G(XBGL)="" XBGL="ABMTUFMS("
S XBQSHO=""
S XBF=$J ; Beginning 1st level numeric subscript
S XBE=$J ; Ending 1st level numeric subscript
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 PARAMETERS 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 'SET UFMS Setup' 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
DOTS(X) ;EP - WRITE OUT A DOT EVERY HUNDRED
U IO(0)
W:'(X#100) "."
Q
ABMPUEXT ; IHS/SD/SDR - UFMS Re-extract of bills
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 QUIT
+3 ;Invoice file format:
+4 ; 1. Always D for Invoice (Bill)
+5 ; 2. <parent ASUFAC><satellite ASUFAC>3P BILL IEN
+6 ; 3. Date/Time Approved (MM/DD/YYYY) from 3P Bill file
+7 ; 4. TAX ID (.11) from Insurer file
+8 ; 5. <parent ASUFAC><satellite ASUFAC>3P BILL NUMBER
+9 ; 6. Bill Amount (.21) from 3P Bill file
+10 ; 7. CAN--for test set based on insurer type
+11 ; 8. Always (for now) 132 for HHS T-code
+12 ; 9. Always (for now) 61704 for object class
+13 ;
+14 ;Trailer record format:
+15 ; 1. Always T for trailer
+16 ; 2. Number of records
+17 ; 3. Total file amount
+18 ;
FROMDT ;EP
+1 SET ABMFROM=3071001
TODT ;
+1 IF $GET(DT)=""
DO NOW^%DTC
SET DT=%
+2 SET ABMTO=DT
+3 ;
+4 DO FILENAME()
+5 ;compile list of bills in open sessions
DO OPENLIST
+6 ;
+1 ;create entry in 3P UFMS Export file
DO CREATBTH
+2 ;
+3 KILL ^ABMTUFMS($JOB)
+4 SET ABMTOT=0
+5 SET ABMRECT="D"
+6 SET ABMTCODE=132
+7 SET ABMOCL=61704
+8 SET ABMCNT=1
+9 DO NOW^%DTC
+10 SET ABMSTART=%
+11 SET ABMDUZ2=0
+12 FOR
SET ABMDUZ2=$ORDER(^ABMDBILL(ABMDUZ2))
IF +ABMDUZ2=0
QUIT
Begin DoDot:1
+13 IF $DATA(^ABMDPARM(ABMDUZ2,1))'=10
QUIT
+14 SET ABMADIEN=$ORDER(^AUTTLOC(ABMDUZ2,11,9999999),-1)
+15 IF +ABMADIEN=0
QUIT
+16 ;not IHS affiliation
IF $PIECE($GET(^AUTTLOC(ABMDUZ2,11,ABMADIEN,0)),U,3)'=1
QUIT
+17 SET ABMLDT=(ABMFROM-.5)
+18 FOR
SET ABMLDT=$ORDER(^ABMDBILL(ABMDUZ2,"AP",ABMLDT))
IF ABMLDT=""!(($PIECE(ABMLDT,"."))>ABMTO)
QUIT
Begin DoDot:2
+19 SET ABMP("BDFN")=0
+20 FOR
SET ABMP("BDFN")=$ORDER(^ABMDBILL(ABMDUZ2,"AP",ABMLDT,ABMP("BDFN")))
IF +ABMP("BDFN")=0
QUIT
Begin DoDot:3
+21 ;quit if bill is on open list
IF $DATA(^TMP($JOB,"ABMUB",ABMDUZ2,ABMP("BDFN")))
QUIT
+22 ;date/time approved
SET ABMDTAPP=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),1)),U,5)
+23 ;active insurer
SET ABMP("INS")=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8)
+24 ;no Ben or Third Party Liab.
IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)="I"!($PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)="T")
QUIT
+25 ;approving offical
SET ABMDUZ=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),1)),U,4)
+26 ;
+27 ;TAX ID
SET ABMTAXID=$TRANSLATE($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U,11),"-")
+28 ;
+29 ;exclusion table entry?
SET ABMEXCLD=$$BILL^ABMUEAPI(ABMDUZ2,ABMP("BDFN"))
+30 ;flag as excluded data in batch/on bill & quit
IF ABMEXCLD<1
DO BATCH
DO BILL
QUIT
+31 ;
+32 ;visit location
SET ABMP("LDFN")=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,3)
+33 ;service date
SET ABMPDOS=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),7)),U,1)
+34 SET ABMPRNTL=0
+35 SET ABMPFLG=0
+36 FOR
SET ABMPRNTL=$ORDER(^BAR(90052.05,ABMPRNTL))
IF +ABMPRNTL=0
QUIT
Begin DoDot:4
+37 IF $DATA(^BAR(90052.05,ABMPRNTL,DUZ(2)))
Begin DoDot:5
+38 IF ABMPDOS<$PIECE($GET(^BAR(90052.05,ABMPRNTL,DUZ(2),0)),U,6)
QUIT
+39 SET ABMPFLG=1
End DoDot:5
End DoDot:4
IF ABMPFLG=1
QUIT
+40 SET ABMPASUF=$$ASUFAC($SELECT(+$GET(ABMPRNTL)'=0:ABMPRNTL,1:DUZ(2)),ABMPDOS)
+41 ;use asufac of
SET ABMUAOF=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,4)),U,17)
+42 SET ABMSASUF=$$ASUFAC($SELECT(+$GET(ABMUAOF)'=0:ABMUAOF,1:ABMP("LDFN")),ABMPDOS)
+43 ;Bill Number
SET ABMPBNUM=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
+44 ;bill amount
SET ABMP("BAMT")=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U)
+45 SET ABMP("ITYP")=$PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)
+46 SET ABMCLN=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,10)
+47 ;
+48 ;CAN number
+49 SET ABMCAN=$$EP^ABMUCAPI(ABMP("ITYP"),ABMCLN,ABMDTAPP,ABMSASUF)
+50 ;
+51 SET ABMCNT=ABMCNT+1
+52 SET ABMP(ABMDUZ2)=+$GET(ABMP(ABMDUZ2))+1
+53 ;
+54 ;use asufac of
SET ABMUAOF=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,4)),U,17)
+55 ;
+56 SET ABMINV=$$FMT^ABMERUTL(ABMPASUF_$SELECT(+$GET(ABMUAOF)'=0:$$ASUFAC(ABMUAOF)_$EXTRACT($PIECE($GET(^DIC(4,ABMP("LDFN"),0)),U),1),+$GET(ABMUAOF)=0:ABMSASUF,1:"")_ABMP("BDFN"),20)
+57 SET ABMREC=ABMRECT_ABMINV
+58 SET ABMREC=ABMREC_$$SDT^ABMDUTL(ABMDTAPP)
+59 SET ABMREC=ABMREC_$$FMT^ABMERUTL(ABMTAXID,10)
+60 SET ABMDESC=ABMPASUF_$SELECT(+$GET(ABMUAOF)'=0:$$ASUFAC(ABMUAOF)_$EXTRACT($PIECE($GET(^DIC(4,ABMP("LDFN"),0)),U),1),+$GET(ABMUAOF)=0:ABMSASUF,1:"")_ABMPBNUM
+61 SET ABMREC=ABMREC_$$FMT^ABMERUTL(ABMDESC,100)
+62 SET ABMREC=ABMREC_$$FMT^ABMERUTL($TRANSLATE($JUSTIFY(ABMP("BAMT"),".",2),"."),"20NR")
+63 ;no CAN
SET ABMREC=ABMREC_$$FMT^ABMERUTL("","10R")
+64 SET ABMREC=ABMREC_$$FMT^ABMERUTL(ABMTCODE,"10R")
+65 SET ABMREC=ABMREC_ABMOCL
+66 ;ba/cc
SET ABMREC=ABMREC_ABMCAN
+67 IF "^R^MD^MH^"[("^"_ABMP("ITYP")_"^")
SET ABMPTIN="MCR"
+68 IF "^D^K^"[("^"_ABMP("ITYP")_"^")
SET ABMPTIN="MCD"
+69 IF "^H^M^P^F^"[("^"_ABMP("ITYP")_"^")
SET ABMPTIN="PRV"
+70 IF "^W^C^N^"[("^"_ABMP("ITYP")_"^")
SET ABMPTIN="OTH"
+71 SET ABMPTIN=ABMSASUF_ABMPTIN
+72 SET ABMREC=ABMREC_ABMPTIN
+73 ;
+74 SET ^ABMTUFMS($JOB,ABMCNT)=ABMREC
+75 ;set vars for BATCH tag
+76 SET ABMDUZ=DUZ
+77 SET ABMSDT=ABMSTART
+78 SET ABMBAOUT=ABMP("ITYP")
+79 SET ABMPREC=ABMPBNUM_"^"_ABMDUZ2_"^"_ABMP("BDFN")_"^"_ABMP("BAMT")
+80 ;put exported entry in batch/bill
DO BATCH
DO BILL
+81 SET ABMTOT=+$GET(ABMTOT)+(ABMP("BAMT"))
+82 DO DOTS(ABMCNT)
End DoDot:3
End DoDot:2
End DoDot:1
+83 ;
+84 IF '$DATA(^ABMTUFMS($JOB))
QUIT
+85 KILL ^TMP($JOB)
+86 DO TRAILER
+87 DO SENDFILE("ABMTUFMS(",ABMFILE)
+88 DO NOW^%DTC
+89 SET ABMEND=%
+90 WRITE !,"START ",ABMSTART
+91 WRITE !,"END ",ABMEND
+92 WRITE !,"RECORD COUNTS"
+93 SET ABMDUZ2=0
+94 FOR
SET ABMDUZ2=$ORDER(ABMP(ABMDUZ2))
IF +ABMDUZ2=0
QUIT
Begin DoDot:1
+95 WRITE !,ABMDUZ2,?6,+$GET(ABMP(ABMDUZ2))
End DoDot:1
+96 SET ^ABMUFEXP("EXPORT COMPLETE")=ABMEND
+97 QUIT
+98 ;
TRAILER ;EP
+1 SET ABMREC="T"_$$FMT^ABMERUTL(ABMCNT,"10R")_$TRANSLATE($$FMT^ABMERUTL(ABMTOT,"20NR"),".")
+2 SET ^ABMTUFMS($JOB,(ABMCNT+1))=ABMREC
+3 QUIT
+4 ;
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 ;
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
+6 ;
GETFILNM(ASUFACS) ;EP - create file name
+1 NEW FNROOT,FNEXT,FN,YR,DATE,TIME,DATETIME
+2 SET FNROOT="IHS_TPB_RPMS_INV_POST_INIT_"
+3 ;version/patch in format 2.05.13
SET FNEXT="_"_$PIECE($$VERSION^XPDUTL("ABM"),".")_"."_$$FMT^ABMERUTL($PIECE($$VERSION^XPDUTL("ABM"),".",2),"2NR")_"."_+$$LAST^ABMENVCK("IHS 3P BILLING SYSTEM",$$VERSION^XPDUTL("ABM"))_"k.DAT"
+4 SET FN=FNROOT
+5 DO NOW^%DTC
+6 SET YR=1700+$EXTRACT(%,1,3)
+7 SET DATE=YR_$EXTRACT(%,4,7)
+8 SET Y=%
XECUTE ^DD("DD")
+9 SET TIME=$TRANSLATE($PIECE(Y,"@",2),":")
+10 SET DATETIME=DATE_"_"_TIME
+11 SET FN=FNROOT_ASUFACS_"_"_DATETIME
+12 SET FN=FN_FNEXT
+13 QUIT FN
+14 ;
OPENLIST ;EP - compile list of bills in open sessions
+1 SET ABMCL=0
+2 ;location loop
FOR
SET ABMCL=$ORDER(^ABMUCASH(ABMCL))
IF +ABMCL=0
QUIT
Begin DoDot:1
+3 ;user then POS entries
FOR ABMULP=10,20
Begin DoDot:2
+4 SET ABMUSER=0
+5 ;user loop
FOR
SET ABMUSER=$ORDER(^ABMUCASH(ABMCL,ABMULP,ABMUSER))
IF +ABMUSER=0
QUIT
Begin DoDot:3
+6 SET ABMSDT=0
+7 ;sign-in dt loop
FOR
SET ABMSDT=$ORDER(^ABMUCASH(ABMCL,ABMULP,ABMUSER,20,ABMSDT))
IF +ABMSDT=0
QUIT
Begin DoDot:4
+8 ;has transmission date
IF $PIECE($GET(^ABMUCASH(ABMCL,ABMULP,ABMUSER,20,ABMSDT,0)),U,8)'=""
QUIT
+9 ;has reconciled date (tribal)
IF $PIECE($GET(^ABMUCASH(ABMCL,ABMULP,ABMUSER,20,ABMSDT,0)),U,7)'=""
QUIT
+10 SET ABMBA=0
+11 ;budget act.loop
FOR
SET ABMBA=$ORDER(^ABMUCASH(ABMCL,ABMULP,ABMUSER,20,ABMSDT,11,ABMBA))
IF +ABMBA=0
QUIT
Begin DoDot:5
+12 SET ABMABIL=0
+13 ;appr. bill loop
FOR
SET ABMABIL=$ORDER(^ABMUCASH(ABMCL,ABMULP,ABMUSER,20,ABMSDT,11,ABMBA,2,ABMABIL))
IF +ABMABIL=0
QUIT
Begin DoDot:6
+14 SET ABMREC=$GET(^ABMUCASH(ABMCL,ABMULP,ABMUSER,20,ABMSDT,11,ABMBA,2,ABMABIL,0))
+15 SET ^TMP($JOB,"ABMUB",$PIECE(ABMREC,U,2),$PIECE(ABMREC,U,3))=$PIECE(ABMREC,U)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
CREATBTH ;EP - create UFMS export entry
+1 SET DIC="^ABMUTXMT("
+2 SET DIC("DR")=".02////"_ABMFILE_";.03////"_DUZ_";.04////"_ABMLOC
+3 SET DIC(0)="L"
+4 DO NOW^%DTC
+5 SET X=%
+6 DO ^DIC
+7 KILL DIC
+8 IF Y<0
QUIT
+9 SET ABMPXMIT=+Y
+10 QUIT
+11 ;
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 ;
+3 ;remove all current entries
+4 KILL DIC,DIE,X,Y,DA
+5 SET DA(1)=ABMP("BDFN")
+6 SET DIK="^ABMDBILL("_ABMDUZ2_",DA(1),69,"
+7 SET ABMDA=0
+8 FOR
SET ABMDA=$ORDER(^ABMDBILL(ABMDUZ2,DA(1),69,ABMDA))
IF +ABMDA=0
QUIT
Begin DoDot:1
+9 SET DA=ABMDA
+10 DO ^DIK
End DoDot:1
+11 ;
+12 ;creates entry
+13 KILL DIC,DIE,X,Y,DA
+14 SET DIC(0)="L"
+15 SET DA(1)=ABMP("BDFN")
+16 SET DIC="^ABMDBILL("_ABMDUZ2_",DA(1),69,"
+17 SET DIC("P")=$PIECE(^DD(9002274.4,69,0),U,2)
+18 ;date from batch
SET X=ABMPXMIT
+19 SET DIC("DR")=".02////"_ABMPASUF_ABMSASUF_$SELECT(+$GET(ABMUAOF)'=0:$EXTRACT($PIECE($GET(^DIC(4,ABMP("LDFN"),0)),U),1),1:"")_ABMP("BDFN")
+20 ;excluded data
IF ABMEXCLD<1
SET DIC("DR")=DIC("DR")_";.03////1"
+21 DO ^DIC
+22 QUIT
+23 ;
SENDFILE(XBGL,XBFN) ;
+1 IF $GET(XBFN)=""
SET XBFN="UFMS.TST"
+2 IF $GET(XBGL)=""
SET XBGL="ABMTUFMS("
+3 SET XBQSHO=""
+4 ; Beginning 1st level numeric subscript
SET XBF=$JOB
+5 ; Ending 1st level numeric subscript
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 PARAMETERS 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 'SET UFMS Setup' option"
+17 KILL DIR
+18 SET DIR(0)="E"
+19 DO ^DIR
End DoDot:1
QUIT
+20 SET XBFLG=0
+21 ;
+22 IF XBUF=""
Begin DoDot:1
+23 SET XBFLG=-1
+24 SET XBFLG(1)="Missing UFMS storage directory. Please check TPB UFMS Parameters"
End DoDot:1
QUIT
+25 DO ^XBGSAVE
+26 QUIT
DOTS(X) ;EP - WRITE OUT A DOT EVERY HUNDRED
+1 USE IO(0)
+2 IF '(X#100)
WRITE "."
+3 QUIT
