- 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 ;
