ACHSTX2R ; IHS/ITSC/PMF - EXPORT DATA. reexport selected documents
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
;we get here if we are reexporting POs specified by the user.
;
;same initialization as exporting for the first time
D INIT^ACHSTX11 I STOP Q
;
; Select transactions from particular documents for export.
KILL ^TMP("ACHSTXAR",$J)
NEW D,T
F D ^ACHSUD Q:$D(DUOUT)!$D(DTOUT)!'$D(ACHSDIEN) D SELDOC Q:%=11
;
K ACHSDIEN
I $$DIR^XBDIR("E")
;
;Now, if we have transactions, call them up one by one and
;examine them. Use the same code path used for exporting
;for the first time.
;
;
S ACHSDATE="" F S ACHSDATE=$O(^TMP("ACHSTXAR",$J,ACHSDATE)) Q:ACHSDATE="" D
. S ACHSDIEN="" F S ACHSDIEN=$O(^TMP("ACHSTXAR",$J,ACHSDATE,ACHSDIEN)) Q:ACHSDIEN="" D
.. S ACHSTY="" F S ACHSTY=$O(^TMP("ACHSTXAR",$J,ACHSDATE,ACHSDIEN,ACHSTY)) Q:ACHSTY="" D
... ;we use var DA for the next level so that it matchs what
... ;the main export code does
... S DA="" F S DA=$O(^TMP("ACHSTXAR",$J,ACHSDATE,ACHSDIEN,ACHSTY,DA)) Q:DA="" D
.... S ACHSDOCN=^TMP("ACHSTXAR",$J,ACHSDATE,ACHSDIEN,ACHSTY,DA)
.... D ^ACHSDOCR I 'OK Q
.... D ^ACHSVNDR I 'OK Q
.... S ACHSCTY=ACHSTY
.... D EXTR4^ACHSTX11
.... Q
... Q
.. Q
. Q
Q
;
SELDOC ;
;now that we have a pointer to a document, ACHSDIEN, lets pick
;what transaction we want.
;
S ACHSDOCR=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,0))
I ACHSDOCR="" W !!,"Invalid PO" Q
S ACHSDOCN="0"_$P(ACHSDOCR,U,14)_ACHSFC_$E($P(ACHSDOCR,U)+100000,2,6)
;The SELTRANS module returns these vars set for this doc and trans:
;ACHSDATE date of the transaction activity
;ACHSTY transaction type
;T transaction number
;
S T=$$SELTRANS(ACHSDIEN)
I $D(DUOUT)!$D(DTOUT)!'T S %=11,STOP=1 Q
;
;if they asked to remove a selection, do so
;else set the transaction into the list
I $P(T,U,2)="-" S T=$P(T,U,1) KILL ^TMP("ACHSTXAR",$J,ACHSDATE,ACHSDIEN,ACHSTY,T)
E S ^TMP("ACHSTXAR",$J,ACHSDATE,ACHSDIEN,ACHSTY,T)=ACHSDOCN
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 D
. S ACHSTYP="" F S ACHSTYP=$O(^TMP("ACHSTXAR",$J,ACHSSDI,D,ACHSTYP)) Q:ACHSTYP="" S T=0 F S T=$O(^TMP("ACHSTXAR",$J,ACHSSDI,D,ACHSTYP,T)) Q:'T D
.. S ACHSDOCN=^TMP("ACHSTXAR",$J,ACHSSDI,D,ACHSTYP,T)
.. 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
. Q
;
I %=10 S %=11
Q
;
SELTRANS(D) ; Display trans of doc D, and allow selection.
D HELP("H1")
NEW 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)
S ACHSDATE=$P(Y,U,1),ACHSTY=$P(Y,U,2)
W ?17,$$FMTE^XLFDT(ACHSDATE),?32,ACHSTY,$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.
;;
;;Or, if the HAS is still showing an IHS document as open after a
;;reasonable amount of time has lapsed, the S.U. may want to
;;selectively re-export the pay.
;;
;;( "ZA" and "IP" transactions are not exported. )
;;###
;
;
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.
;;###
;
ACHSTX2R ; IHS/ITSC/PMF - EXPORT DATA. reexport selected documents
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 ;we get here if we are reexporting POs specified by the user.
+4 ;
+5 ;same initialization as exporting for the first time
+6 DO INIT^ACHSTX11
IF STOP
QUIT
+7 ;
+8 ; Select transactions from particular documents for export.
+9 KILL ^TMP("ACHSTXAR",$JOB)
+10 NEW D,T
+11 FOR
DO ^ACHSUD
IF $DATA(DUOUT)!$DATA(DTOUT)!'$DATA(ACHSDIEN)
QUIT
DO SELDOC
IF %=11
QUIT
+12 ;
+13 KILL ACHSDIEN
+14 IF $$DIR^XBDIR("E")
+15 ;
+16 ;Now, if we have transactions, call them up one by one and
+17 ;examine them. Use the same code path used for exporting
+18 ;for the first time.
+19 ;
+20 ;
+21 SET ACHSDATE=""
FOR
SET ACHSDATE=$ORDER(^TMP("ACHSTXAR",$JOB,ACHSDATE))
IF ACHSDATE=""
QUIT
Begin DoDot:1
+22 SET ACHSDIEN=""
FOR
SET ACHSDIEN=$ORDER(^TMP("ACHSTXAR",$JOB,ACHSDATE,ACHSDIEN))
IF ACHSDIEN=""
QUIT
Begin DoDot:2
+23 SET ACHSTY=""
FOR
SET ACHSTY=$ORDER(^TMP("ACHSTXAR",$JOB,ACHSDATE,ACHSDIEN,ACHSTY))
IF ACHSTY=""
QUIT
Begin DoDot:3
+24 ;we use var DA for the next level so that it matchs what
+25 ;the main export code does
+26 SET DA=""
FOR
SET DA=$ORDER(^TMP("ACHSTXAR",$JOB,ACHSDATE,ACHSDIEN,ACHSTY,DA))
IF DA=""
QUIT
Begin DoDot:4
+27 SET ACHSDOCN=^TMP("ACHSTXAR",$JOB,ACHSDATE,ACHSDIEN,ACHSTY,DA)
+28 DO ^ACHSDOCR
IF 'OK
QUIT
+29 DO ^ACHSVNDR
IF 'OK
QUIT
+30 SET ACHSCTY=ACHSTY
+31 DO EXTR4^ACHSTX11
+32 QUIT
End DoDot:4
+33 QUIT
End DoDot:3
+34 QUIT
End DoDot:2
+35 QUIT
End DoDot:1
+36 QUIT
+37 ;
SELDOC ;
+1 ;now that we have a pointer to a document, ACHSDIEN, lets pick
+2 ;what transaction we want.
+3 ;
+4 SET ACHSDOCR=$GET(^ACHSF(DUZ(2),"D",ACHSDIEN,0))
+5 IF ACHSDOCR=""
WRITE !!,"Invalid PO"
QUIT
+6 SET ACHSDOCN="0"_$PIECE(ACHSDOCR,U,14)_ACHSFC_$EXTRACT($PIECE(ACHSDOCR,U)+100000,2,6)
+7 ;The SELTRANS module returns these vars set for this doc and trans:
+8 ;ACHSDATE date of the transaction activity
+9 ;ACHSTY transaction type
+10 ;T transaction number
+11 ;
+12 SET T=$$SELTRANS(ACHSDIEN)
+13 IF $DATA(DUOUT)!$DATA(DTOUT)!'T
SET %=11
SET STOP=1
QUIT
+14 ;
+15 ;if they asked to remove a selection, do so
+16 ;else set the transaction into the list
+17 IF $PIECE(T,U,2)="-"
SET T=$PIECE(T,U,1)
KILL ^TMP("ACHSTXAR",$JOB,ACHSDATE,ACHSDIEN,ACHSTY,T)
+18 IF '$TEST
SET ^TMP("ACHSTXAR",$JOB,ACHSDATE,ACHSDIEN,ACHSTY,T)=ACHSDOCN
+19 SET (%,ACHSSDI)=0
+20 ;
+21 WRITE !!,"The list now consists of the following transactions:"
+22 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
Begin DoDot:1
+23 SET ACHSTYP=""
FOR
SET ACHSTYP=$ORDER(^TMP("ACHSTXAR",$JOB,ACHSSDI,D,ACHSTYP))
IF ACHSTYP=""
QUIT
SET T=0
FOR
SET T=$ORDER(^TMP("ACHSTXAR",$JOB,ACHSSDI,D,ACHSTYP,T))
IF 'T
QUIT
Begin DoDot:2
+24 SET ACHSDOCN=^TMP("ACHSTXAR",$JOB,ACHSSDI,D,ACHSTYP,T)
+25 SET %=%+1
+26 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)
+27 DO DISTRANS(D,T)
+28 QUIT
End DoDot:2
+29 QUIT
End DoDot:1
+30 ;
+31 IF %=10
SET %=11
+32 QUIT
+33 ;
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 ;
+7 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)
+8 ;
+9 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=0)
QUIT 0
+10 IF Y<1
QUIT C(-1*Y)_"^-"
+11 QUIT C(Y)
+12 ;
DISTRANS(D,T) ;
+1 SET Y=^ACHSF(DUZ(2),"D",D,"T",T,0)
+2 SET ACHSDATE=$PIECE(Y,U,1)
SET ACHSTY=$PIECE(Y,U,2)
+3 WRITE ?17,$$FMTE^XLFDT(ACHSDATE),?32,ACHSTY,$PIECE(Y,U,5),?35,$JUSTIFY($FNUMBER($PIECE(Y,U,4),",",2),11)," <",$$EXTSET^XBFUNC(9002080.02,1,$PIECE(Y,U,2)),">"
+4 QUIT
+5 ;
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 ;;Or, if the HAS is still showing an IHS document as open after a
+10 ;;reasonable amount of time has lapsed, the S.U. may want to
+11 ;;selectively re-export the pay.
+12 ;;
+13 ;;( "ZA" and "IP" transactions are not exported. )
+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 ;
