BARRQ ; IHS/SD/TPF - Re-queue A/R Transactions for UFMS export ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23**;OCT 26,2005;Build 38
; IHS/SD/TMM - 10/01/09 - V1.8*14 - Re-transmit indiv. A/R Trans; Re-transmit individual A/R Trans
; IHS/SD/TPF 7/14/2011 COPIED FROM BZHIXMP. CLEANED UP FOR READABILITY
;OCT 24 2012 HEAT# 80306 P.OTT (PARAMETER PASSING ADDED TO RESEND)
Q
REQUEUE ;Re-queue based on TPB, A/R lists
D MSG^BARRQ2
N FLAG,REJECT,ESC,BARRQDT,NEWDUZ,NEWSESS,NEWUSRNM,BARRNAM,ERASTA,LIST,CHOICE
N BARSEL,BARCNT,BARCNTS,BARCNTE,REJEC,FN,CB,SS
S FLAG=0
D HOME^%ZIS
W @IOF
D ^BARBAN
D NOW^%DTC
S BARRQDT=%
D INIT
D OPENSESS^BARRQ1(.REJECT,.ESC) ;CREATE NEW OPEN SESS
Q:ESC=U!(ESC="")
G:$G(REJECT) REQUEUE
I NEWDUZ="",(NEWSESS=""),(NEWUSRNM="") Q
I NEWDUZ="" W !!!,"***** NEW OPEN SESSION NOT CREATED *****" G REQUEUE
K ^TMP($J,BARRNAM,$J)
D REQTYP ;SELECT HOW TO PROCESS TX
S ERATSTA=0
;LIST(1)="398^3110905.150246^"
S LIST(1)=NEWDUZ_U_NEWSESS_U
S CHOICE=1
D DISPLAYT^BARUFLOG(NEWDUZ,NEWSESS,"VIEW",ERATSTA)
G REQUEUE
Q
INIT ;
K BAR3PB
S (BARSAVE,NEWDUZ,NEWSESS,NEWUSRNM,FN,CB,SS)=""
S (BARCNT,BARCNTS,BARCNTE,REJECT,ESC)=0
S BARRNAM=$P($T(+1)," ")
S $P(DASHLINE,"-",81)=""
Q
REQTYP ;CHOOSE METHOD
W !!
W !,?6,"RE-QUEUE A/R TRANSACTIONS FOR UFMS EXPORT"
K DIR
D SETRQTYP^BARRQ1(.DIR) ;INIT DIR HELP
S DIR(0)="SO^I:INDIVIDUAL A/R TRANSACTION IEN;"
S DIR(0)=DIR(0)_"F:FILE OF A/R TRANSACTION IENs;"
S DIR(0)=DIR(0)_"B:INDIVIDUAL 3P BILL NUMBER;"
S DIR(0)=DIR(0)_"FB:FILE OF TPB BILLS;"
S DIR(0)=DIR(0)_"FN:SEARCH FOR FILENAME IN A/R TRANSACTION FILE "_$G(FN)_";"
S DIR(0)=DIR(0)_"CB:SEARCH BY COL BATCH "_$G(CB)_";"
S DIR(0)=DIR(0)_"SS:SEARCH FOR A TX IN A SESSION "_$G(SS)_";"
S DIR(0)=DIR(0)_"RQ:RE-Q COMPILED SEARCH DATA;"
S DIR("A")="HOW WILL THESE TRANSACTIONS BE RE-QUEUED FOR EXPORT?"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!(Y="")
S BARSEL=Y
I BARSEL="FN"!(BARSEL="CB")!(BARSEL="SS")!(BARSEL="RQ"),(FLAG) D G REQTYP
.W !,"YOU HAVE TRANSACTIONS QUEUED USING THE I,F,B OR FB OPTIONS."
.W !,"PRESS RETURN AND TRANSMIT THESE TXs BEFORE USING THIS OPTION!"
I BARSEL="I" D EN G REQTYP ;INDIVIDUAL OR LIST OF A/R TX
I BARSEL="F" D TXFILE G REQTYP ;FILE OF TXS
I BARSEL="B" D BLLIST G REQTYP ;INDIVIDUAL OR LIST OF 3P EXTERNAL BILL
I BARSEL="FB" D TPBFILE G REQTYP ;FILE OF EXTERNAL 3P BILLS
I BARSEL="FN" D FNSEARCH^BARRQ1(.FN) G REQTYP ;SEARCH FOR TX USING FILENAME
I BARSEL="CB" D CBSEARCH^BARRQ1(.CB) G REQTYP ;"" USING COL BATCH
I BARSEL="SS" D SSEARCH^BARRQ1(.SS) G REQTYP ;"" USING SESSION
I BARSEL="RQ" D PROCESS^BARRQ1 K ^TMP($J,BARRNAM,$J),FN,CB,SS ;PROCESS SEARCH DATA IN ^TMP($J,BARRNAM,$J,TX)
G REQTYP
Q
;
EN ;EP - RE-QUE TRANS
;PROMPT FOR A/R TRANS TO BE RE-QUEUED
N TRLIST
ASKAGAIN ;EP
W !!,"THE PROMPT WILL BE PRESENTED OVER AND OVER"
W !,"SO YOU CAN ENTER MORE THAN ONE A/R TRANSACTION."
W !,"WHEN YOU ARE DONE ENTERING TRANSACTIONS PRESS RETURN."
W !
K DIR,DIC,DIE,DA,DR
S DIC="^BARTR(DUZ(2),"
S DIC(0)="AEQM"
S DIC("S")="I $P($G(^(1)),U)'=49,($P($G(^(1)),U)'=115),($P($G(^(1)),U)'=117)"
D ^DIC
Q:Y<0&('$D(TRLIST))
I Y>0 D G ASKAGAIN
.I $D(^BARSESS(DUZ(2),"NS",+Y)) D Q
..W !!,"TRANSACTION IN THE 'NOT SEND' STATUS"
..W !,"TX NOT ALLOWED!"
.S BARTRIEN=+Y
.I $$PAYREV(BARTRIEN) D Q
..W !,"NOT RE-QUEUED: TRANSACTION IS PAY REV"
.S BARTR1=$G(^BARTR(DUZ(2),BARTRIEN,1))
.S BARTXTYP=$P(BARTR1,U),BARTXADJ=$P(BARTR1,U,2)
.I BARTXTYP=49!(BARTXTYP=115)!(BARTXTYP=117) D Q
..W:BARTXTYP=49 !,"NOT RE-QUEUED: BILL NEW TYPE"
..W:BARTXTYP=115 !,"NOT RE-QUEUED: COL BAT TO ACC POST"
..W:BARTXTYP=117 !,"NOT RE-QUEUED: COL BAT TO FACILITY"
.I BARTXADJ=21!(BARTXADJ=22) D Q
..W:BARTXADJ=21 !,"NOT RE-QUEUED: ADJUST CAT 'PENDING'"
..W:BARTXADJ=22 !,"NOT RE-QUEUED: ADJUST CAT 'GENERAL INFORMATION'"
.I $$INDPAT^BARRQ2(BARTRIEN) W !,"INDIAN PAT OR NO INSURER TYPE" Q
.S TRLIST(BARTRIEN)=""
S TRLIST=0
F S TRLIST=$O(TRLIST(TRLIST)) Q:'TRLIST D
.S BARTRIEN=$P(TRLIST,U)
.D EN1
Q
;
PAYREV(BARTRIEN) ;EP - IS PYMT REV
Q $P($G(^BARTR(DUZ(2),BARTRIEN,1)),U)=40&($P($G(^BARTR(DUZ(2),BARTRIEN,0)),U,2)<0)
;
EN1 ; EP - Entry point when A/R Trans not entered by user (BARTRIEN needed)
S (BARBILL,BARBLIEN)=""
EN2 ; EP - FOR TPBLIST (ENTER WITH BARTRIEN, DON'T NEW BARBILL OR BARBLIEN)
;BARTRIEN REQUIRED
S (SDUZ,UDUZ,SESSID,SESSTX,SESSXMIT,SFILE,TRDUZ)=""
S (TRFILE,TRID,TRSESSID,TRXMIT)=""
S BARMSG1=""
I BARTRIEN="" D Q
.S BARMSG1="INVALID A/R TRANSACTION IS NULL"
.D MSG1^BARRQ1(BARMSG1,"F")
D NOW^%DTC
S BARRQDT=%
I '$D(^BARTR(DUZ(2),BARTRIEN)) D Q
.S BARMSG1="A/R TRANSACTION INVALID NOT IN ^BARTR"
.D MSG1^BARRQ1(BARMSG1,"F")
I '$D(^BARSESS(DUZ(2),"G",BARTRIEN)) D Q
.D MSG1^BARRQ1("TX NOT FOUND IN 'G' X-REF. RE-Q","W")
.D CLEARTX ;CLEAR NODE 6 IN BARTR AND RESEND?
;
S UDUZ=$O(^BARSESS(DUZ(2),"G",BARTRIEN,"")) ;CASHIER DUZ
I UDUZ="" D Q
.D MSG1^BARRQ1("ORIG SESS USER NOT FOUND. RE-Q","W")
.D CLEARTX ;CLEAR NODE 6 AND RESEND
;
S SESSID=$O(^BARSESS(DUZ(2),"G",BARTRIEN,UDUZ,"")) ;SESS ID
I SESSID="" D Q
.D MSG1^BARRQ1("ORIG SESS ID NOT FOUND. RE-Q","W")
.D CLEARTX ;CLEAR NODE 6 AND RESEND
;WAS IT TRANSMITTED?
S TRXMIT=$G(^BARTR(DUZ(2),BARTRIEN,6)) ;GET TRANSMIT DATA FROM NODE 6
S SESSTX=$G(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,BARTRIEN,0))
S SESSXMT=$P($G(^BARSESS(DUZ(2),UDUZ,11,SESSID,0)),U,2)
;SCENARIO 1
I $G(TRXMIT)="",$G(SESSTX)="" D Q ;(1).
.S BARMSG1="SCENARIO 1 - ORIG EXPORT DATA NOT FOUND IN SESS OR TX - RE-Q"
.D RESEND(UDUZ,SESSID,BARTRIEN)
.D MSG1^BARRQ1(BARMSG1,"W")
S TRSESSID=$P(TRXMIT,U,2) ;SESS ID FROM BARTR
S SESSXMIT=$P(SESSTX,U,4) ;DT/TM TRANSMITTED
;SCENARIO 2
I $G(TRSESSID)="",$G(SESSXMIT)="" D Q ;(2).
.S BARMSG1="SCENARIO 2 - NOT TRANSMITTED. NO TRANS FROM BARTR. NO SESSION TRANS - RE-Q"
.D RESEND(UDUZ,SESSID,BARTRIEN)
.D MSG1^BARRQ1(BARMSG1,"W")
;
;GET THE TX UFMS EXPORT DATA
S TRFILE=$P(TRXMIT,U) ;EXPORT FILE NAME
S TRDUZ=$P(TRXMIT,U,3) ;EXPORTED BY
S TRID=$P(TRXMIT,U,4) ;UNIQUE ID
;GET THE SESSION UFMS EXPORT DATA
S SDUZ=$P(SESSTX,U,3) ;TRANSMITTED BY
S SID=$P(SESSTX,U,5) ;APPLY TO/UNIQUEID
;SCENARIO 4
I TRSESSID'=""&(SESSXMIT'="") D Q
.S BARMSG1="TRANSMITTED PREVIOUSLY AND DATA IN BOTH SESSION AND BARTR - RE-Q"
.D MSG1^BARRQ1(BARMSG1,"W")
.D RESEND(UDUZ,SESSID,BARTRIEN)
S SFILE=""
;SCENARIO 5
S:SDUZ'="" SFILE=$P($G(^BARSESS(DUZ(2),UDUZ,11,SESSID,21,1,0)),U,2) ;UFMS FILENAME
I SESSXMIT'=""&(TRSESSID="") D Q ;(5)
.S BARMSG1="SCENARIO 5 - SESSXMIT'=NULL,TRSESSID=NULL - RE-Q"
.D CLRSESS
;SCENARIO 6
I SESSXMIT=""&(TRSESSID'="") D Q ;(6)
.S BARMSG1="SCENARIO 6 - TX HAS XMIT DATA, SESS DOES NOT - RE-Q"
.D CLEARTX
.D MSG1^BARRQ1(BARMSG1,"W")
Q
;
ASKFILE(TYPE) ;EP - CHOOSE UFMS FILE TO VIEW
FAGAIN ;EP - AGAIN
;TYPE IS "BILL" OR "TRANS" FOR TYPE OF DATA IN ^TMP
N DIREC,DESTIP,ARGS,BARUFMS,FILENM,FARRAY,DELIMIT
N Y,X,I,RECORDS,BARTRIEN
K DIR
S DIR(0)="FO"
S DIR("B")=","
S DIR("A")="ENTER DELIMITER FOR FILE"
D ^DIR
Q:$D(DTOUT)!$D(DIROUT)!$D(DIROUT)
I $D(DUOUT) S DELIM=U
E S DELIM=Y
S $P(DASH,"-",81)=""
S DIREC=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),15)),U) ;A/R PARM, UFMS DIR
I DIREC="" D
.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 A/R Site Parameter"
.W !,"field UFMS DIRECTORY using the 'SPE Site Parameter Edit' option"
.D ASKFORRT^BARUFUT
W !!,"CURRENT UFMS DIRECTORY IS ",$S(DIREC'="":DIREC,1:"UNDEFINED")
;CONFIRM THIS IS DIR WHERE RE-Q FILE IS
ASKDIR ;EP - ASK DIR
K DIR
S DIR(0)="FO"
S DIR("B")=$G(DIREC)
I DIREC="" S DIR("A")="ENTER DIRECTORY WHERE RE-Q FILE IS LOCATED"
E I DIREC'="" S DIR("A")="IS THIS THE DIRECTORY WHERE THE RE-Q FILE IS LOCATED"
D ^DIR
S DIREC=Y
G:$D(DTOUT)!$D(DIROUT)!$D(DUOUT) FAGAIN
;ASK FILENAME
K DIR
S DIR(0)="FO"
S DIR("?",1)="Enter a file name e.g. IHS_AR_RPMS_RCV_398_113510_20070806_0847.DAT,"
S DIR("?",2)="or a partial filename IHS_AR_RPMS_RCV_398*, the * is a wildcard,"
S DIR("?")="or * to list all UFMS files in the UFMS directory."
S DIR("A")="Enter filename "
D ^DIR
Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y="")
S FILENM=Y
I $E(FILENM)="*" S FILENM="*"
I FILENM="*" S FILENM="*"
K FARRAY
D LIST^%ZISH(DIREC,FILENM,.FARRAY)
I '$D(FARRAY) W " ??" H 1 G FAGAIN
W @IOF
W !!!,"FILES FOUND: "
S (KEY,LN,CHOICE)=""
S FIRST=1
F CNT=1:1 S LN=$O(FARRAY(LN)) Q:KEY!(LN="")!$G(CHOICE) D
.W !,LN_"."
.W ?5,FARRAY(LN)
.I '(CNT#10) D
..K DIR
..S DIR(0)="NO^1:"_CNT
..S DIR("A")="Enter item number: "
..D ^DIR
..S CHOICE=Y
..S KEY=$D(DUOUT)!($D(DTOUT))
Q:KEY
I '$G(CHOICE),LN="" D Q:KEY
.K DIR
.S DIR(0)="NO^1:"_(CNT-1)
.S DIR("A")="Enter item number: "
.D ^DIR
.S CHOICE=Y
.S KEY=$D(DUOUT)!($D(DTOUT))!(Y="")
;
S ITEM=CHOICE
S BARDIR=DIREC
S BARFN=FARRAY(CHOICE)
S Y=$$OPEN^%ZISH(BARDIR,BARFN,"R")
I Y W !,"CAN'T OPEN FILE" H 3 G FAGAIN
F I=1:1 U IO R X:1 Q:$$STATUS^%ZISH=-1 D ;DIRECT READ OF FLAT FILE
.S ^TMP($J,BARRNAM,$J,TYPE,I,0)=$P(X,DELIM) ;ASSUME BILL OR TX IS 1ST PIECE
D ^%ZISC
Q
;
TXFILE ;LOOP TO RE-Q FILE OF TXs
K ^TMP($J,BARRNAM,$J)
;DELIMITER, TYPE OF FILE
D ASKFILE("TRANS")
S BARTXCNT=0
F S BARTXCNT=$O(^TMP($J,BARRNAM,$J,"TRANS",BARTXCNT)) Q:BARTXCNT="" D
.S BARTRIEN=$G(^TMP($J,BARRNAM,$J,"TRANS",BARTXCNT,0))
.I BARTRIEN="" D Q
..W !,"TRANSATION NULL - POSSIBLY INCORRECT FILE FORMAT!"
.I $$INDPAT^BARRQ2(BARTRIEN) W !,"INDIAN PAT OR NO INSURER TYPE" Q
.I $$PAYREV(BARTRIEN) D Q
..W !,"NOT RE-QUEUED: TRANSACTION IS PAY REV"
.I $D(^BARSESS(DUZ(2),"NS",BARTRIEN)) D Q
..W !!,"TRANSACTION IN THE 'NOT SEND' STATUS"
..W !,"TX NOT ALLOWED!"
.S BARTR1=$G(^BARTR(DUZ(2),BARTRIEN,1))
.S BARTXTYP=$P(BARTR1,U),BARTXADJ=$P(BARTR1,U,2)
.I BARTXTYP=49!(BARTXTYP=115)!(BARTXTYP=117) D Q
..W:BARTXTYP=49 !,"NOT RE-QUEUED: BILL NEW TYPE"
..W:BARTXTYP=115 !,"NOT RE-QUEUED: COL BAT TO ACC POST"
..W:BARTXTYP=117 !,"NOT RE-QUEUED: COL BAT TO FACILITY"
.I BARTXADJ=21!(BARTXADJ=22) D Q
..W:BARTXADJ=21 !,"NOT RE-QUEUED: ADJUST CAT 'PENDING'"
..W:BARTXADJ=22 !,"NOT RE-QUEUED: ADJUST CAT 'GENERAL INFORMATION'"
.D EN1
K ^TMP($J,BARRNAM,$J)
Q
;
TPBFILE ;EP - PROCESS FILE OF TPB BILLS
K ^TMP($J,BARRNAM,"BILL")
D ASKFILE("BILL")
S BAR3PB=1
S BARCNT3P=0
S BARTMP3P=""
F S BARTMP3P=$O(^TMP($J,BARRNAM,$J,"BILL",BARTMP3P)) Q:BARTMP3P="" D
.S ARBILL=$G(^TMP($J,BARRNAM,$J,"BILL",BARTMP3P,0))
.I ARBILL="" D Q
..W !,"BILL NULL - POSSIBLY INCORRECT FILE FORMAT!"
.I '$D(^BARBL(DUZ(2),"B",ARBILL)) D Q
..W !!,"BILL NOT FOUND IN A/R BILL FILE:"
..W !,"BILL "_ARBILL_" WILL NOT BE PROCESSED!"
.S BARBLIEN=$O(^BARBL(DUZ(2),"B",ARBILL,"")) ;A/R BILL IEN
.I 'BARBLIEN W !,"BILL IEN NOT FOUND FOR A/R BILL: "_ARBILL Q
.S BARCNT3P=$G(BARCNT3P)+1
.S BARCNT3X=0 ;COUNT A/R TX
.S BARTRIEN=0
.F S BARTRIEN=$O(^BARTR(DUZ(2),"AC",BARBLIEN,BARTRIEN)) Q:'BARTRIEN D
..I $$INDPAT^BARRQ2(BARTRIEN) W !,"INDIAN PAT OR NO INSURER TYPE" Q
..I $$PAYREV(BARTRIEN) D Q
...W !,"NOT RE-QUEUED: TRANSACTION IS PAY REV"
..I $D(^BARSESS(DUZ(2),"NS",BARTRIEN)) D Q
...W !!,"TRANSACTION IN THE 'NOT SEND' STATUS"
...W !,"TX NOT ALLOWED!"
..S BARTR1=$G(^BARTR(DUZ(2),BARTRIEN,1))
..S BARTXTYP=$P(BARTR1,U),BARTXADJ=$P(BARTR1,U,2)
..I BARTXTYP=49!(BARTXTYP=115)!(BARTXTYP=117) D Q
...W:BARTXTYP=49 !,"NOT RE-QUEUED: BILL NEW TYPE"
...W:BARTXTYP=115 !,"NOT RE-QUEUED: COL BAT TO ACC POST"
...W:BARTXTYP=117 !,"NOT RE-QUEUED: COL BAT TO FACILITY"
..I BARTXADJ=21!(BARTXADJ=22) D Q
...W:BARTXADJ=21 !,"NOT RE-QUEUED: ADJUST CAT 'PENDING'"
...W:BARTXADJ=22 !,"NOT RE-QUEUED: ADJUST CAT 'GENERAL INFORMATION'"
..S BARCNT3X=BARCNT3X+1
..S BARCNT=BARCNT3X
..D EN2
..S PROCMSG="TRANSACTION HAS BEEN RE-QUEUED"
W !,DASHLINE
W !!,"TOTAL 3P BILL'S PROCESSED:",?37,BARCNT3P ;loop cntr includes "" read in cnt
W !,"TOTAL A/R TX'S ADDED TO SESSION ",NEWSESS," FOR (",NEWDUZ,") ",NEWUSRNM,": ",BARCNTS
W !,"RE-QUEUE STATUS: ",$G(PROCMSG)
Q
;
BLLIST ;EP - ALLOW ENTRY OF 1+ BILLS ON THE FLY
;PROMPT FOR TPB BILL TO BE RE-QUEUED
N BLLIST
AGAIN ;EP - ASK ANOTHER
W !!,"THE PROMPT WILL BE PRESENTED OVER AND OVER"
W !,"SO YOU CAN ENTER MORE THAN ONE TPB BILL."
W !,"WHEN YOU ARE DONE ENTERING TPB BILLS PRESS RETURN."
W !
K DIR,DIC,DIE,DA,DR
S DIC="^BARBL(DUZ(2),"
S DIC(0)="AEQM"
D ^DIC
Q:Y<0&('$D(BLLIST))
I Y>0 S BLLIST($P(Y,U,2))="" G AGAIN
S TPBILL=0
F S TPBILL=$O(BLLIST(TPBILL)) Q:'TPBILL D
.S BARBLIEN=$O(^BARBL(DUZ(2),"B",TPBILL,""))
.S BARCNT3P=$G(BARCNT3P)+1
.S BARCNTX=0 ;CNT FOR A/R TXs
.I '$O(^BARTR(DUZ(2),"AC",BARBLIEN,"")) D Q
..W !,"NO TRANSACTIONS FOR "_TPBILL_" NO RE-Q"
.S BARTRIEN=0
.F S BARTRIEN=$O(^BARTR(DUZ(2),"AC",BARBLIEN,BARTRIEN)) Q:'BARTRIEN D
..I $$PAYREV(BARTRIEN) D Q
...W !,"NOT RE-QUEUED: TRANSACTION IS PAY REV"
..I $$INDPAT^BARRQ2(BARTRIEN) W !,"INDIAN PAT OR NO INSURER TYPE" Q
..I $D(^BARSESS(DUZ(2),"NS",BARTRIEN)) D Q
...W !!,"TRANSACTION IN THE 'NOT SEND' STATUS"
...W !,"TX NOT ALLOWED!"
..S BARTR1=$G(^BARTR(DUZ(2),BARTRIEN,1))
..S BARTXTYP=$P(BARTR1,U),BARTXADJ=$P(BARTR1,U,2)
..I BARTXTYP=49!(BARTXTYP=115)!(BARTXTYP=117) D Q
...W:BARTXTYP=49 !,"NOT RE-QUEUED: BILL NEW TYPE"
...W:BARTXTYP=115 !,"NOT RE-QUEUED: COL BAT TO ACC POST"
...W:BARTXTYP=117 !,"NOT RE-QUEUED: COL BAT TO FACILITY"
..I BARTXADJ=21!(BARTXADJ=22) D Q
...W:BARTXADJ=21 !,"NOT RE-QUEUED: ADJUST CAT 'PENDING'"
...W:BARTXADJ=22 !,"NOT RE-QUEUED: ADJUST CAT 'GENERAL INFORMATION'"
..S BARCNTX=BARCNT3X+1
..S BARCNT=BARCNT3X
..D EN2
..W !,BARTRIEN," TRANSACTION HAS BEEN RE-QUEUED FOR BILL ",BARBILL
Q
;
RESEND(UDUZ,SESSID,BARTRIEN) ;EP - ADD TO NEW CASHIER SESS
D RESEND^BARRQ2(UDUZ,SESSID,BARTRIEN) ;P.OTT
;
CLRSESS ;CLEAR THE SESS TRANSMISSION DATA
D CLRSESS^BARRQ2
;
;IHS/SD/PKD DON'T KILL EXPORT HISTORY 4/15/11
CLEARTX ;EP - CLEAR THE A/R TRANS TRANSMISSION DATA
D CLEARTX^BARRQ2
D SESSLOG^BARRQ2
Q
BARRQ ; IHS/SD/TPF - Re-queue A/R Transactions for UFMS export ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23**;OCT 26,2005;Build 38
+2 ; IHS/SD/TMM - 10/01/09 - V1.8*14 - Re-transmit indiv. A/R Trans; Re-transmit individual A/R Trans
+3 ; IHS/SD/TPF 7/14/2011 COPIED FROM BZHIXMP. CLEANED UP FOR READABILITY
+4 ;OCT 24 2012 HEAT# 80306 P.OTT (PARAMETER PASSING ADDED TO RESEND)
+5 QUIT
REQUEUE ;Re-queue based on TPB, A/R lists
+1 DO MSG^BARRQ2
+2 NEW FLAG,REJECT,ESC,BARRQDT,NEWDUZ,NEWSESS,NEWUSRNM,BARRNAM,ERASTA,LIST,CHOICE
+3 NEW BARSEL,BARCNT,BARCNTS,BARCNTE,REJEC,FN,CB,SS
+4 SET FLAG=0
+5 DO HOME^%ZIS
+6 WRITE @IOF
+7 DO ^BARBAN
+8 DO NOW^%DTC
+9 SET BARRQDT=%
+10 DO INIT
+11 ;CREATE NEW OPEN SESS
DO OPENSESS^BARRQ1(.REJECT,.ESC)
+12 IF ESC=U!(ESC="")
QUIT
+13 IF $GET(REJECT)
GOTO REQUEUE
+14 IF NEWDUZ=""
IF (NEWSESS="")
IF (NEWUSRNM="")
QUIT
+15 IF NEWDUZ=""
WRITE !!!,"***** NEW OPEN SESSION NOT CREATED *****"
GOTO REQUEUE
+16 KILL ^TMP($JOB,BARRNAM,$JOB)
+17 ;SELECT HOW TO PROCESS TX
DO REQTYP
+18 SET ERATSTA=0
+19 ;LIST(1)="398^3110905.150246^"
+20 SET LIST(1)=NEWDUZ_U_NEWSESS_U
+21 SET CHOICE=1
+22 DO DISPLAYT^BARUFLOG(NEWDUZ,NEWSESS,"VIEW",ERATSTA)
+23 GOTO REQUEUE
+24 QUIT
INIT ;
+1 KILL BAR3PB
+2 SET (BARSAVE,NEWDUZ,NEWSESS,NEWUSRNM,FN,CB,SS)=""
+3 SET (BARCNT,BARCNTS,BARCNTE,REJECT,ESC)=0
+4 SET BARRNAM=$PIECE($TEXT(+1)," ")
+5 SET $PIECE(DASHLINE,"-",81)=""
+6 QUIT
REQTYP ;CHOOSE METHOD
+1 WRITE !!
+2 WRITE !,?6,"RE-QUEUE A/R TRANSACTIONS FOR UFMS EXPORT"
+3 KILL DIR
+4 ;INIT DIR HELP
DO SETRQTYP^BARRQ1(.DIR)
+5 SET DIR(0)="SO^I:INDIVIDUAL A/R TRANSACTION IEN;"
+6 SET DIR(0)=DIR(0)_"F:FILE OF A/R TRANSACTION IENs;"
+7 SET DIR(0)=DIR(0)_"B:INDIVIDUAL 3P BILL NUMBER;"
+8 SET DIR(0)=DIR(0)_"FB:FILE OF TPB BILLS;"
+9 SET DIR(0)=DIR(0)_"FN:SEARCH FOR FILENAME IN A/R TRANSACTION FILE "_$GET(FN)_";"
+10 SET DIR(0)=DIR(0)_"CB:SEARCH BY COL BATCH "_$GET(CB)_";"
+11 SET DIR(0)=DIR(0)_"SS:SEARCH FOR A TX IN A SESSION "_$GET(SS)_";"
+12 SET DIR(0)=DIR(0)_"RQ:RE-Q COMPILED SEARCH DATA;"
+13 SET DIR("A")="HOW WILL THESE TRANSACTIONS BE RE-QUEUED FOR EXPORT?"
+14 DO ^DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)!(Y="")
QUIT
+16 SET BARSEL=Y
+17 IF BARSEL="FN"!(BARSEL="CB")!(BARSEL="SS")!(BARSEL="RQ")
IF (FLAG)
Begin DoDot:1
+18 WRITE !,"YOU HAVE TRANSACTIONS QUEUED USING THE I,F,B OR FB OPTIONS."
+19 WRITE !,"PRESS RETURN AND TRANSMIT THESE TXs BEFORE USING THIS OPTION!"
End DoDot:1
GOTO REQTYP
+20 ;INDIVIDUAL OR LIST OF A/R TX
IF BARSEL="I"
DO EN
GOTO REQTYP
+21 ;FILE OF TXS
IF BARSEL="F"
DO TXFILE
GOTO REQTYP
+22 ;INDIVIDUAL OR LIST OF 3P EXTERNAL BILL
IF BARSEL="B"
DO BLLIST
GOTO REQTYP
+23 ;FILE OF EXTERNAL 3P BILLS
IF BARSEL="FB"
DO TPBFILE
GOTO REQTYP
+24 ;SEARCH FOR TX USING FILENAME
IF BARSEL="FN"
DO FNSEARCH^BARRQ1(.FN)
GOTO REQTYP
+25 ;"" USING COL BATCH
IF BARSEL="CB"
DO CBSEARCH^BARRQ1(.CB)
GOTO REQTYP
+26 ;"" USING SESSION
IF BARSEL="SS"
DO SSEARCH^BARRQ1(.SS)
GOTO REQTYP
+27 ;PROCESS SEARCH DATA IN ^TMP($J,BARRNAM,$J,TX)
IF BARSEL="RQ"
DO PROCESS^BARRQ1
KILL ^TMP($JOB,BARRNAM,$JOB),FN,CB,SS
+28 GOTO REQTYP
+29 QUIT
+30 ;
EN ;EP - RE-QUE TRANS
+1 ;PROMPT FOR A/R TRANS TO BE RE-QUEUED
+2 NEW TRLIST
ASKAGAIN ;EP
+1 WRITE !!,"THE PROMPT WILL BE PRESENTED OVER AND OVER"
+2 WRITE !,"SO YOU CAN ENTER MORE THAN ONE A/R TRANSACTION."
+3 WRITE !,"WHEN YOU ARE DONE ENTERING TRANSACTIONS PRESS RETURN."
+4 WRITE !
+5 KILL DIR,DIC,DIE,DA,DR
+6 SET DIC="^BARTR(DUZ(2),"
+7 SET DIC(0)="AEQM"
+8 SET DIC("S")="I $P($G(^(1)),U)'=49,($P($G(^(1)),U)'=115),($P($G(^(1)),U)'=117)"
+9 DO ^DIC
+10 IF Y<0&('$DATA(TRLIST))
QUIT
+11 IF Y>0
Begin DoDot:1
+12 IF $DATA(^BARSESS(DUZ(2),"NS",+Y))
Begin DoDot:2
+13 WRITE !!,"TRANSACTION IN THE 'NOT SEND' STATUS"
+14 WRITE !,"TX NOT ALLOWED!"
End DoDot:2
QUIT
+15 SET BARTRIEN=+Y
+16 IF $$PAYREV(BARTRIEN)
Begin DoDot:2
+17 WRITE !,"NOT RE-QUEUED: TRANSACTION IS PAY REV"
End DoDot:2
QUIT
+18 SET BARTR1=$GET(^BARTR(DUZ(2),BARTRIEN,1))
+19 SET BARTXTYP=$PIECE(BARTR1,U)
SET BARTXADJ=$PIECE(BARTR1,U,2)
+20 IF BARTXTYP=49!(BARTXTYP=115)!(BARTXTYP=117)
Begin DoDot:2
+21 IF BARTXTYP=49
WRITE !,"NOT RE-QUEUED: BILL NEW TYPE"
+22 IF BARTXTYP=115
WRITE !,"NOT RE-QUEUED: COL BAT TO ACC POST"
+23 IF BARTXTYP=117
WRITE !,"NOT RE-QUEUED: COL BAT TO FACILITY"
End DoDot:2
QUIT
+24 IF BARTXADJ=21!(BARTXADJ=22)
Begin DoDot:2
+25 IF BARTXADJ=21
WRITE !,"NOT RE-QUEUED: ADJUST CAT 'PENDING'"
+26 IF BARTXADJ=22
WRITE !,"NOT RE-QUEUED: ADJUST CAT 'GENERAL INFORMATION'"
End DoDot:2
QUIT
+27 IF $$INDPAT^BARRQ2(BARTRIEN)
WRITE !,"INDIAN PAT OR NO INSURER TYPE"
QUIT
+28 SET TRLIST(BARTRIEN)=""
End DoDot:1
GOTO ASKAGAIN
+29 SET TRLIST=0
+30 FOR
SET TRLIST=$ORDER(TRLIST(TRLIST))
IF 'TRLIST
QUIT
Begin DoDot:1
+31 SET BARTRIEN=$PIECE(TRLIST,U)
+32 DO EN1
End DoDot:1
+33 QUIT
+34 ;
PAYREV(BARTRIEN) ;EP - IS PYMT REV
+1 QUIT $PIECE($GET(^BARTR(DUZ(2),BARTRIEN,1)),U)=40&($PIECE($GET(^BARTR(DUZ(2),BARTRIEN,0)),U,2)<0)
+2 ;
EN1 ; EP - Entry point when A/R Trans not entered by user (BARTRIEN needed)
+1 SET (BARBILL,BARBLIEN)=""
EN2 ; EP - FOR TPBLIST (ENTER WITH BARTRIEN, DON'T NEW BARBILL OR BARBLIEN)
+1 ;BARTRIEN REQUIRED
+2 SET (SDUZ,UDUZ,SESSID,SESSTX,SESSXMIT,SFILE,TRDUZ)=""
+3 SET (TRFILE,TRID,TRSESSID,TRXMIT)=""
+4 SET BARMSG1=""
+5 IF BARTRIEN=""
Begin DoDot:1
+6 SET BARMSG1="INVALID A/R TRANSACTION IS NULL"
+7 DO MSG1^BARRQ1(BARMSG1,"F")
End DoDot:1
QUIT
+8 DO NOW^%DTC
+9 SET BARRQDT=%
+10 IF '$DATA(^BARTR(DUZ(2),BARTRIEN))
Begin DoDot:1
+11 SET BARMSG1="A/R TRANSACTION INVALID NOT IN ^BARTR"
+12 DO MSG1^BARRQ1(BARMSG1,"F")
End DoDot:1
QUIT
+13 IF '$DATA(^BARSESS(DUZ(2),"G",BARTRIEN))
Begin DoDot:1
+14 DO MSG1^BARRQ1("TX NOT FOUND IN 'G' X-REF. RE-Q","W")
+15 ;CLEAR NODE 6 IN BARTR AND RESEND?
DO CLEARTX
End DoDot:1
QUIT
+16 ;
+17 ;CASHIER DUZ
SET UDUZ=$ORDER(^BARSESS(DUZ(2),"G",BARTRIEN,""))
+18 IF UDUZ=""
Begin DoDot:1
+19 DO MSG1^BARRQ1("ORIG SESS USER NOT FOUND. RE-Q","W")
+20 ;CLEAR NODE 6 AND RESEND
DO CLEARTX
End DoDot:1
QUIT
+21 ;
+22 ;SESS ID
SET SESSID=$ORDER(^BARSESS(DUZ(2),"G",BARTRIEN,UDUZ,""))
+23 IF SESSID=""
Begin DoDot:1
+24 DO MSG1^BARRQ1("ORIG SESS ID NOT FOUND. RE-Q","W")
+25 ;CLEAR NODE 6 AND RESEND
DO CLEARTX
End DoDot:1
QUIT
+26 ;WAS IT TRANSMITTED?
+27 ;GET TRANSMIT DATA FROM NODE 6
SET TRXMIT=$GET(^BARTR(DUZ(2),BARTRIEN,6))
+28 SET SESSTX=$GET(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,BARTRIEN,0))
+29 SET SESSXMT=$PIECE($GET(^BARSESS(DUZ(2),UDUZ,11,SESSID,0)),U,2)
+30 ;SCENARIO 1
+31 ;(1).
IF $GET(TRXMIT)=""
IF $GET(SESSTX)=""
Begin DoDot:1
+32 SET BARMSG1="SCENARIO 1 - ORIG EXPORT DATA NOT FOUND IN SESS OR TX - RE-Q"
+33 DO RESEND(UDUZ,SESSID,BARTRIEN)
+34 DO MSG1^BARRQ1(BARMSG1,"W")
End DoDot:1
QUIT
+35 ;SESS ID FROM BARTR
SET TRSESSID=$PIECE(TRXMIT,U,2)
+36 ;DT/TM TRANSMITTED
SET SESSXMIT=$PIECE(SESSTX,U,4)
+37 ;SCENARIO 2
+38 ;(2).
IF $GET(TRSESSID)=""
IF $GET(SESSXMIT)=""
Begin DoDot:1
+39 SET BARMSG1="SCENARIO 2 - NOT TRANSMITTED. NO TRANS FROM BARTR. NO SESSION TRANS - RE-Q"
+40 DO RESEND(UDUZ,SESSID,BARTRIEN)
+41 DO MSG1^BARRQ1(BARMSG1,"W")
End DoDot:1
QUIT
+42 ;
+43 ;GET THE TX UFMS EXPORT DATA
+44 ;EXPORT FILE NAME
SET TRFILE=$PIECE(TRXMIT,U)
+45 ;EXPORTED BY
SET TRDUZ=$PIECE(TRXMIT,U,3)
+46 ;UNIQUE ID
SET TRID=$PIECE(TRXMIT,U,4)
+47 ;GET THE SESSION UFMS EXPORT DATA
+48 ;TRANSMITTED BY
SET SDUZ=$PIECE(SESSTX,U,3)
+49 ;APPLY TO/UNIQUEID
SET SID=$PIECE(SESSTX,U,5)
+50 ;SCENARIO 4
+51 IF TRSESSID'=""&(SESSXMIT'="")
Begin DoDot:1
+52 SET BARMSG1="TRANSMITTED PREVIOUSLY AND DATA IN BOTH SESSION AND BARTR - RE-Q"
+53 DO MSG1^BARRQ1(BARMSG1,"W")
+54 DO RESEND(UDUZ,SESSID,BARTRIEN)
End DoDot:1
QUIT
+55 SET SFILE=""
+56 ;SCENARIO 5
+57 ;UFMS FILENAME
IF SDUZ'=""
SET SFILE=$PIECE($GET(^BARSESS(DUZ(2),UDUZ,11,SESSID,21,1,0)),U,2)
+58 ;(5)
IF SESSXMIT'=""&(TRSESSID="")
Begin DoDot:1
+59 SET BARMSG1="SCENARIO 5 - SESSXMIT'=NULL,TRSESSID=NULL - RE-Q"
+60 DO CLRSESS
End DoDot:1
QUIT
+61 ;SCENARIO 6
+62 ;(6)
IF SESSXMIT=""&(TRSESSID'="")
Begin DoDot:1
+63 SET BARMSG1="SCENARIO 6 - TX HAS XMIT DATA, SESS DOES NOT - RE-Q"
+64 DO CLEARTX
+65 DO MSG1^BARRQ1(BARMSG1,"W")
End DoDot:1
QUIT
+66 QUIT
+67 ;
ASKFILE(TYPE) ;EP - CHOOSE UFMS FILE TO VIEW
FAGAIN ;EP - AGAIN
+1 ;TYPE IS "BILL" OR "TRANS" FOR TYPE OF DATA IN ^TMP
+2 NEW DIREC,DESTIP,ARGS,BARUFMS,FILENM,FARRAY,DELIMIT
+3 NEW Y,X,I,RECORDS,BARTRIEN
+4 KILL DIR
+5 SET DIR(0)="FO"
+6 SET DIR("B")=","
+7 SET DIR("A")="ENTER DELIMITER FOR FILE"
+8 DO ^DIR
+9 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIROUT)
QUIT
+10 IF $DATA(DUOUT)
SET DELIM=U
+11 IF '$TEST
SET DELIM=Y
+12 SET $PIECE(DASH,"-",81)=""
+13 ;A/R PARM, UFMS DIR
SET DIREC=$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),15)),U)
+14 IF DIREC=""
Begin DoDot:1
+15 WRITE !!,"Before UFMS files can be created a non-public directory must be created"
+16 WRITE !,"on the Host File System. This directory must be entered in to A/R Site Parameter"
+17 WRITE !,"field UFMS DIRECTORY using the 'SPE Site Parameter Edit' option"
+18 DO ASKFORRT^BARUFUT
End DoDot:1
+19 WRITE !!,"CURRENT UFMS DIRECTORY IS ",$SELECT(DIREC'="":DIREC,1:"UNDEFINED")
+20 ;CONFIRM THIS IS DIR WHERE RE-Q FILE IS
ASKDIR ;EP - ASK DIR
+1 KILL DIR
+2 SET DIR(0)="FO"
+3 SET DIR("B")=$GET(DIREC)
+4 IF DIREC=""
SET DIR("A")="ENTER DIRECTORY WHERE RE-Q FILE IS LOCATED"
+5 IF '$TEST
IF DIREC'=""
SET DIR("A")="IS THIS THE DIRECTORY WHERE THE RE-Q FILE IS LOCATED"
+6 DO ^DIR
+7 SET DIREC=Y
+8 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)
GOTO FAGAIN
+9 ;ASK FILENAME
+10 KILL DIR
+11 SET DIR(0)="FO"
+12 SET DIR("?",1)="Enter a file name e.g. IHS_AR_RPMS_RCV_398_113510_20070806_0847.DAT,"
+13 SET DIR("?",2)="or a partial filename IHS_AR_RPMS_RCV_398*, the * is a wildcard,"
+14 SET DIR("?")="or * to list all UFMS files in the UFMS directory."
+15 SET DIR("A")="Enter filename "
+16 DO ^DIR
+17 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")
QUIT
+18 SET FILENM=Y
+19 IF $EXTRACT(FILENM)="*"
SET FILENM="*"
+20 IF FILENM="*"
SET FILENM="*"
+21 KILL FARRAY
+22 DO LIST^%ZISH(DIREC,FILENM,.FARRAY)
+23 IF '$DATA(FARRAY)
WRITE " ??"
HANG 1
GOTO FAGAIN
+24 WRITE @IOF
+25 WRITE !!!,"FILES FOUND: "
+26 SET (KEY,LN,CHOICE)=""
+27 SET FIRST=1
+28 FOR CNT=1:1
SET LN=$ORDER(FARRAY(LN))
IF KEY!(LN="")!$GET(CHOICE)
QUIT
Begin DoDot:1
+29 WRITE !,LN_"."
+30 WRITE ?5,FARRAY(LN)
+31 IF '(CNT#10)
Begin DoDot:2
+32 KILL DIR
+33 SET DIR(0)="NO^1:"_CNT
+34 SET DIR("A")="Enter item number: "
+35 DO ^DIR
+36 SET CHOICE=Y
+37 SET KEY=$DATA(DUOUT)!($DATA(DTOUT))
End DoDot:2
End DoDot:1
+38 IF KEY
QUIT
+39 IF '$GET(CHOICE)
IF LN=""
Begin DoDot:1
+40 KILL DIR
+41 SET DIR(0)="NO^1:"_(CNT-1)
+42 SET DIR("A")="Enter item number: "
+43 DO ^DIR
+44 SET CHOICE=Y
+45 SET KEY=$DATA(DUOUT)!($DATA(DTOUT))!(Y="")
End DoDot:1
IF KEY
QUIT
+46 ;
+47 SET ITEM=CHOICE
+48 SET BARDIR=DIREC
+49 SET BARFN=FARRAY(CHOICE)
+50 SET Y=$$OPEN^%ZISH(BARDIR,BARFN,"R")
+51 IF Y
WRITE !,"CAN'T OPEN FILE"
HANG 3
GOTO FAGAIN
+52 ;DIRECT READ OF FLAT FILE
FOR I=1:1
USE IO
READ X:1
IF $$STATUS^%ZISH=-1
QUIT
Begin DoDot:1
+53 ;ASSUME BILL OR TX IS 1ST PIECE
SET ^TMP($JOB,BARRNAM,$JOB,TYPE,I,0)=$PIECE(X,DELIM)
End DoDot:1
+54 DO ^%ZISC
+55 QUIT
+56 ;
TXFILE ;LOOP TO RE-Q FILE OF TXs
+1 KILL ^TMP($JOB,BARRNAM,$JOB)
+2 ;DELIMITER, TYPE OF FILE
+3 DO ASKFILE("TRANS")
+4 SET BARTXCNT=0
+5 FOR
SET BARTXCNT=$ORDER(^TMP($JOB,BARRNAM,$JOB,"TRANS",BARTXCNT))
IF BARTXCNT=""
QUIT
Begin DoDot:1
+6 SET BARTRIEN=$GET(^TMP($JOB,BARRNAM,$JOB,"TRANS",BARTXCNT,0))
+7 IF BARTRIEN=""
Begin DoDot:2
+8 WRITE !,"TRANSATION NULL - POSSIBLY INCORRECT FILE FORMAT!"
End DoDot:2
QUIT
+9 IF $$INDPAT^BARRQ2(BARTRIEN)
WRITE !,"INDIAN PAT OR NO INSURER TYPE"
QUIT
+10 IF $$PAYREV(BARTRIEN)
Begin DoDot:2
+11 WRITE !,"NOT RE-QUEUED: TRANSACTION IS PAY REV"
End DoDot:2
QUIT
+12 IF $DATA(^BARSESS(DUZ(2),"NS",BARTRIEN))
Begin DoDot:2
+13 WRITE !!,"TRANSACTION IN THE 'NOT SEND' STATUS"
+14 WRITE !,"TX NOT ALLOWED!"
End DoDot:2
QUIT
+15 SET BARTR1=$GET(^BARTR(DUZ(2),BARTRIEN,1))
+16 SET BARTXTYP=$PIECE(BARTR1,U)
SET BARTXADJ=$PIECE(BARTR1,U,2)
+17 IF BARTXTYP=49!(BARTXTYP=115)!(BARTXTYP=117)
Begin DoDot:2
+18 IF BARTXTYP=49
WRITE !,"NOT RE-QUEUED: BILL NEW TYPE"
+19 IF BARTXTYP=115
WRITE !,"NOT RE-QUEUED: COL BAT TO ACC POST"
+20 IF BARTXTYP=117
WRITE !,"NOT RE-QUEUED: COL BAT TO FACILITY"
End DoDot:2
QUIT
+21 IF BARTXADJ=21!(BARTXADJ=22)
Begin DoDot:2
+22 IF BARTXADJ=21
WRITE !,"NOT RE-QUEUED: ADJUST CAT 'PENDING'"
+23 IF BARTXADJ=22
WRITE !,"NOT RE-QUEUED: ADJUST CAT 'GENERAL INFORMATION'"
End DoDot:2
QUIT
+24 DO EN1
End DoDot:1
+25 KILL ^TMP($JOB,BARRNAM,$JOB)
+26 QUIT
+27 ;
TPBFILE ;EP - PROCESS FILE OF TPB BILLS
+1 KILL ^TMP($JOB,BARRNAM,"BILL")
+2 DO ASKFILE("BILL")
+3 SET BAR3PB=1
+4 SET BARCNT3P=0
+5 SET BARTMP3P=""
+6 FOR
SET BARTMP3P=$ORDER(^TMP($JOB,BARRNAM,$JOB,"BILL",BARTMP3P))
IF BARTMP3P=""
QUIT
Begin DoDot:1
+7 SET ARBILL=$GET(^TMP($JOB,BARRNAM,$JOB,"BILL",BARTMP3P,0))
+8 IF ARBILL=""
Begin DoDot:2
+9 WRITE !,"BILL NULL - POSSIBLY INCORRECT FILE FORMAT!"
End DoDot:2
QUIT
+10 IF '$DATA(^BARBL(DUZ(2),"B",ARBILL))
Begin DoDot:2
+11 WRITE !!,"BILL NOT FOUND IN A/R BILL FILE:"
+12 WRITE !,"BILL "_ARBILL_" WILL NOT BE PROCESSED!"
End DoDot:2
QUIT
+13 ;A/R BILL IEN
SET BARBLIEN=$ORDER(^BARBL(DUZ(2),"B",ARBILL,""))
+14 IF 'BARBLIEN
WRITE !,"BILL IEN NOT FOUND FOR A/R BILL: "_ARBILL
QUIT
+15 SET BARCNT3P=$GET(BARCNT3P)+1
+16 ;COUNT A/R TX
SET BARCNT3X=0
+17 SET BARTRIEN=0
+18 FOR
SET BARTRIEN=$ORDER(^BARTR(DUZ(2),"AC",BARBLIEN,BARTRIEN))
IF 'BARTRIEN
QUIT
Begin DoDot:2
+19 IF $$INDPAT^BARRQ2(BARTRIEN)
WRITE !,"INDIAN PAT OR NO INSURER TYPE"
QUIT
+20 IF $$PAYREV(BARTRIEN)
Begin DoDot:3
+21 WRITE !,"NOT RE-QUEUED: TRANSACTION IS PAY REV"
End DoDot:3
QUIT
+22 IF $DATA(^BARSESS(DUZ(2),"NS",BARTRIEN))
Begin DoDot:3
+23 WRITE !!,"TRANSACTION IN THE 'NOT SEND' STATUS"
+24 WRITE !,"TX NOT ALLOWED!"
End DoDot:3
QUIT
+25 SET BARTR1=$GET(^BARTR(DUZ(2),BARTRIEN,1))
+26 SET BARTXTYP=$PIECE(BARTR1,U)
SET BARTXADJ=$PIECE(BARTR1,U,2)
+27 IF BARTXTYP=49!(BARTXTYP=115)!(BARTXTYP=117)
Begin DoDot:3
+28 IF BARTXTYP=49
WRITE !,"NOT RE-QUEUED: BILL NEW TYPE"
+29 IF BARTXTYP=115
WRITE !,"NOT RE-QUEUED: COL BAT TO ACC POST"
+30 IF BARTXTYP=117
WRITE !,"NOT RE-QUEUED: COL BAT TO FACILITY"
End DoDot:3
QUIT
+31 IF BARTXADJ=21!(BARTXADJ=22)
Begin DoDot:3
+32 IF BARTXADJ=21
WRITE !,"NOT RE-QUEUED: ADJUST CAT 'PENDING'"
+33 IF BARTXADJ=22
WRITE !,"NOT RE-QUEUED: ADJUST CAT 'GENERAL INFORMATION'"
End DoDot:3
QUIT
+34 SET BARCNT3X=BARCNT3X+1
+35 SET BARCNT=BARCNT3X
+36 DO EN2
+37 SET PROCMSG="TRANSACTION HAS BEEN RE-QUEUED"
End DoDot:2
End DoDot:1
+38 WRITE !,DASHLINE
+39 ;loop cntr includes "" read in cnt
WRITE !!,"TOTAL 3P BILL'S PROCESSED:",?37,BARCNT3P
+40 WRITE !,"TOTAL A/R TX'S ADDED TO SESSION ",NEWSESS," FOR (",NEWDUZ,") ",NEWUSRNM,": ",BARCNTS
+41 WRITE !,"RE-QUEUE STATUS: ",$GET(PROCMSG)
+42 QUIT
+43 ;
BLLIST ;EP - ALLOW ENTRY OF 1+ BILLS ON THE FLY
+1 ;PROMPT FOR TPB BILL TO BE RE-QUEUED
+2 NEW BLLIST
AGAIN ;EP - ASK ANOTHER
+1 WRITE !!,"THE PROMPT WILL BE PRESENTED OVER AND OVER"
+2 WRITE !,"SO YOU CAN ENTER MORE THAN ONE TPB BILL."
+3 WRITE !,"WHEN YOU ARE DONE ENTERING TPB BILLS PRESS RETURN."
+4 WRITE !
+5 KILL DIR,DIC,DIE,DA,DR
+6 SET DIC="^BARBL(DUZ(2),"
+7 SET DIC(0)="AEQM"
+8 DO ^DIC
+9 IF Y<0&('$DATA(BLLIST))
QUIT
+10 IF Y>0
SET BLLIST($PIECE(Y,U,2))=""
GOTO AGAIN
+11 SET TPBILL=0
+12 FOR
SET TPBILL=$ORDER(BLLIST(TPBILL))
IF 'TPBILL
QUIT
Begin DoDot:1
+13 SET BARBLIEN=$ORDER(^BARBL(DUZ(2),"B",TPBILL,""))
+14 SET BARCNT3P=$GET(BARCNT3P)+1
+15 ;CNT FOR A/R TXs
SET BARCNTX=0
+16 IF '$ORDER(^BARTR(DUZ(2),"AC",BARBLIEN,""))
Begin DoDot:2
+17 WRITE !,"NO TRANSACTIONS FOR "_TPBILL_" NO RE-Q"
End DoDot:2
QUIT
+18 SET BARTRIEN=0
+19 FOR
SET BARTRIEN=$ORDER(^BARTR(DUZ(2),"AC",BARBLIEN,BARTRIEN))
IF 'BARTRIEN
QUIT
Begin DoDot:2
+20 IF $$PAYREV(BARTRIEN)
Begin DoDot:3
+21 WRITE !,"NOT RE-QUEUED: TRANSACTION IS PAY REV"
End DoDot:3
QUIT
+22 IF $$INDPAT^BARRQ2(BARTRIEN)
WRITE !,"INDIAN PAT OR NO INSURER TYPE"
QUIT
+23 IF $DATA(^BARSESS(DUZ(2),"NS",BARTRIEN))
Begin DoDot:3
+24 WRITE !!,"TRANSACTION IN THE 'NOT SEND' STATUS"
+25 WRITE !,"TX NOT ALLOWED!"
End DoDot:3
QUIT
+26 SET BARTR1=$GET(^BARTR(DUZ(2),BARTRIEN,1))
+27 SET BARTXTYP=$PIECE(BARTR1,U)
SET BARTXADJ=$PIECE(BARTR1,U,2)
+28 IF BARTXTYP=49!(BARTXTYP=115)!(BARTXTYP=117)
Begin DoDot:3
+29 IF BARTXTYP=49
WRITE !,"NOT RE-QUEUED: BILL NEW TYPE"
+30 IF BARTXTYP=115
WRITE !,"NOT RE-QUEUED: COL BAT TO ACC POST"
+31 IF BARTXTYP=117
WRITE !,"NOT RE-QUEUED: COL BAT TO FACILITY"
End DoDot:3
QUIT
+32 IF BARTXADJ=21!(BARTXADJ=22)
Begin DoDot:3
+33 IF BARTXADJ=21
WRITE !,"NOT RE-QUEUED: ADJUST CAT 'PENDING'"
+34 IF BARTXADJ=22
WRITE !,"NOT RE-QUEUED: ADJUST CAT 'GENERAL INFORMATION'"
End DoDot:3
QUIT
+35 SET BARCNTX=BARCNT3X+1
+36 SET BARCNT=BARCNT3X
+37 DO EN2
+38 WRITE !,BARTRIEN," TRANSACTION HAS BEEN RE-QUEUED FOR BILL ",BARBILL
End DoDot:2
End DoDot:1
+39 QUIT
+40 ;
RESEND(UDUZ,SESSID,BARTRIEN) ;EP - ADD TO NEW CASHIER SESS
+1 ;P.OTT
DO RESEND^BARRQ2(UDUZ,SESSID,BARTRIEN)
+2 ;
CLRSESS ;CLEAR THE SESS TRANSMISSION DATA
+1 DO CLRSESS^BARRQ2
+2 ;
+3 ;IHS/SD/PKD DON'T KILL EXPORT HISTORY 4/15/11
CLEARTX ;EP - CLEAR THE A/R TRANS TRANSMISSION DATA
+1 DO CLEARTX^BARRQ2
+2 DO SESSLOG^BARRQ2
+3 QUIT
