ACHSTXAR ; IHS/ITSC/PMF - REGENERATION OF EXPORT GLOBAL ;
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**13,14,21,26**;JUN 11, 2001;Build 43
;ACHS*3.1*13 6.26.2007 IHS/OIT/FCJ FIXED EXITING IF NO DOC SELECTED
;ACHS*3.1*14 11.5.2007 IHS/OIT/FCJ RE-EXPORT UFMS INSTEAD OF CORE RECORDS
;ACHS*3.1*26 2.26.2016 IHS/OIT/FCJ ADDED RANGE SELECTION OPTION
;
;ACHS*3.1*14 11.5.2007 IHS/OIT/FCJ ADDED COMMENT AND TEST FOR EXPORT ALREADY RAN;ACHS*3.1*21 ADDED TEST FOR RE-EXPORT
I 'ACHSREEX,$D(^ACHSTXST("C",DT,DUZ(2))) W !!,"EXPORT PROGRAM ALREADY RUN THIS DATE FOR THIS FACILITY",*7 H 2 G EXIT1
;S Y=$$DIR^XBDIR("S^1:Re-Export a Batch;2:Select (up to) 101 transactions","Which Re-export option","1","","Select one of the re-export options or ""^""","^D HELP^ACHSTXAR(""H"")","2")
S Y=$$DIR^XBDIR("S^1:Re-Export a Batch;2:Select (up to) 101 transactions;3:Select range for Intial transactions only","Which Re-export option","1","","Select one of the re-export options or ""^""","^D HELP^ACHSTXAR(""H"")","2")
G EXIT1:$D(DUOUT)!$D(DTOUT)
;ACHS*3.1*13 IHS/OIT/FCJ ADDED TEST FOR ^TMP IN NXT LINE TO EXIT IF NO DOCS SELECTED ACHS*3.1*14 CHANGE RTN FR ACHSTXA1 TO ACHSTXF1
;I Y=2 D SELDOC G EXIT1:$D(DUOUT)!$D(DTOUT)!'$D(^TMP("ACHSTXAR",$J)),^ACHSTXA1
I Y=2 D SELDOC G EXIT1:$D(DUOUT)!$D(DTOUT)!'$D(^TMP("ACHSTXAR",$J)) G ^ACHSTXF1:ACHSTXTY="U" G ^ACHSTXA1
I Y=3 D SELRANG G EXIT1:$D(DUOUT)!$D(DTOUT)!'$D(^TMP("ACHSTXAR",$J)) G ^ACHSTXF1:ACHSTXTY="U" G ^ACHSTXA1
D LINES^ACHSFU,HDR
S ACHSCHSS=""
D ^ACHSUF
K ACHSCHSS
S (J,ACHSEDT,ACHSBDT)=0,ACHSRR="",ACHSF638=$$PARM^ACHS(0,8)
F I=2:1:7 S ACHSRTYP(I)=0
W !?10,"FACILITY NAME: ",$$LOC^ACHS
L1 ;
I '$D(^ACHSTXST(DUZ(2),1,0)) W !!,*7,"NO DATA ON FILE FOR THIS FACILITY, JOB CANCELLED" G EXIT1
S ACHS("MAX")=+$P($G(^ACHSTXST(DUZ(2),1,0)),U,4),ACHS("NUM")=10
S:ACHS("MAX")<10 ACHS("NUM")=ACHS("MAX")
S Y=$$DIR^XBDIR("NO^1:"_ACHS("MAX"),"ENTER NUMBER OF EXPORT ENTRIES TO DISPLAY ",ACHS("NUM"),"","ENTER A NUMBER BETWEEN 1 AND "_ACHS("MAX"),"",2)
G L2:(Y=""),EXIT1:$D(DUOUT)!$D(DTOUT)
S ACHS("NUM")=+Y
L2 ;
S (ACHSR,ACHSRR)=0,ACHSLCAT=0
D HDR1
L3 ;
S ACHSR=$O(^ACHSTXST("AC",DUZ(2),ACHSR))
G L4:ACHSR=""
S ACHSRR=$O(^ACHSTXST("AC",DUZ(2),ACHSR,""))
G L3:ACHSRR=""
S ACHSLCAT=ACHSLCAT+1,X=^ACHSTXST(DUZ(2),1,ACHSRR,0),X1=$$FMTE^XLFDT($P(X,U)),X2=$$FMTE^XLFDT($P(X,U,2)),X3=$$FMTE^XLFDT($P(X,U,3)),ACHS(ACHSLCAT)=ACHSRR
W $J(ACHSLCAT,4),?10,X1,?25,X2,?40,X3,?55,$J($P(X,U,5),5),!
I ACHSLCAT+1>ACHS("NUM") G L4
I '(ACHSLCAT#10) W:$$DIR^XBDIR("E","'^' TO STOP ") "" G:$D(DUOUT) L4 D HDR1
G L3
;
L4 ;
I 'ACHSLCAT G NORECDS^ACHSTX8
S Y=$$DIR^XBDIR("N^1:"_ACHSLCAT,"ENTER ITEM # FOR EXPORT DATE","","","","",2)
G NORECDS^ACHSTX8:$D(DUOUT)!$D(DTOUT)
S ACHS("REXNUM")=ACHS(+Y)
W *7,!!!?15,"*******************NOTICE******************",!?15,"The number of records in this re-export",!?15,"might differ from the number in the original.",!?15,"*******************************************",!!
D KILLGLBS^ACHSTX
I ACHSTXTY="U" G ^ACHSTXF1
S ACHSBDT=$P($G(^ACHSTXST(DUZ(2),1,ACHS("REXNUM"),0)),U,2)
S ACHSBDT=ACHSBDT-1
S ACHSEDT=$P($G(^ACHSTXST(DUZ(2),1,ACHS("REXNUM"),0)),U,3)
K ACHS("MAX"),ACHS("NUM"),ACHSLCAT,ACHSR,ACHSRR,X1,X2,X3
G S2^ACHSTX2
;
HDR1 ;
W !!,"ITM #",?10,"EXPORT DATE",?25,"BEG DATE",?40,"END DATE",?55,"# RECORDS",!!
Q
;
HDR ;
U IO(0)
W @IOF,!,ACHS("*"),!?22,"GENERATE PREVIOUS CHS TRANSMISSION DATA",!,ACHS("*"),!
Q
;
EXIT1 ;
U IO(0)
W !!,"JOB CANCELLED BY OPERATOR"
D KILL^ACHSTX8
Q
;
SELDOC ; Select transactions from particular documents for export.
K ^TMP("ACHSTXAR",$J)
N D,T
F D ^ACHSUD Q:$D(DUOUT)!$D(DTOUT)!'$D(ACHSDIEN) D Q:%>101
. S T=$$SELTRANS(ACHSDIEN)
. I $D(DUOUT)!$D(DTOUT)!'T S %=102 Q
. I $P(T,U,2)="-" S T=$P(T,U,1) K ^TMP("ACHSTXAR",$J,$P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0),U),ACHSDIEN,T)
. E S ^TMP("ACHSTXAR",$J,$P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0),U),ACHSDIEN,T)=""
. ;Sel Doc Index
. S (%,ACHSSDI)=0
. W !!,"The list now consists of the following transactions:"
. F S ACHSSDI=$O(^TMP("ACHSTXAR",$J,ACHSSDI)) Q:'ACHSSDI S D=0 F S D=$O(^TMP("ACHSTXAR",$J,ACHSSDI,D)) Q:'D S T=0 F S T=$O(^TMP("ACHSTXAR",$J,ACHSSDI,D,T)) Q:'T D
.. ;
.. S %=%+1
.. W !,$J(%,2),". ",$P(^ACHSF(DUZ(2),"D",D,0),U,14),"-",$$FC^ACHS(DUZ(2)),"-",$P(^ACHSF(DUZ(2),"D",D,0),U,1)
.. D DISTRANS(D,T)
..Q
. I %=101 S %=102
.Q
K ACHSDIEN
I $$DIR^XBDIR("E")
Q
;
SELRANG ; Select Document range only Initial transactions.
K ^TMP("ACHSTXAR",$J)
N D,T
S SEL=1
BEGDOC ;
W !!!,"ENTER THE BEGINNING DOCUMENT NUMBER"
D ^ACHSUD Q:$D(DUOUT)!$D(DTOUT)!'$D(ACHSDIEN)
S ACHSEDOC(SEL,"B")=ACHSDIEN_"^"_$E(X,1,2)_"-"_ACHSFC_"-"_$E(X,3,7)_"^"_X_"^"_$P(Y(0),U,27)_$E(X,3,7)
ENDDOC ;
W !!!,"ENTER THE ENDING DOCUMENT NUMBER"
D ^ACHSUD G:$D(DUOUT)!$D(DTOUT)!'$D(ACHSDIEN) BEGDOC
I $P(Y(0),U,27)_$E(X,3,7)<$P(ACHSEDOC(SEL,"B"),U,4) W !!,"*****Document selected is not after beginning Document.*****" G ENDDOC
S ACHSEDOC(SEL,"E")=ACHSDIEN_"^"_$E(X,1,2)_"-"_ACHSFC_"-"_$E(X,3,7)_"^"_X_"^"_$P(Y(0),U,27)_$E(X,3,7)
;ANOTHER DOC RANGE?
S %=$$DIR^XBDIR("Y","Add additional Documents","N","","","",2)
I Y S SEL=SEL+1 G BEGDOC
Q:$D(DUOUT)
SETRTR ;SET TRANS FOR DOCUMENT RANGE
F L=1:1:SEL D
.S BEGDOC=$P(ACHSEDOC(L,"B"),U,3)-1,ENDDOC=$P(ACHSEDOC(L,"E"),U,3)
.I $P(ACHSEDOC(L,"B"),U,3)>$P(ACHSEDOC(L,"E"),U,3) D
..F S BEGDOC=$O(^ACHSF(DUZ(2),"D","B",BEGDOC)) Q:BEGDOC'?1N.N D SETRTR1
..S BEGDOC=1000000 F S BEGDOC=$O(^ACHSF(DUZ(2),"D","B",BEGDOC)) Q:(BEGDOC>ENDDOC)!(BEGDOC'?1N.N) D SETRTR1
.E F S BEGDOC=$O(^ACHSF(DUZ(2),"D","B",BEGDOC)) Q:(BEGDOC>ENDDOC)!(BEGDOC'?1N.N) D SETRTR1
;DISPLAY Doc Index
N ACHSQ S (%,ACHSSDI,ACHSQ)=0
W !!,"The list now consists of the following transactions:"
F S ACHSSDI=$O(^TMP("ACHSTXAR",$J,ACHSSDI)) Q:'ACHSSDI D Q:ACHSQ
.S D=0 F S D=$O(^TMP("ACHSTXAR",$J,ACHSSDI,D)) Q:'D S T=0 Q:ACHSQ F S T=$O(^TMP("ACHSTXAR",$J,ACHSSDI,D,T)) Q:'T D Q:ACHSQ
.. S %=%+1
.. W !,$J(%,2),". ",$P(^ACHSF(DUZ(2),"D",D,0),U,14),"-",$$FC^ACHS(DUZ(2)),"-",$P(^ACHSF(DUZ(2),"D",D,0),U,1)
.. D DISTRANS(D,T)
.. I %#25=0 S:'$$DIR^XBDIR("E") ACHSQ=1
K ACHSDIEN,BEGDOC,ENDDOC,ACHSEDOC,L,SEL
W !!,"CONTINUE TO EXPORT RECORDS"
I $$DIR^XBDIR("E")
Q
SETRTR1 ;SET DOC TRANS IN TEMP
S ACHSDIEN=0,ACHSDIEN=$O(^ACHSF(DUZ(2),"D","B",BEGDOC,ACHSDIEN))
S ^TMP("ACHSTXAR",$J,$P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",1,0),U),ACHSDIEN,1)=""
Q
;
SELTRANS(D) ; Display trans of doc D, and allow selection.
D HELP("H1")
N C,T
W !!?10,"----------------------------------------------------",!?10,"TRANS",?30,"TRANS",!?11,"NUM",?19,"D A T E",?30,"TYPE",?40,"AMOUNT",!?10,"----------------------------------------------------",!!
S (C,T)=0
F S T=$O(^ACHSF(DUZ(2),"D",D,"T",T)) Q:+T=0 S Y=^(T,0),C=C+1,C(C)=T W !?10,$J(C,3) D DISTRANS(D,T)
S Y=$$DIR^XBDIR("N^-"_C_":"_C,"Re-export which transaction","1","","Enter the number corresponding to the transaction you want re-exported","^D HELP^ACHSTXAR(""H1"")",2)
Q:$D(DUOUT)!$D(DTOUT)!(Y=0) 0
I Y<1 Q C(-1*Y)_"^-"
Q C(Y)
;
DISTRANS(D,T) ;
S Y=^ACHSF(DUZ(2),"D",D,"T",T,0)
W ?17,$$FMTE^XLFDT($P(Y,U,1)),?32,$P(Y,U,2),$P(Y,U,5),?35,$J($FN($P(Y,U,4),",",2),11)," <",$$EXTSET^XBFUNC(9002080.02,1,$P(Y,U,2)),">"
Q
;
HELP(L) ;EP - Display text at label L.
W !
F %=1:1 W !?4,$P($T(@L+%),";",3) Q:$P($T(@L+%+1),";",3)="###"
Q
;
H ;
;;Selection of individual documents is intended to allow the local
;;service unit to clear documents that are not processing at higher
;;levels.
;;
;;E.g., if an FI document is PEND'ing for no obligation (P259), the
;;S.U. may want to selectively re-export the initial obligation
;;transaction of the document.
;;
;;Re-export the pay transaction will not export
;;"ZA" and "IP" transactions.
;;
;;Option 3 is used to select export of only INITIAL transactions,
;;using a document range.
;;
;;###
;
H1 ;
;;Enter a number corresponding to the transaction that you want to re-export.
;;Enter a "-" before the number to remove the transaction from the list.
;;###
;
ACHSTXAR ; IHS/ITSC/PMF - REGENERATION OF EXPORT GLOBAL ;
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**13,14,21,26**;JUN 11, 2001;Build 43
+2 ;ACHS*3.1*13 6.26.2007 IHS/OIT/FCJ FIXED EXITING IF NO DOC SELECTED
+3 ;ACHS*3.1*14 11.5.2007 IHS/OIT/FCJ RE-EXPORT UFMS INSTEAD OF CORE RECORDS
+4 ;ACHS*3.1*26 2.26.2016 IHS/OIT/FCJ ADDED RANGE SELECTION OPTION
+5 ;
+6 ;ACHS*3.1*14 11.5.2007 IHS/OIT/FCJ ADDED COMMENT AND TEST FOR EXPORT ALREADY RAN;ACHS*3.1*21 ADDED TEST FOR RE-EXPORT
+7 IF 'ACHSREEX
IF $DATA(^ACHSTXST("C",DT,DUZ(2)))
WRITE !!,"EXPORT PROGRAM ALREADY RUN THIS DATE FOR THIS FACILITY",*7
HANG 2
GOTO EXIT1
+8 ;S Y=$$DIR^XBDIR("S^1:Re-Export a Batch;2:Select (up to) 101 transactions","Which Re-export option","1","","Select one of the re-export options or ""^""","^D HELP^ACHSTXAR(""H"")","2")
+9 SET Y=$$DIR^XBDIR("S^1:Re-Export a Batch;2:Select (up to) 101 transactions;3:Select range for Intial transactions only","Which Re-export option","1","","Select one of the re-export options or ""^""","^D HELP^ACHSTXAR(""H"")","2")
+10 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT1
+11 ;ACHS*3.1*13 IHS/OIT/FCJ ADDED TEST FOR ^TMP IN NXT LINE TO EXIT IF NO DOCS SELECTED ACHS*3.1*14 CHANGE RTN FR ACHSTXA1 TO ACHSTXF1
+12 ;I Y=2 D SELDOC G EXIT1:$D(DUOUT)!$D(DTOUT)!'$D(^TMP("ACHSTXAR",$J)),^ACHSTXA1
+13 IF Y=2
DO SELDOC
IF $DATA(DUOUT)!$DATA(DTOUT)!'$DATA(^TMP("ACHSTXAR",$JOB))
GOTO EXIT1
IF ACHSTXTY="U"
GOTO ^ACHSTXF1
GOTO ^ACHSTXA1
+14 IF Y=3
DO SELRANG
IF $DATA(DUOUT)!$DATA(DTOUT)!'$DATA(^TMP("ACHSTXAR",$JOB))
GOTO EXIT1
IF ACHSTXTY="U"
GOTO ^ACHSTXF1
GOTO ^ACHSTXA1
+15 DO LINES^ACHSFU
DO HDR
+16 SET ACHSCHSS=""
+17 DO ^ACHSUF
+18 KILL ACHSCHSS
+19 SET (J,ACHSEDT,ACHSBDT)=0
SET ACHSRR=""
SET ACHSF638=$$PARM^ACHS(0,8)
+20 FOR I=2:1:7
SET ACHSRTYP(I)=0
+21 WRITE !?10,"FACILITY NAME: ",$$LOC^ACHS
L1 ;
+1 IF '$DATA(^ACHSTXST(DUZ(2),1,0))
WRITE !!,*7,"NO DATA ON FILE FOR THIS FACILITY, JOB CANCELLED"
GOTO EXIT1
+2 SET ACHS("MAX")=+$PIECE($GET(^ACHSTXST(DUZ(2),1,0)),U,4)
SET ACHS("NUM")=10
+3 IF ACHS("MAX")<10
SET ACHS("NUM")=ACHS("MAX")
+4 SET Y=$$DIR^XBDIR("NO^1:"_ACHS("MAX"),"ENTER NUMBER OF EXPORT ENTRIES TO DISPLAY ",ACHS("NUM"),"","ENTER A NUMBER BETWEEN 1 AND "_ACHS("MAX"),"",2)
+5 IF (Y="")
GOTO L2
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT1
+6 SET ACHS("NUM")=+Y
L2 ;
+1 SET (ACHSR,ACHSRR)=0
SET ACHSLCAT=0
+2 DO HDR1
L3 ;
+1 SET ACHSR=$ORDER(^ACHSTXST("AC",DUZ(2),ACHSR))
+2 IF ACHSR=""
GOTO L4
+3 SET ACHSRR=$ORDER(^ACHSTXST("AC",DUZ(2),ACHSR,""))
+4 IF ACHSRR=""
GOTO L3
+5 SET ACHSLCAT=ACHSLCAT+1
SET X=^ACHSTXST(DUZ(2),1,ACHSRR,0)
SET X1=$$FMTE^XLFDT($PIECE(X,U))
SET X2=$$FMTE^XLFDT($PIECE(X,U,2))
SET X3=$$FMTE^XLFDT($PIECE(X,U,3))
SET ACHS(ACHSLCAT)=ACHSRR
+6 WRITE $JUSTIFY(ACHSLCAT,4),?10,X1,?25,X2,?40,X3,?55,$JUSTIFY($PIECE(X,U,5),5),!
+7 IF ACHSLCAT+1>ACHS("NUM")
GOTO L4
+8 IF '(ACHSLCAT#10)
IF $$DIR^XBDIR("E","'^' TO STOP ")
WRITE ""
IF $DATA(DUOUT)
GOTO L4
DO HDR1
+9 GOTO L3
+10 ;
L4 ;
+1 IF 'ACHSLCAT
GOTO NORECDS^ACHSTX8
+2 SET Y=$$DIR^XBDIR("N^1:"_ACHSLCAT,"ENTER ITEM # FOR EXPORT DATE","","","","",2)
+3 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO NORECDS^ACHSTX8
+4 SET ACHS("REXNUM")=ACHS(+Y)
+5 WRITE *7,!!!?15,"*******************NOTICE******************",!?15,"The number of records in this re-export",!?15,"might differ from the number in the original.",!?15,"*******************************************",!!
+6 DO KILLGLBS^ACHSTX
+7 IF ACHSTXTY="U"
GOTO ^ACHSTXF1
+8 SET ACHSBDT=$PIECE($GET(^ACHSTXST(DUZ(2),1,ACHS("REXNUM"),0)),U,2)
+9 SET ACHSBDT=ACHSBDT-1
+10 SET ACHSEDT=$PIECE($GET(^ACHSTXST(DUZ(2),1,ACHS("REXNUM"),0)),U,3)
+11 KILL ACHS("MAX"),ACHS("NUM"),ACHSLCAT,ACHSR,ACHSRR,X1,X2,X3
+12 GOTO S2^ACHSTX2
+13 ;
HDR1 ;
+1 WRITE !!,"ITM #",?10,"EXPORT DATE",?25,"BEG DATE",?40,"END DATE",?55,"# RECORDS",!!
+2 QUIT
+3 ;
HDR ;
+1 USE IO(0)
+2 WRITE @IOF,!,ACHS("*"),!?22,"GENERATE PREVIOUS CHS TRANSMISSION DATA",!,ACHS("*"),!
+3 QUIT
+4 ;
EXIT1 ;
+1 USE IO(0)
+2 WRITE !!,"JOB CANCELLED BY OPERATOR"
+3 DO KILL^ACHSTX8
+4 QUIT
+5 ;
SELDOC ; Select transactions from particular documents for export.
+1 KILL ^TMP("ACHSTXAR",$JOB)
+2 NEW D,T
+3 FOR
DO ^ACHSUD
IF $DATA(DUOUT)!$DATA(DTOUT)!'$DATA(ACHSDIEN)
QUIT
Begin DoDot:1
+4 SET T=$$SELTRANS(ACHSDIEN)
+5 IF $DATA(DUOUT)!$DATA(DTOUT)!'T
SET %=102
QUIT
+6 IF $PIECE(T,U,2)="-"
SET T=$PIECE(T,U,1)
KILL ^TMP("ACHSTXAR",$JOB,$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0),U),ACHSDIEN,T)
+7 IF '$TEST
SET ^TMP("ACHSTXAR",$JOB,$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0),U),ACHSDIEN,T)=""
+8 ;Sel Doc Index
+9 SET (%,ACHSSDI)=0
+10 WRITE !!,"The list now consists of the following transactions:"
+11 FOR
SET ACHSSDI=$ORDER(^TMP("ACHSTXAR",$JOB,ACHSSDI))
IF 'ACHSSDI
QUIT
SET D=0
FOR
SET D=$ORDER(^TMP("ACHSTXAR",$JOB,ACHSSDI,D))
IF 'D
QUIT
SET T=0
FOR
SET T=$ORDER(^TMP("ACHSTXAR",$JOB,ACHSSDI,D,T))
IF 'T
QUIT
Begin DoDot:2
+12 ;
+13 SET %=%+1
+14 WRITE !,$JUSTIFY(%,2),". ",$PIECE(^ACHSF(DUZ(2),"D",D,0),U,14),"-",$$FC^ACHS(DUZ(2)),"-",$PIECE(^ACHSF(DUZ(2),"D",D,0),U,1)
+15 DO DISTRANS(D,T)
+16 QUIT
End DoDot:2
+17 IF %=101
SET %=102
+18 QUIT
End DoDot:1
IF %>101
QUIT
+19 KILL ACHSDIEN
+20 IF $$DIR^XBDIR("E")
+21 QUIT
+22 ;
SELRANG ; Select Document range only Initial transactions.
+1 KILL ^TMP("ACHSTXAR",$JOB)
+2 NEW D,T
+3 SET SEL=1
BEGDOC ;
+1 WRITE !!!,"ENTER THE BEGINNING DOCUMENT NUMBER"
+2 DO ^ACHSUD
IF $DATA(DUOUT)!$DATA(DTOUT)!'$DATA(ACHSDIEN)
QUIT
+3 SET ACHSEDOC(SEL,"B")=ACHSDIEN_"^"_$EXTRACT(X,1,2)_"-"_ACHSFC_"-"_$EXTRACT(X,3,7)_"^"_X_"^"_$PIECE(Y(0),U,27)_$EXTRACT(X,3,7)
ENDDOC ;
+1 WRITE !!!,"ENTER THE ENDING DOCUMENT NUMBER"
+2 DO ^ACHSUD
IF $DATA(DUOUT)!$DATA(DTOUT)!'$DATA(ACHSDIEN)
GOTO BEGDOC
+3 IF $PIECE(Y(0),U,27)_$EXTRACT(X,3,7)<$PIECE(ACHSEDOC(SEL,"B"),U,4)
WRITE !!,"*****Document selected is not after beginning Document.*****"
GOTO ENDDOC
+4 SET ACHSEDOC(SEL,"E")=ACHSDIEN_"^"_$EXTRACT(X,1,2)_"-"_ACHSFC_"-"_$EXTRACT(X,3,7)_"^"_X_"^"_$PIECE(Y(0),U,27)_$EXTRACT(X,3,7)
+5 ;ANOTHER DOC RANGE?
+6 SET %=$$DIR^XBDIR("Y","Add additional Documents","N","","","",2)
+7 IF Y
SET SEL=SEL+1
GOTO BEGDOC
+8 IF $DATA(DUOUT)
QUIT
SETRTR ;SET TRANS FOR DOCUMENT RANGE
+1 FOR L=1:1:SEL
Begin DoDot:1
+2 SET BEGDOC=$PIECE(ACHSEDOC(L,"B"),U,3)-1
SET ENDDOC=$PIECE(ACHSEDOC(L,"E"),U,3)
+3 IF $PIECE(ACHSEDOC(L,"B"),U,3)>$PIECE(ACHSEDOC(L,"E"),U,3)
Begin DoDot:2
+4 FOR
SET BEGDOC=$ORDER(^ACHSF(DUZ(2),"D","B",BEGDOC))
IF BEGDOC'?1N.N
QUIT
DO SETRTR1
+5 SET BEGDOC=1000000
FOR
SET BEGDOC=$ORDER(^ACHSF(DUZ(2),"D","B",BEGDOC))
IF (BEGDOC>ENDDOC)!(BEGDOC'?1N.N)
QUIT
DO SETRTR1
End DoDot:2
+6 IF '$TEST
FOR
SET BEGDOC=$ORDER(^ACHSF(DUZ(2),"D","B",BEGDOC))
IF (BEGDOC>ENDDOC)!(BEGDOC'?1N.N)
QUIT
DO SETRTR1
End DoDot:1
+7 ;DISPLAY Doc Index
+8 NEW ACHSQ
SET (%,ACHSSDI,ACHSQ)=0
+9 WRITE !!,"The list now consists of the following transactions:"
+10 FOR
SET ACHSSDI=$ORDER(^TMP("ACHSTXAR",$JOB,ACHSSDI))
IF 'ACHSSDI
QUIT
Begin DoDot:1
+11 SET D=0
FOR
SET D=$ORDER(^TMP("ACHSTXAR",$JOB,ACHSSDI,D))
IF 'D
QUIT
SET T=0
IF ACHSQ
QUIT
FOR
SET T=$ORDER(^TMP("ACHSTXAR",$JOB,ACHSSDI,D,T))
IF 'T
QUIT
Begin DoDot:2
+12 SET %=%+1
+13 WRITE !,$JUSTIFY(%,2),". ",$PIECE(^ACHSF(DUZ(2),"D",D,0),U,14),"-",$$FC^ACHS(DUZ(2)),"-",$PIECE(^ACHSF(DUZ(2),"D",D,0),U,1)
+14 DO DISTRANS(D,T)
+15 IF %#25=0
IF '$$DIR^XBDIR("E")
SET ACHSQ=1
End DoDot:2
IF ACHSQ
QUIT
End DoDot:1
IF ACHSQ
QUIT
+16 KILL ACHSDIEN,BEGDOC,ENDDOC,ACHSEDOC,L,SEL
+17 WRITE !!,"CONTINUE TO EXPORT RECORDS"
+18 IF $$DIR^XBDIR("E")
+19 QUIT
SETRTR1 ;SET DOC TRANS IN TEMP
+1 SET ACHSDIEN=0
SET ACHSDIEN=$ORDER(^ACHSF(DUZ(2),"D","B",BEGDOC,ACHSDIEN))
+2 SET ^TMP("ACHSTXAR",$JOB,$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",1,0),U),ACHSDIEN,1)=""
+3 QUIT
+4 ;
SELTRANS(D) ; Display trans of doc D, and allow selection.
+1 DO HELP("H1")
+2 NEW C,T
+3 WRITE !!?10,"----------------------------------------------------",!?10,"TRANS",?30,"TRANS",!?11,"NUM",?19,"D A T E",?30,"TYPE",?40,"AMOUNT",!?10,"----------------------------------------------------",!!
+4 SET (C,T)=0
+5 FOR
SET T=$ORDER(^ACHSF(DUZ(2),"D",D,"T",T))
IF +T=0
QUIT
SET Y=^(T,0)
SET C=C+1
SET C(C)=T
WRITE !?10,$JUSTIFY(C,3)
DO DISTRANS(D,T)
+6 SET Y=$$DIR^XBDIR("N^-"_C_":"_C,"Re-export which transaction","1","","Enter the number corresponding to the transaction you want re-exported","^D HELP^ACHSTXAR(""H1"")",2)
+7 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=0)
QUIT 0
+8 IF Y<1
QUIT C(-1*Y)_"^-"
+9 QUIT C(Y)
+10 ;
DISTRANS(D,T) ;
+1 SET Y=^ACHSF(DUZ(2),"D",D,"T",T,0)
+2 WRITE ?17,$$FMTE^XLFDT($PIECE(Y,U,1)),?32,$PIECE(Y,U,2),$PIECE(Y,U,5),?35,$JUSTIFY($FNUMBER($PIECE(Y,U,4),",",2),11)," <",$$EXTSET^XBFUNC(9002080.02,1,$PIECE(Y,U,2)),">"
+3 QUIT
+4 ;
HELP(L) ;EP - Display text at label L.
+1 WRITE !
+2 FOR %=1:1
WRITE !?4,$PIECE($TEXT(@L+%),";",3)
IF $PIECE($TEXT(@L+%+1),";",3)="###"
QUIT
+3 QUIT
+4 ;
H ;
+1 ;;Selection of individual documents is intended to allow the local
+2 ;;service unit to clear documents that are not processing at higher
+3 ;;levels.
+4 ;;
+5 ;;E.g., if an FI document is PEND'ing for no obligation (P259), the
+6 ;;S.U. may want to selectively re-export the initial obligation
+7 ;;transaction of the document.
+8 ;;
+9 ;;Re-export the pay transaction will not export
+10 ;;"ZA" and "IP" transactions.
+11 ;;
+12 ;;Option 3 is used to select export of only INITIAL transactions,
+13 ;;using a document range.
+14 ;;
+15 ;;###
+16 ;
H1 ;
+1 ;;Enter a number corresponding to the transaction that you want to re-export.
+2 ;;Enter a "-" before the number to remove the transaction from the list.
+3 ;;###
+4 ;
