- 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