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

ACHSEOB7.m

Go to the documentation of this file. 
  1. ACHSEOB7 ; IHS/ITSC/PMF - PRINT 1 OR RANGE OF EOBRS ;    [ 10/16/2001   8:16 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;
  1.  S ACHSIO=IO,(ACHSBDOC,ACHSEDOC)=""
  1.  I '$D(^ACHSEOBR("P")) W *7,!,"NO EOBRS AVAILABLE.",!! D RTRN^ACHS G K
  1.  W !!,"NOTE:",!?5,"Selecting a P.O. will print EACH transaction for that document",!?5,"in this batch, if more than one transaction exists.",!
  1. BDOC ;
  1.  S ACHSBG=1
  1.  W !,"BEGIN WITH DOCUMENT : "
  1.  W:ACHSBDOC]"" ACHSBDOC," //"
  1.  D READ^ACHSFU
  1.  I $D(DUOUT)!$D(DTOUT)!((Y="")&(ACHSBDOC="")) D K Q
  1.  I Y="",ACHSBDOC]"" S Y=ACHSBDOC G BDOC2
  1.  I Y?1"?".E D SHOW G BDOC:Y="" G BDOC2
  1.  I '$D(^ACHSEOBR("P",Y)) W *7,"??",!! D SHOW G BDOC:Y="" G BDOC2
  1. BDOC2 ;
  1.  I $D(^ACHSEOBR("P",Y)) G BDOCND
  1. BDOCER ;
  1.  W *7,"  ??"
  1.  G BDOC
  1.  ;
  1. BDOCND ;
  1.  S ACHSBDOC=Y
  1. EDOC ;
  1.  S ACHSBG=0,ACHSEG=1
  1.  W !,"END WITH DOCUMENT : "
  1.  W:ACHSEDOC]"" ACHSEDOC," //"
  1.  D READ^ACHSFU
  1.  G BDOC:$D(DUOUT)!((Y="")&(ACHSEDOC="")),K:$D(DTOUT)
  1.  I Y="",ACHSEDOC]"" G EDOC2
  1.  I Y?1"?".E D SHOW G EDOCER:Y="" ;G EDOC2
  1.  I '$D(^ACHSEOBR("P",Y)) W *7,"??",!! D SHOW G EDOC:Y="" G EDOC2
  1. EDOC2 ;
  1.  I $D(^ACHSEOBR("P",Y)) G EDOCND
  1. EDOCER ;
  1.  W *7,"  ??"
  1.  G EDOC
  1.  ;
  1. EDOCND ;
  1.  S ACHSEDOC=Y
  1. DEV ;
  1.  S %=$$PB^ACHS
  1.  I %=U!$D(DTOUT)!$D(DUOUT) D K Q
  1.  I %="B" D VIEWR^XBLM("START^ACHSEOB7"),EN^XBVK("VALM"),K Q
  1.  S %ZIS="OPQ"
  1.  D ^%ZIS
  1.  I POP D HOME^%ZIS G K
  1.  G:'$D(IO("Q")) START
  1.  K IO("Q")
  1.  I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
  1.  S ZTRTN="START^ACHSEOB7",ZTDESC="EOBR for "_ACHSBDOC_$S(ACHSEDOC]"":" to "_ACHSEDOC,1:"")
  1.  F %="ACHSBDOC","ACHSEDOC" S ZTSAVE(%)=""
  1.  D ^%ZTLOAD
  1.  G:'$D(ZTSK) DEV
  1. K ; Kill vars, do ERPT, quit.
  1.  K ZTSK
  1.  D ERPT^ACHS
  1.  D EN^XBVK("ACHS")
  1.  D ^ACHSVAR
  1.  Q
  1.  ;
  1. START ;EP - From TaskMan.
  1.  I ACHSEDOC="" S ACHSEDOC=ACHSBDOC
  1.  S ACHSOLD="",ACHSEOIO=IO
  1.  K ^TMP("ACHSEOB",$J)
  1.  D BM^ACHSFU,NOW^ACHS
  1.  S ACHSTIME=$$C^XBFUNC(ACHSTIME,80),ACHSTERR=0,ACHSCTR(1)=""
  1.  U ACHSEOIO
  1.  W @IOF
  1. L1 ;
  1. L2 ;
  1.  G K:'$D(^ACHSEOBR("P",ACHSBDOC))
  1.  S ACHSCTR(1)=$O(^ACHSEOBR("P",ACHSBDOC,ACHSCTR(1)))
  1.  G L3:ACHSCTR(1)=""
  1.  S ACHSFAC=$P(^ACHSEOBR("P",ACHSBDOC,ACHSCTR(1)),U),ACHSOLD=$E(^ACHSEOBR(ACHSFAC,ACHSCTR(1)),1,18)
  1.  D PRNT
  1.  G:$D(DUOUT)!$D(DTOUT) K
  1.  G L2
  1.  ;
  1. L3 ;
  1.  G K:ACHSBDOC=ACHSEDOC
  1. L3A ;
  1.  S ACHSBDOC=$O(^ACHSEOBR("P",ACHSBDOC))
  1.  G K:ACHSBDOC=""
  1.  G L2
  1.  ;
  1. PRNT ;
  1.  F ACHSCTR=ACHSCTR(1):1 Q:'$D(^ACHSEOBR(ACHSFAC,ACHSCTR))  S ACHSEOBR=$G(^ACHSEOBR(ACHSFAC,ACHSCTR)) Q:$E(ACHSEOBR,1,18)'=ACHSOLD  D PRT^ACHSEOBB
  1.  D ^ACHSEOB2,RTRN^ACHS
  1.  K ^TMP("ACHSEOB",$J),ACHSEOBR
  1.  Q
  1.  ;
  1. SHOW ;
  1.  S ACHSY=""
  1.  K ACHSP
  1.  F ACHS=1:1 S ACHSY=$O(^ACHSEOBR("P",ACHSY)) Q:ACHSY=""  W !,$J(ACHS,4),".  ",ACHSY S ACHSP(ACHS)=ACHSY I '(ACHS#10) W !?7,"('^' to stop) Select: " D READ^ACHSFU Q:$D(DUOUT)!$D(DTOUT)  G SHOW2:Y]"" D:Y?1"?".E SHOWH
  1.  W !?7,"('^' to stop) Select: "
  1.  D READ^ACHSFU
  1.  Q:$D(DUOUT)!$D(DTOUT)
  1.  D:Y?1"?".E SHOWH
  1. SHOW2 ;
  1.  Q:Y']""
  1.  I $D(^ACHSEOBR("P",Y)) W "  ",Y Q
  1.  I '$D(ACHSP(Y)) D SHOWH Q
  1.  S Y=ACHSP(Y)
  1.  W "  ",Y
  1.  Q
  1.  ;
  1. SHOWH ;
  1.  W !!!,"ENTER ENTRY NUMBER OF ",$S(ACHSBG:"BEGINNING",ACHSEG:"ENDING",1:"")," DOCUMENT TO PRINT",!!
  1.  Q
  1.  ;