ABMPSTRD ; IHS/SD/SDR - Re-Print Selected Pt statements ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
START ;
K ABMY,ABMP
S ABMP("XMIT")=0
S ABMY("TOT")="0^0^0"
W !!,"Re-Print Statements for:"
K DIR
S DIR(0)="SO^1:SELECTIVE STATEMENT(S);2:ALL STATEMENTS WITHIN APPROVED DATE RANGE;3:APPROVING OFFICIAL"
S DIR("A")="Select Desired Option"
D ^DIR
K DIR
G XIT:$D(DIRUT)!$D(DIROUT),SEL:Y=1,DTRANGE:Y=2
;
APOFF ; by approving official
K DIC,X,Y
S DIC="^VA(200,"
S DIC(0)="AEM"
S DIC("A")="Approving Official: "
D ^DIC
I Y>0 S ABMY("AOFF",+Y)=""
I '$O(ABMY("AOFF",0)) W !!,"NO APPROVING OFFICIAL SELECTED!" G START
;
DTRANGE ; by date range
W !
S DIR("A")="Enter STARTING APPROVAL DATE for the Report"
S DIR("B")=$$SDT^ABMDUTL(DT)
S DIR(0)="DO^::EP"
D ^DIR
G START:($D(DIRUT)!$D(DIROUT))
S ABMY("DT",1)=Y
W !
S DIR("A")="Enter ENDING APPROVAL DATE for the Report"
D ^DIR
K DIR
G DTRANGE:$D(DIRUT)
S ABMY("DT",2)=Y
I ABMY("DT",1)>ABMY("DT",2) W !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!! G DTRANGE
G ZIS
;
SEL ; by individual bill
W !!
K DIC
S DIC="^ABMDBILL(DUZ(2),"
S DIC(0)="QZEAM"
S ABMY=$G(ABMY)+1
S ABM("E")=$E(ABMY,$L(ABMY))
S DIC("A")="Select "_ABMY_$S(ABMY>3&(ABMY<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" BILL to Re-Print: "
S DIC("S")="I $P(^(0),U)'=+^(0),""BTCP""[$P(^(0),""^"",4)"
D BENT^ABMDBDIC ;returns ABMP("BDFN")
G XIT:$D(DUOUT)!$D(DTOUT)
I '$G(ABMP("BDFN")) G ZIS:ABMY>1,XIT
I '$G(ABMP("BDFN")) S ABMY=ABMY-1 G SEL
S ABMP("PDFN")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5)
D COVRG^ABMPTSMT
I $G(ABMISNB)=0 D
.K DIR
.S DIR("A",1)="YOU HAVE SELECTED A STATEMENT FOR AN INDIAN BENEFICIARY."
.S DIR("A")="DO YOU WISH TO CONTINUE PRINTING"
.S DIR("B")="N"
.S DIR(0)="Y"
.D ^DIR
Q:Y=0 ;don't print it-they are ben
; do they want to edit message at bottom of statement?
W !!
K DIR,X,Y
S ABMMSG=$S(+$O(ABML(0))'=0:"Your insurance has been billed",$G(ABMABEN)=1:"Summary of services rendered",1:"First notice of balance due. Please remit payment promptly")
S DIR("A",1)="This message will print on bottom of statement:"
S DIR("A",2)=""
S DIR("A",3)=ABMMSG
S DIR("A",4)=""
S DIR("A")="Would you like to edit it?"
S DIR("B")="N"
S DIR(0)="Y"
D ^DIR K DIR
I +Y>0 D
.K X,Y
.S DIR("A")=ABMMSG
.S DIR(0)="F^0:70"
.D ^DIR K DIR
.I '$D(DIROUT),'$D(DUOUT),'$D(DTOUT),'$D(DIRUT) S ABMMSG=$G(X)
;
S ABMY(ABMP("BDFN"))=ABMMSG
G SEL
;
ZIS ;
W !!?15,"(NOTE: "
W "Plain Paper needs"
W " to be loaded in the printer.)"
W !!
S %ZIS("A")="Output DEVICE: "
S %ZIS="PQ"
D ^%ZIS
G XIT:POP
I IO'=IO(0),IOT'="HFS" D Q
.D QUE2
.D HOME^%ZIS
U IO(0)
W:'$D(IO("S")) !!,"Printing..."
U IO
G ENT
;
QUE2 ;
I IO=IO(0) W !,"Cannot Queue to Screen or Slave Printer!",! G ZIS
S ZTRTN="TSK^ABMPSTRD"
S ZTDESC="3P Re-Print of Selective Bill."
F ABM="ZTRTN","ZTDESC","ABMP(","ABMY(" S ZTSAVE(ABM)=""
D ^%ZTLOAD
I $D(ZTSK) W !,"(Job Queued, Task Number: ",ZTSK,")"
G OUT
;
TSK ; Taskman Entry Point
S ABMP("Q")=""
;
ENT ;
I '$D(ABMY("DT")) D G OUT
.S ABMY=0
.F S ABMY=$O(ABMY(ABMY)) Q:'ABMY D
..S ABMP("BDFN")=ABMY
..D STMTS
S ABMYDT=$G(ABMY("DT",1))-.5
F S ABMYDT=$O(^ABMDBILL(DUZ(2),"AP",ABMYDT)) Q:'ABMYDT!(ABMYDT>ABMY("DT",2)) D
.S ABMP("BDFN")=0
.F S ABMP("BDFN")=$O(^ABMDBILL(DUZ(2),"AP",ABMYDT,ABMP("BDFN"))) Q:'ABMP("BDFN") D
..; Quit if bill status is Reviewed, Approved, or Cancelled
..Q:"RAX"[$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,4)
..;if approving official selected and not a match
..I $D(ABMY("AOFF")),$O(ABMY("AOFF",0))'=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,4) Q
..Q:$G(^ABMDCLM(DUZ(2),+$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U),0))="" ;manually created bill
..S ABMP("PDFN")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5)
..K ABMISNB,ABMBEN
..D COVRG^ABMPTSMT
..I $G(ABMBEN)=1 Q ;don't print statements for bens when batching
..I ABMBILLD=1 Q ;has completed insurer; don't print when batching
..I +$O(ABML(0))'=0 S ABMY(ABMP("BDFN"))="Your insurance has been billed"
..D STMTS
G OUT
;
STMTS ; Reprint Statements
K ABMP("PAYED")
D @("^ABMPTSMT")
Q
;
OUT ;
D ^%ZISC
;
XIT ;
K ABMP,ABMY,DIQ
Q
ABMPSTRD ; IHS/SD/SDR - Re-Print Selected Pt statements ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
START ;
+1 KILL ABMY,ABMP
+2 SET ABMP("XMIT")=0
+3 SET ABMY("TOT")="0^0^0"
+4 WRITE !!,"Re-Print Statements for:"
+5 KILL DIR
+6 SET DIR(0)="SO^1:SELECTIVE STATEMENT(S);2:ALL STATEMENTS WITHIN APPROVED DATE RANGE;3:APPROVING OFFICIAL"
+7 SET DIR("A")="Select Desired Option"
+8 DO ^DIR
+9 KILL DIR
+10 IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO XIT
IF Y=1
GOTO SEL
IF Y=2
GOTO DTRANGE
+11 ;
APOFF ; by approving official
+1 KILL DIC,X,Y
+2 SET DIC="^VA(200,"
+3 SET DIC(0)="AEM"
+4 SET DIC("A")="Approving Official: "
+5 DO ^DIC
+6 IF Y>0
SET ABMY("AOFF",+Y)=""
+7 IF '$ORDER(ABMY("AOFF",0))
WRITE !!,"NO APPROVING OFFICIAL SELECTED!"
GOTO START
+8 ;
DTRANGE ; by date range
+1 WRITE !
+2 SET DIR("A")="Enter STARTING APPROVAL DATE for the Report"
+3 SET DIR("B")=$$SDT^ABMDUTL(DT)
+4 SET DIR(0)="DO^::EP"
+5 DO ^DIR
+6 IF ($DATA(DIRUT)!$DATA(DIROUT))
GOTO START
+7 SET ABMY("DT",1)=Y
+8 WRITE !
+9 SET DIR("A")="Enter ENDING APPROVAL DATE for the Report"
+10 DO ^DIR
+11 KILL DIR
+12 IF $DATA(DIRUT)
GOTO DTRANGE
+13 SET ABMY("DT",2)=Y
+14 IF ABMY("DT",1)>ABMY("DT",2)
WRITE !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!!
GOTO DTRANGE
+15 GOTO ZIS
+16 ;
SEL ; by individual bill
+1 WRITE !!
+2 KILL DIC
+3 SET DIC="^ABMDBILL(DUZ(2),"
+4 SET DIC(0)="QZEAM"
+5 SET ABMY=$GET(ABMY)+1
+6 SET ABM("E")=$EXTRACT(ABMY,$LENGTH(ABMY))
+7 SET DIC("A")="Select "_ABMY_$SELECT(ABMY>3&(ABMY<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" BILL to Re-Print: "
+8 SET DIC("S")="I $P(^(0),U)'=+^(0),""BTCP""[$P(^(0),""^"",4)"
+9 ;returns ABMP("BDFN")
DO BENT^ABMDBDIC
+10 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO XIT
+11 IF '$GET(ABMP("BDFN"))
IF ABMY>1
GOTO ZIS
GOTO XIT
+12 IF '$GET(ABMP("BDFN"))
SET ABMY=ABMY-1
GOTO SEL
+13 SET ABMP("PDFN")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5)
+14 DO COVRG^ABMPTSMT
+15 IF $GET(ABMISNB)=0
Begin DoDot:1
+16 KILL DIR
+17 SET DIR("A",1)="YOU HAVE SELECTED A STATEMENT FOR AN INDIAN BENEFICIARY."
+18 SET DIR("A")="DO YOU WISH TO CONTINUE PRINTING"
+19 SET DIR("B")="N"
+20 SET DIR(0)="Y"
+21 DO ^DIR
End DoDot:1
+22 ;don't print it-they are ben
IF Y=0
QUIT
+23 ; do they want to edit message at bottom of statement?
+24 WRITE !!
+25 KILL DIR,X,Y
+26 SET ABMMSG=$SELECT(+$ORDER(ABML(0))'=0:"Your insurance has been billed",$GET(ABMABEN)=1:"Summary of services rendered",1:"First notice of balance due. Please remit payment promptly")
+27 SET DIR("A",1)="This message will print on bottom of statement:"
+28 SET DIR("A",2)=""
+29 SET DIR("A",3)=ABMMSG
+30 SET DIR("A",4)=""
+31 SET DIR("A")="Would you like to edit it?"
+32 SET DIR("B")="N"
+33 SET DIR(0)="Y"
+34 DO ^DIR
KILL DIR
+35 IF +Y>0
Begin DoDot:1
+36 KILL X,Y
+37 SET DIR("A")=ABMMSG
+38 SET DIR(0)="F^0:70"
+39 DO ^DIR
KILL DIR
+40 IF '$DATA(DIROUT)
IF '$DATA(DUOUT)
IF '$DATA(DTOUT)
IF '$DATA(DIRUT)
SET ABMMSG=$GET(X)
End DoDot:1
+41 ;
+42 SET ABMY(ABMP("BDFN"))=ABMMSG
+43 GOTO SEL
+44 ;
ZIS ;
+1 WRITE !!?15,"(NOTE: "
+2 WRITE "Plain Paper needs"
+3 WRITE " to be loaded in the printer.)"
+4 WRITE !!
+5 SET %ZIS("A")="Output DEVICE: "
+6 SET %ZIS="PQ"
+7 DO ^%ZIS
+8 IF POP
GOTO XIT
+9 IF IO'=IO(0)
IF IOT'="HFS"
Begin DoDot:1
+10 DO QUE2
+11 DO HOME^%ZIS
End DoDot:1
QUIT
+12 USE IO(0)
+13 IF '$DATA(IO("S"))
WRITE !!,"Printing..."
+14 USE IO
+15 GOTO ENT
+16 ;
QUE2 ;
+1 IF IO=IO(0)
WRITE !,"Cannot Queue to Screen or Slave Printer!",!
GOTO ZIS
+2 SET ZTRTN="TSK^ABMPSTRD"
+3 SET ZTDESC="3P Re-Print of Selective Bill."
+4 FOR ABM="ZTRTN","ZTDESC","ABMP(","ABMY("
SET ZTSAVE(ABM)=""
+5 DO ^%ZTLOAD
+6 IF $DATA(ZTSK)
WRITE !,"(Job Queued, Task Number: ",ZTSK,")"
+7 GOTO OUT
+8 ;
TSK ; Taskman Entry Point
+1 SET ABMP("Q")=""
+2 ;
ENT ;
+1 IF '$DATA(ABMY("DT"))
Begin DoDot:1
+2 SET ABMY=0
+3 FOR
SET ABMY=$ORDER(ABMY(ABMY))
IF 'ABMY
QUIT
Begin DoDot:2
+4 SET ABMP("BDFN")=ABMY
+5 DO STMTS
End DoDot:2
End DoDot:1
GOTO OUT
+6 SET ABMYDT=$GET(ABMY("DT",1))-.5
+7 FOR
SET ABMYDT=$ORDER(^ABMDBILL(DUZ(2),"AP",ABMYDT))
IF 'ABMYDT!(ABMYDT>ABMY("DT",2))
QUIT
Begin DoDot:1
+8 SET ABMP("BDFN")=0
+9 FOR
SET ABMP("BDFN")=$ORDER(^ABMDBILL(DUZ(2),"AP",ABMYDT,ABMP("BDFN")))
IF 'ABMP("BDFN")
QUIT
Begin DoDot:2
+10 ; Quit if bill status is Reviewed, Approved, or Cancelled
+11 IF "RAX"[$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,4)
QUIT
+12 ;if approving official selected and not a match
+13 IF $DATA(ABMY("AOFF"))
IF $ORDER(ABMY("AOFF",0))'=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,4)
QUIT
+14 ;manually created bill
IF $GET(^ABMDCLM(DUZ(2),+$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U),0))=""
QUIT
+15 SET ABMP("PDFN")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5)
+16 KILL ABMISNB,ABMBEN
+17 DO COVRG^ABMPTSMT
+18 ;don't print statements for bens when batching
IF $GET(ABMBEN)=1
QUIT
+19 ;has completed insurer; don't print when batching
IF ABMBILLD=1
QUIT
+20 IF +$ORDER(ABML(0))'=0
SET ABMY(ABMP("BDFN"))="Your insurance has been billed"
+21 DO STMTS
End DoDot:2
End DoDot:1
+22 GOTO OUT
+23 ;
STMTS ; Reprint Statements
+1 KILL ABMP("PAYED")
+2 DO @("^ABMPTSMT")
+3 QUIT
+4 ;
OUT ;
+1 DO ^%ZISC
+2 ;
XIT ;
+1 KILL ABMP,ABMY,DIQ
+2 QUIT
