- 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
