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