Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSTX1R

ACHSTX1R.m

Go to the documentation of this file. 
  1. ACHSTX1R ; IHS/ITSC/PMF - REGENERATION OF EXPORT GLOBAL ;   [ 10/16/2001   8:16 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;
  1.  ; we get here if we are REEXporting.  ask which kind they want
  1.  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^ACHSTX1R(""H"")","2")
  1.  ;
  1.  I $D(DUOUT)!$D(DTOUT) S STOP=1 Q
  1.  ;
  1.  ;now go one of two ways.  If they want to reexport a specific
  1.  ;list of docs do that now.
  1.  I Y=2 D SELDOC Q
  1.  ;if not, they must want to reexport a batch
  1.  ;
  1.  D HDR
  1.  S (J,ACHSEDT,ACHSBDT)=0,ACHSRR=""
  1.  ;
  1.  W !?10,"FACILITY NAME: ",$$LOC^ACHS
  1.  ;
  1.  I '$D(^ACHSTXST(DUZ(2),1,0)) S STOP=4 Q
  1.  ;
  1.  S ACHS("MAX")=+$P($G(^ACHSTXST(DUZ(2),1,0)),U,4),ACHS("NUM")=10
  1.  S:ACHS("MAX")<10 ACHS("NUM")=ACHS("MAX")
  1.  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)
  1.  I $D(DUOUT)!$D(DTOUT) S STOP=1 Q
  1.  ;
  1.  S ACHS("NUM")=+Y
  1. L2 ;
  1.  S (ACHSR,ACHSRR)=0,ACHSLCAT=0
  1.  D HDR1
  1.  F  S ACHSR=$O(^ACHSTXST("AC",DUZ(2),ACHSR)) Q:ACHSR=""  D  Q:$D(DUOUT)
  1.  . S ACHSRR=$O(^ACHSTXST("AC",DUZ(2),ACHSR,"")) Q:ACHSRR=""
  1.  . 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
  1.  . W $J(ACHSLCAT,4),?10,X1,?25,X2,?40,X3,?55,$J($P(X,U,5),5),!
  1.  . I ACHSLCAT+1>ACHS("NUM") Q
  1.  . I '(ACHSLCAT#10) W:$$DIR^XBDIR("E","'^' TO STOP ") ""
  1.  . Q
  1.  ;
  1.  I 'ACHSLCAT Q
  1.  S Y=$$DIR^XBDIR("N^1:"_ACHSLCAT,"ENTER ITEM # FOR EXPORT DATE","","","","",2)
  1.  I $D(DUOUT)!$D(DTOUT) Q
  1.  S ACHS("REXNUM")=ACHS(+Y)
  1.  W *7,!!!?15,"*******************NOTICE******************",!?15,"The number of records in this re-export",!?15,"might differ from the number in the original.",!?15,"*******************************************",!!
  1.  D KILLGLBS^ACHSTX
  1.  S ACHSBDT=$P($G(^ACHSTXST(DUZ(2),1,ACHS("REXNUM"),0)),U,2)
  1.  S ACHSBDT=ACHSBDT-1
  1.  S ACHSEDT=$P($G(^ACHSTXST(DUZ(2),1,ACHS("REXNUM"),0)),U,3)
  1.  K ACHS("MAX"),ACHS("NUM"),ACHSLCAT,ACHSR,ACHSRR,X1,X2,X3
  1.  G S2^ACHSTX2
  1.  ;
  1. HDR ;
  1.  U IO(0)
  1.  W @IOF,!,ACHS("*"),!?22,"GENERATE PREVIOUS CHS TRANSMISSION DATA",!,ACHS("*"),!
  1.  Q
  1.  ;
  1. HDR1 ;
  1.  W !!,"ITM #",?10,"EXPORT DATE",?25,"BEG DATE",?40,"END DATE",?55,"# RECORDS",!!
  1.  Q
  1.  ;
  1. SELDOC ; Select transactions from particular documents for export.
  1.  K ^TMP("ACHSTXAR",$J)
  1.  N D,T
  1.  F  D ^ACHSUD Q:$D(DUOUT)!$D(DTOUT)!'$D(ACHSDIEN)  D  Q:%=102
  1.  . S T=$$SELTRANS(ACHSDIEN)
  1.  . I $D(DUOUT)!$D(DTOUT)!'T S %=102 Q
  1.  . 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)
  1.  . E  S ^TMP("ACHSTXAR",$J,$P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0),U),ACHSDIEN,T)=""
  1.  . S (%,X)=0
  1.  . W !!,"The list now consists of the following transactions:"
  1.  . F  S X=$O(^TMP("ACHSTXAR",$J,X)) Q:'X  S D=0 F  S D=$O(^TMP("ACHSTXAR",$J,X,D)) Q:'D  S T=0 F  S T=$O(^TMP("ACHSTXAR",$J,X,D,T)) Q:'T  D
  1.  .. S %=%+1
  1.  .. W !!,%,!!
  1.  .. ;for test!!!!!
  1.  .. I %>2 I %<99 S %=99
  1.  .. W !!,%,!!
  1.  .. ;
  1.  .. W !,$J(%,3),".  ",$P(^ACHSF(DUZ(2),"D",D,0),U,14),"-",$$FC^ACHS(DUZ(2)),"-",$P(^ACHSF(DUZ(2),"D",D,0),U,1)
  1.  .. D DISTRANS(D,T)
  1.  ..Q
  1.  . I %=101 S %=102
  1.  .Q
  1.  K ACHSDIEN
  1.  I $$DIR^XBDIR("E")
  1.  Q
  1.  ;
  1. SELTRANS(D) ; Display trans of doc D, and allow selection.
  1.  D HELP("H1")
  1.  N C,T
  1.  W !!?10,"----------------------------------------------------",!?10,"TRANS",?30,"TRANS",!?11,"NUM",?19,"D A T E",?30,"TYPE",?40,"AMOUNT",!?10,"----------------------------------------------------",!!
  1.  S (C,T)=0
  1.  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)
  1.  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)
  1.  Q:$D(DUOUT)!$D(DTOUT)!(Y=0) 0
  1.  I Y<1 Q C(-1*Y)_"^-"
  1.  Q C(Y)
  1.  ;
  1. DISTRANS(D,T) ; 
  1.  S Y=^ACHSF(DUZ(2),"D",D,"T",T,0)
  1.  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)),">"
  1.  Q
  1.  ;
  1. HELP(L) ;EP - Display text at label L.
  1.  W !
  1.  F %=1:1 W !?4,$P($T(@L+%),";",3) Q:$P($T(@L+%+1),";",3)="###"
  1.  Q
  1.  ;
  1. H ;
  1.  ;;Selection of individual documents is intended to allow the local
  1.  ;;service unit to clear documents that are not processing at higher
  1.  ;;levels.
  1.  ;;
  1.  ;;E.g., if an FI document is PEND'ing for no obligation (P259), the
  1.  ;;S.U. may want to selectively re-export the initial obligation
  1.  ;;transaction of the document.
  1.  ;;
  1.  ;;Or, if the HAS is still showing an IHS document as open after a
  1.  ;;reasonable amount of time has lapsed, the S.U. may want to
  1.  ;;selectively re-export the pay.
  1.  ;;
  1.  ;;( "ZA" and "IP" transactions are not exported. )
  1.  ;;###
  1.  ;
  1. H1 ;
  1.  ;;Enter a number corresponding to the transaction that you want to re-export.
  1.  ;;Enter a "-" before the number to remove the transaction from the list.
  1.  ;;###
  1.  ;