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

ABMDFRDO.m

Go to the documentation of this file. 
  1. ABMDFRDO ; IHS/ASDST/DMJ - Re-Print Selected Bills ;    
  1.  ;;2.6;IHS Third Party Billing System;**2,4,11,13**;NOV 12, 2009;Build 213
  1.  ;Original;TMD;02/21/96 12:13 PM
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p8 - IM14693/IM16105
  1.  ;    Added code to use ADA-2002 for 837D when printing
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p11 - NPI
  1.  ; IHS/SD/SDR - abm*2.6*2 - FIXPMS10006 - added prompt for DATE to use when reprinting
  1.  ;IHS/SD/SDR - 2.6*13 - Added check for new export mode 35; Updated check to look for HCFA or CMS in the
  1.  ;  export name.
  1.  ;
  1.  K ABMY,ABMP
  1.  S ABMP("XMIT")=0
  1.  S ABMY("TOT")="0^0^0"
  1.  W !!,"Re-Print Bills for:"
  1.  K DIR
  1.  S DIR(0)="SO^1:SELECTIVE BILL(S);2:ALL BILLS FOR AN EXPORT BATCH;3:UNPAID BILLS"
  1.  S DIR("A")="Select Desired Option"
  1.  D ^DIR
  1.  K DIR
  1.  G XIT:$D(DIRUT)!$D(DIROUT),SEL:Y=1,UNPD:Y=3
  1.  ;
  1. BATCH ;
  1.  W !
  1.  K DIC
  1.  S DIC="^ABMDTXST(DUZ(2),"
  1.  S DIC(0)="AEMQ"
  1.  S DIC("A")="Select EXPORT BATCH (Date): "
  1.  D ^DIC
  1.  K DIC("A")
  1.  G XIT:X=""!$D(DTOUT)!$D(DUOUT),BATCH:+Y<1
  1.  S (ABMY("BATCH"),ABMP("XMIT"))=+Y
  1.  I $P(^ABMDTXST(DUZ(2),+Y,0),U,2) S ABMY("FORM")=$P(^(0),U,2)_U_$P($G(^ABMDEXP($P(^(0),U,2),0)),U)
  1.  E  S ABMY("FORM")=$S($P(^ABMDTXST(DUZ(2),ABMY("BATCH"),0),U,2)="U":1,1:2)_U_$S($P(^(0),U,2)="U":"UB-82",1:"HCFA-1500A")
  1.  G ZIS
  1.  ;
  1. SEL ;
  1.  W !!
  1.  K DIC
  1.  S DIC="^ABMDBILL(DUZ(2),"
  1.  S DIC(0)="QZEAM"
  1.  S ABMY=$G(ABMY)+1
  1.  S ABM("E")=$E(ABMY,$L(ABMY))
  1.  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: "
  1.  S DIC("S")="I $P(^(0),U)'=+^(0),""BTCP""[$P(^(0),""^"",4),$P(^(0),""^"",6)"
  1.  S:ABMY>1 DIC("S")=DIC("S")_",$P(ABMY(""FORM""),""^"",1)[$P(^(0),""^"",6)"
  1.  D BENT^ABMDBDIC
  1.  G XIT:$D(DUOUT)!$D(DTOUT)
  1.  I '$G(ABMP("BDFN")) G ZIS:ABMY>1,XIT
  1.  D CKMULT
  1.  I '$G(ABMP("BDFN")) S ABMY=ABMY-1 G SEL
  1.  S ABMY(ABMP("BDFN"))=""
  1.  G SEL:ABMY>1
  1.  S ABMY("EXP")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6)
  1.  S ABMY("FORM")=ABMY("EXP")_"^"_$P($G(^ABMDEXP(ABMY("EXP"),0)),U)
  1.  G SEL
  1.  ;
  1. UNPD ;UN-PAID BILLS
  1.  D ^ABMDBRUN
  1.  S ABMY("TOT")="0^0^0"
  1.  W !!,"For the parameters specified, the"
  1.  W !,"           Number of Bills to Reprint: ",ABMP("CNT")
  1.  I '$O(ABMY(0)) W *7 G XIT
  1.  ;
  1. ZIS ;EP
  1.  I '$G(ABMY("EXP")) S ABMY("EXP")=+ABMY("FORM")
  1.  I $P($G(^ABMDEXP(ABMY("EXP"),1)),"^",5)="E" D
  1.  .K DIC,DIE,DIR,X,Y
  1.  .S DIR("A")="**Use the following export mode: "
  1.  .;I $P(ABMY("FORM"),U,2)["HCFA" D  ;abm*2.6*13 exp mode 35
  1.  .I $P(ABMY("FORM"),U,2)["HCFA"!($P(ABMY("FORM"),U,2)["CMS") D  ;abm*2.6*13 exp mode 35
  1.  ..;start old code abm*2.6*13 export mode 35
  1.  ..;S DIR("B")="1500 (08/05)"
  1.  ..;S DIR(0)="S^3:1500 B;14:1500 Y2K;27:1500 (08/05)"
  1.  ..;end old start new export mode 35
  1.  ..S DIR("B")="1500 (02/12)"
  1.  ..S DIR(0)="S^27:1500 (08/05);35:1500 (02/12)"
  1.  ..;end new export mode 35
  1.  .I $P(ABMY("FORM"),U,2)["UB" D
  1.  ..S DIR("B")="UB-04"
  1.  ..S DIR(0)="S^11:UB-92;28:UB-04"
  1.  .I $P(ABMY("FORM"),U,2)["ADA" D
  1.  ..;start old code abm*2.6*11 new ADA form
  1.  ..;S DIR("B")="ADA-2006"
  1.  ..;S DIR(0)="S^25:ADA-2002;29:ADA-2006"
  1.  ..;end old code start new code
  1.  ..S DIR("B")="ADA-2012"
  1.  ..S DIR(0)="S^25:ADA-2002;29:ADA-2006;34:ADA-2012"
  1.  ..;end new code
  1.  .D ^DIR K DIR
  1.  .;I $P(ABMY("FORM"),U,2)["HCFA" S ABMY("FORM")=$S(Y=3:"3^HCFA-1500B",Y=14:"14^HCFA-1500 Y2K",1:"27^HCFA 1500 (08/05)")  ;abm*2.6*13 export mode 35
  1.  .I $P(ABMY("FORM"),U,2)["HCFA" S ABMY("FORM")=$S(Y=27:"27^HCFA 1500 (08/05)",1:"35^HCFA 1500 (02/12)")  ;abm*2.6*13 export mode 35
  1.  .I $P(ABMY("FORM"),U,2)["UB" S ABMY("FORM")=$S(Y=11:"11^UB-92",1:"28^UB-04")
  1.  .;I $P(ABMY("FORM"),U,2)["ADA" S ABMY("FORM")=$S(Y=25:"25^ADA-2002",1:"29^ADA-2012")  ;abm*2.6*11 new ADA form
  1.  .I $P(ABMY("FORM"),U,2)["ADA" S ABMY("FORM")=$S(Y=25:"25^ADA-2002",Y=29:"29^ADA-2006",1:"34^ADA-2012")  ;abm*2.6*11 new ADA form I +ABMY("FORM")=2,$P($G(^ABMDPARM(DUZ(2),1,2)),9)=2 D  G XIT:$D(DIRUT)
  1.  .;start old code abm*2.6*11
  1.  .;W !!,"Forms Previously Printed on Old HCFA-1500.",!!
  1.  .;K DIR
  1.  .;S DIR(0)="Y"
  1.  .;S DIR("B")="Y"
  1.  .;S DIR("A")="Want to print the New Version of the HCFA-1500 (Y/N)"
  1.  .;D ^DIR
  1.  .;I Y S ABMY("FORM")=3_U_$P(^ABMDEXP(3,0),U)
  1.  ;end old code
  1.  S ABMP("EXP")=+ABMY("FORM")
  1.  ;start new code abm*2.6*2 FIXPMS10006
  1.  D ^XBFMK
  1.  ;S DIR(0)="S^T:TODAY'S DATE;O:ORIGINAL PRINT DATE"  ;abm*2.6*11 HEAT81561
  1.  S DIR(0)="S^T:TODAY'S DATE;O:ORIGINAL PRINT DATE;A:APPROVAL DATE"  ;abm*2.6*11 HEAT81561
  1.  S DIR("A")="Reprint using which date"
  1.  S DIR("B")="TODAY"
  1.  D ^DIR K DIR
  1.  ;S ABMPDT=Y  ;abm*2.6*4 HEAT17615
  1.  S ABMP("PRINTDT")=Y  ;abm*2.6*4 HEAT17615
  1.  ;end new code FIXPMS10006
  1.  W !!?15,"(NOTE: "
  1.  I $P($G(^ABMDEXP(ABMP("EXP"),1)),U,4) W "Plain Paper needs"
  1.  E  W $P(ABMY("FORM"),U,2)," forms need"
  1.  W " to be loaded in the printer.)"
  1.  W !!
  1.  S %ZIS("A")="Output DEVICE: "
  1.  S %ZIS="PQ"
  1.  D ^%ZIS
  1.  G XIT:POP
  1.  I IO'=IO(0),IOT'="HFS" D  Q
  1.  .D QUE2
  1.  .D HOME^%ZIS
  1.  U IO(0)
  1.  W:'$D(IO("S")) !!,"Printing..."
  1.  U IO
  1.  G ENT
  1.  ;
  1. QUE2 ;
  1.  I IO=IO(0) W !,"Cannot Queue to Screen or Slave Printer!",! G ZIS
  1.  S ZTRTN="TSK^ABMDFRDO"
  1.  S ZTDESC="3P Re-Print of Selective Bill."
  1.  F ABM="ZTRTN","ZTDESC","ABMP(","ABMY(" S ZTSAVE(ABM)=""
  1.  D ^%ZTLOAD
  1.  I $D(ZTSK) W !,"(Job Queued, Task Number: ",ZTSK,")"
  1.  G OUT
  1.  ;
  1. TSK ; Taskman Entry Point
  1.  S ABMP("Q")=""
  1.  ;
  1. ENT ;
  1.  I '$D(ABMY("BATCH")) D  G OUT
  1.  .S ABMY=0
  1.  .F  S ABMY=$O(ABMY(ABMY)) Q:'ABMY  D
  1.  ..S ABMP("BDFN")=ABMY
  1.  ..D FORMS
  1.  S ABMY=0
  1.  F  S ABMY=$O(^ABMDBILL(DUZ(2),"AX",ABMY("BATCH"),ABMY)) Q:'ABMY  D
  1.  .; Quit if bill status is Reviewed, Approved, or Cancelled
  1.  .Q:"RAX"[$P($G(^ABMDBILL(DUZ(2),ABMY,0)),U,4)
  1.  .S ABMP("BDFN")=ABMY
  1.  .D FORMS
  1.  G OUT
  1.  ;
  1. FORMS ; Reprint Forms
  1.  K ABMP("PAYED")
  1.  I ABMP("EXP")>2 D @("ENT^ABMDF"_+ABMY("FORM")) Q
  1.  ;
  1. UB82 ;
  1.  I +ABMY("FORM")=1 D  Q
  1.  .D ENT^ABMDF1,^ABMDF1X
  1.  .D:$D(ABMR)=10 UB82^ABMDF1
  1.  ;
  1. HCFA ;
  1.  D ENT^ABMDF2
  1.  I +$O(ABMR("")) S ABMR("MORE")=""
  1.  D ^ABMDF2X
  1.  D:+$O(ABMR("")) HCFA^ABMDF2
  1.  Q
  1.  ;
  1. OUT ;
  1.  D ^%ZISC
  1.  ;
  1. XIT ;
  1.  D WTOT^ABMDFUTL:$G(ABMY("TOT"))
  1.  K ABMP,ABMY,DIQ
  1.  Q
  1.  ;
  1. CKMULT ; check if form is used for multiple bills  
  1.  I $P($G(^ABMDEXP($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6),1)),U,3) D
  1.  .W !!,*7,"Bill Number "
  1.  .W $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
  1.  .W " was exported on a "
  1.  .W $P(^ABMDEXP($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6),0),U)
  1.  .W " form. Since this form may"
  1.  .W !,"include multiple bills, a single bill can not be individually reprinted."
  1.  .W !,"Thus, to reprint the bill you must reprint the entire export batch."
  1.  .K ABMP("BDFN")
  1.  Q