ABMDEWS ; IHS/ASDST/DMJ - Print Worksheets ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
; Original;TMD;
;
I '$D(IO)!'$D(IOF)!'$D(IOST) S IOP="HOME" D ^%ZIS
K ABM,ABMP,ABMD,ABMM
;
W !!,"PRINT WORKSHEET FOR:"
K DIR
S DIR(0)="SO^1:SELECTIVE CLAIMS;2:ALL CLAIMS FOR AN EXPORT DATE"
S DIR("A")="Select Desired Option"
D ^DIR
K DIR
G XIT:$D(DIROUT)!$D(DIRUT)
S ABMP("DO")=$S(Y=1:"MULT^ABMDEDIC",1:"BATCH")
D @ABMP("DO")
G XIT:$D(DTOUT)!$D(DUOUT)!'$D(ABMM)
;
W !!?10,"(NOTE: Standard plain paper needs to be loaded in the printer.)"
;
S ABMP("PG")=0
S ABMP("HEAD2")="WORKSHEET DATA"
S ABMP("WORKSHEET")=""
;
ZIS ;
W !!
S %ZIS("A")="Output DEVICE: "
S %ZIS="QP"
S %ZIS("B")=""
D ^%ZIS
G:POP XIT
I '$D(IO("Q")) G BEGIN W !!,"JOB MUST BE QUEUED" G ZIS
;
QUE ;
K IO("Q")
I IO=IO(0) W !,"Cannot Queue to Screen or Slave Printer!",! G ZIS
S ZTRTN="ENT^ABMDEWS"
S ZTDESC="3P BILLING CLAIM DATA DETAILED DISPLAY"
F ABM="ZTRTN","ZTDESC","ABMM(" S ZTSAVE(ABM)=""
D ^%ZTLOAD
;
TSK ;
I $D(ZTSK) W !,"(Job Queued, Task Number: ",ZTSK,")"
D ^%ZISC
G XIT
;
ENT ;TaskMan Entry Point
S ABMD("QUEON")=""
;
BEGIN ;
U IO
S ABMM=""
F S ABMM=$O(ABMM(ABMM)) Q:'ABMM D Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
. S ABMP("CDFN")=ABMM
. S ABMP("SCRN")=1
. S ABMP("RTN")="^ABMDE1"
. S ABMD("CTR")=0
. S ABMP("DDL")=""
. S ABMP("WORKSHEET")=1
. S ABMP("GL")="^ABMPCLM("_ABMP("CDFN")_","
. S ABMP("PDFN")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,1),ABMP("VTYP")=$P(^(0),"^",7),ABMM("NINS")=$P(^(0),"^",8)
. S ABMM("OINS")=0
. S (ABM,ABM("OI"))=0
. F S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM)) Q:'ABM D Q:ABMM("OINS")
. . S ABM("I")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM,0))
. . S ABM("S")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("I"),0)),U,3)
. . I ABM("S")="I",ABM("OI"),ABMM("NINS")'=ABM("OI") D Q
. . . S ABMM("OINS")=ABM("OI")
. . . S ABMM("CDFN")=ABMP("CDFN")
. . S ABM("OI")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("I"),0),U)
. I ABMM("OINS") D Q:$D(ABM("DIE-FAIL"))
. . S DIE="^ABMDCLM(DUZ(2),"
. . S DA=ABMP("CDFN")
. . S DR=".08////"_ABMM("OINS")
. . D ^ABMDDIE
. D ^ABMDEVAR
. D SCRN^ABMDE
. I ABMM("OINS") D Q:$D(ABM("DIE-FAIL"))
. . S DIE="^ABMDCLM(DUZ(2),"
. . S DA=ABMM("CDFN")
. . S DR=".08////"_ABMM("NINS")
. . D ^ABMDDIE
. I $E(IOST)="C",'$D(IO("S")),'$D(ABMD("QUEON")),'$D(DUOUT),'$D(DTOUT),'$D(DIRUT) K DIR S DIR(0)="E" D ^DIR K DIR
I $E(IOST)'="C" W $$EN^ABMVDF("IOF")
D ^%ZISC
;
XIT ;
K ABMM,ABMP,ABM,ABMD,POP,ZTSK,DIRUT,DTOUT,IO("Q"),DIR,DIRUT,DIQ
Q
;
BATCH ;
W !!
K DIC
S DIC="^ABMDTXST(DUZ(2),"
S DIC(0)="QEAM"
S DIC("A")="Select EXPORT BATCH (Date): "
D ^DIC
Q:X=""!$D(DUOUT)!$D(DTOUT)
I +Y<1 G BATCH
S ABM=""
F S ABM=$O(^ABMDBILL(DUZ(2),"AX",+Y,ABM)) Q:'ABM D
. S ABM("C")=+^ABMDBILL(DUZ(2),ABM,0)
. I $D(^ABMDCLM(DUZ(2),ABM("C"),0)) S ABMM(ABM("C"))=""
K DIC
;
END Q
ABMDEWS ; IHS/ASDST/DMJ - Print Worksheets ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ; Original;TMD;
+3 ;
+4 IF '$DATA(IO)!'$DATA(IOF)!'$DATA(IOST)
SET IOP="HOME"
DO ^%ZIS
+5 KILL ABM,ABMP,ABMD,ABMM
+6 ;
+7 WRITE !!,"PRINT WORKSHEET FOR:"
+8 KILL DIR
+9 SET DIR(0)="SO^1:SELECTIVE CLAIMS;2:ALL CLAIMS FOR AN EXPORT DATE"
+10 SET DIR("A")="Select Desired Option"
+11 DO ^DIR
+12 KILL DIR
+13 IF $DATA(DIROUT)!$DATA(DIRUT)
GOTO XIT
+14 SET ABMP("DO")=$SELECT(Y=1:"MULT^ABMDEDIC",1:"BATCH")
+15 DO @ABMP("DO")
+16 IF $DATA(DTOUT)!$DATA(DUOUT)!'$DATA(ABMM)
GOTO XIT
+17 ;
+18 WRITE !!?10,"(NOTE: Standard plain paper needs to be loaded in the printer.)"
+19 ;
+20 SET ABMP("PG")=0
+21 SET ABMP("HEAD2")="WORKSHEET DATA"
+22 SET ABMP("WORKSHEET")=""
+23 ;
ZIS ;
+1 WRITE !!
+2 SET %ZIS("A")="Output DEVICE: "
+3 SET %ZIS="QP"
+4 SET %ZIS("B")=""
+5 DO ^%ZIS
+6 IF POP
GOTO XIT
+7 IF '$DATA(IO("Q"))
GOTO BEGIN
WRITE !!,"JOB MUST BE QUEUED"
GOTO ZIS
+8 ;
QUE ;
+1 KILL IO("Q")
+2 IF IO=IO(0)
WRITE !,"Cannot Queue to Screen or Slave Printer!",!
GOTO ZIS
+3 SET ZTRTN="ENT^ABMDEWS"
+4 SET ZTDESC="3P BILLING CLAIM DATA DETAILED DISPLAY"
+5 FOR ABM="ZTRTN","ZTDESC","ABMM("
SET ZTSAVE(ABM)=""
+6 DO ^%ZTLOAD
+7 ;
TSK ;
+1 IF $DATA(ZTSK)
WRITE !,"(Job Queued, Task Number: ",ZTSK,")"
+2 DO ^%ZISC
+3 GOTO XIT
+4 ;
ENT ;TaskMan Entry Point
+1 SET ABMD("QUEON")=""
+2 ;
BEGIN ;
+1 USE IO
+2 SET ABMM=""
+3 FOR
SET ABMM=$ORDER(ABMM(ABMM))
IF 'ABMM
QUIT
Begin DoDot:1
+4 SET ABMP("CDFN")=ABMM
+5 SET ABMP("SCRN")=1
+6 SET ABMP("RTN")="^ABMDE1"
+7 SET ABMD("CTR")=0
+8 SET ABMP("DDL")=""
+9 SET ABMP("WORKSHEET")=1
+10 SET ABMP("GL")="^ABMPCLM("_ABMP("CDFN")_","
+11 SET ABMP("PDFN")=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,1)
SET ABMP("VTYP")=$PIECE(^(0),"^",7)
SET ABMM("NINS")=$PIECE(^(0),"^",8)
+12 SET ABMM("OINS")=0
+13 SET (ABM,ABM("OI"))=0
+14 FOR
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM))
IF 'ABM
QUIT
Begin DoDot:2
+15 SET ABM("I")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM,0))
+16 SET ABM("S")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("I"),0)),U,3)
+17 IF ABM("S")="I"
IF ABM("OI")
IF ABMM("NINS")'=ABM("OI")
Begin DoDot:3
+18 SET ABMM("OINS")=ABM("OI")
+19 SET ABMM("CDFN")=ABMP("CDFN")
End DoDot:3
QUIT
+20 SET ABM("OI")=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("I"),0),U)
End DoDot:2
IF ABMM("OINS")
QUIT
+21 IF ABMM("OINS")
Begin DoDot:2
+22 SET DIE="^ABMDCLM(DUZ(2),"
+23 SET DA=ABMP("CDFN")
+24 SET DR=".08////"_ABMM("OINS")
+25 DO ^ABMDDIE
End DoDot:2
IF $DATA(ABM("DIE-FAIL"))
QUIT
+26 DO ^ABMDEVAR
+27 DO SCRN^ABMDE
+28 IF ABMM("OINS")
Begin DoDot:2
+29 SET DIE="^ABMDCLM(DUZ(2),"
+30 SET DA=ABMM("CDFN")
+31 SET DR=".08////"_ABMM("NINS")
+32 DO ^ABMDDIE
End DoDot:2
IF $DATA(ABM("DIE-FAIL"))
QUIT
+33 IF $EXTRACT(IOST)="C"
IF '$DATA(IO("S"))
IF '$DATA(ABMD("QUEON"))
IF '$DATA(DUOUT)
IF '$DATA(DTOUT)
IF '$DATA(DIRUT)
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+34 IF $EXTRACT(IOST)'="C"
WRITE $$EN^ABMVDF("IOF")
+35 DO ^%ZISC
+36 ;
XIT ;
+1 KILL ABMM,ABMP,ABM,ABMD,POP,ZTSK,DIRUT,DTOUT,IO("Q"),DIR,DIRUT,DIQ
+2 QUIT
+3 ;
BATCH ;
+1 WRITE !!
+2 KILL DIC
+3 SET DIC="^ABMDTXST(DUZ(2),"
+4 SET DIC(0)="QEAM"
+5 SET DIC("A")="Select EXPORT BATCH (Date): "
+6 DO ^DIC
+7 IF X=""!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
+8 IF +Y<1
GOTO BATCH
+9 SET ABM=""
+10 FOR
SET ABM=$ORDER(^ABMDBILL(DUZ(2),"AX",+Y,ABM))
IF 'ABM
QUIT
Begin DoDot:1
+11 SET ABM("C")=+^ABMDBILL(DUZ(2),ABM,0)
+12 IF $DATA(^ABMDCLM(DUZ(2),ABM("C"),0))
SET ABMM(ABM("C"))=""
End DoDot:1
+13 KILL DIC
+14 ;
END QUIT
