BARRQ.m

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