| 1 | IBCEMCA3 ;ALB/ESG - Multiple CSA Message Management - Actions ;20-SEP-2005
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**320,349**;21-MAR-1994;Build 46
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | PRINT ; resubmit by print
|
|---|
| 8 | NEW DFN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FC,FORM,IB0,IB364,IBDA,IBFT,IBFTP
|
|---|
| 9 | NEW IBH,IBIFN,IBJ,IBMCSPNT,IBQUIT,IBS,IBS1,IBS2,IBS3,IBTASK,IBX,IBXP,IBY,IBZ
|
|---|
| 10 | NEW INS,NS,NSC,PATNAME,PAYER,X,Y,ZIP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
|
|---|
| 11 | D FULL^VALM1
|
|---|
| 12 | ;
|
|---|
| 13 | S NS=+$G(^TMP($J,"IBCEMCL",4))
|
|---|
| 14 | I 'NS D G PRINTX
|
|---|
| 15 | . W !!?5,"There are no selected messages." D PAUSE^VALM1
|
|---|
| 16 | . Q
|
|---|
| 17 | ;
|
|---|
| 18 | ; count number of claims too
|
|---|
| 19 | S IBIFN=0 F NSC=0:1 S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN
|
|---|
| 20 | ;
|
|---|
| 21 | W !!?5,"Number of messages selected: ",NS
|
|---|
| 22 | W !?7,"Number of claims selected: ",NSC
|
|---|
| 23 | ;
|
|---|
| 24 | ; check certain form types for a default printer
|
|---|
| 25 | K FC S FC=0
|
|---|
| 26 | F FORM=2,3,6 D
|
|---|
| 27 | . N X S X=$G(^IBE(353,FORM,0))
|
|---|
| 28 | . I $P(X,U,2)'="" Q ; billing printer defined
|
|---|
| 29 | . S FC=FC+1,FC($P(X,U,1)_" ")=""
|
|---|
| 30 | . Q
|
|---|
| 31 | I FC D I IBQUIT G PRINTX
|
|---|
| 32 | . N NM
|
|---|
| 33 | . S IBQUIT=0
|
|---|
| 34 | . W !!,*7,"Warning! The default billing printer is missing for the following form type",$S(FC>1:"s",1:""),":",!
|
|---|
| 35 | . S NM="" F S NM=$O(FC(NM)) Q:NM="" W !?4,NM
|
|---|
| 36 | . W !!,"Nothing will print for ",$S(FC>1:"these form types",1:"this form type"),". Printers are maintained in the option"
|
|---|
| 37 | . W !,"'Select Default Device for Forms' on the System Manager's IB Menu."
|
|---|
| 38 | . W ! S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="No"
|
|---|
| 39 | . D ^DIR K DIR
|
|---|
| 40 | . I 'Y S IBQUIT=1 ; No, don't continue quit out
|
|---|
| 41 | . Q
|
|---|
| 42 | ;
|
|---|
| 43 | ; Ask the user for the 3 sort levels
|
|---|
| 44 | W !
|
|---|
| 45 | S IBS=""
|
|---|
| 46 | S IBZ="Z:ZIP;I:INSURANCE COMPANY NAME;P:PATIENT NAME;"
|
|---|
| 47 | S IBH="This Resubmit by Print action attempts to print all selected claims in the order requested. The printed claims may be sorted by: Zip Code, Insurance Company Name, and Patient name."
|
|---|
| 48 | S DIR("?")=IBH
|
|---|
| 49 | S DIR("A")="First Sort Claims By"
|
|---|
| 50 | S DIR(0)="SB^"_IBZ
|
|---|
| 51 | D ^DIR K DIR I $D(DIRUT) G PRINTX ; primary sort
|
|---|
| 52 | S IBS=IBS_$S(Y="Z":1,Y="I":2,Y="P":3,1:0)
|
|---|
| 53 | S IBX=$P($P(IBZ,Y_":",2),";",1)
|
|---|
| 54 | ;
|
|---|
| 55 | S DIR("?")=IBH
|
|---|
| 56 | S DIR("?",1)="Enter the field that the claims should be sorted on within "_IBX_"."
|
|---|
| 57 | S DIR("?",2)="Press return if the order already entered is sufficient."
|
|---|
| 58 | S DIR("?",3)=""
|
|---|
| 59 | S DIR("A")="Then Sort Claims By"
|
|---|
| 60 | S DIR(0)="SOB^"_IBZ
|
|---|
| 61 | D ^DIR K DIR I Y'="",$D(DIRUT) G PRINTX ; secondary sort
|
|---|
| 62 | S IBS=IBS_$S(Y="Z":1,Y="I":2,Y="P":3,1:0)
|
|---|
| 63 | I Y="" G P1
|
|---|
| 64 | S IBY=$P($P(IBZ,Y_":",2),";",1)
|
|---|
| 65 | ;
|
|---|
| 66 | S DIR("?")=IBH
|
|---|
| 67 | S DIR("?",1)="Enter the field that the claims should be sorted on within "_IBX_" and "_IBY_"."
|
|---|
| 68 | S DIR("?",2)="Press return if the order already entered is sufficient."
|
|---|
| 69 | S DIR("?",3)=""
|
|---|
| 70 | S DIR("A")="Then Sort Claims By"
|
|---|
| 71 | S DIR(0)="SOB^"_IBZ
|
|---|
| 72 | D ^DIR K DIR I Y'="",$D(DIRUT) G PRINTX ; tertiary sort
|
|---|
| 73 | S IBS=IBS_$S(Y="Z":1,Y="I":2,Y="P":3,1:0)
|
|---|
| 74 | ;
|
|---|
| 75 | P1 ;
|
|---|
| 76 | ;
|
|---|
| 77 | W !
|
|---|
| 78 | S DIR(0)="S^2:2nd Notice;3:3rd Notice;C:Copy;O:Original"
|
|---|
| 79 | S DIR("A")="(2)nd Notice, (3)rd Notice, (C)opy or (O)riginal"
|
|---|
| 80 | S DIR("B")="C"
|
|---|
| 81 | D ^DIR K DIR
|
|---|
| 82 | I $D(DIRUT) G PRINTX
|
|---|
| 83 | I Y="C" S Y=0 ; copy
|
|---|
| 84 | I Y="O" S Y=1 ; original
|
|---|
| 85 | S IBMCSPNT=Y
|
|---|
| 86 | ;
|
|---|
| 87 | W !!,"Note: Any selected claims in a REQUEST MRA status will not be printed."
|
|---|
| 88 | W !
|
|---|
| 89 | S DIR(0)="Y"
|
|---|
| 90 | S DIR("A")="OK to begin printing claims"
|
|---|
| 91 | S DIR("B")="No"
|
|---|
| 92 | S DIR("?",1)=" Enter YES to immediately begin printing the selected claims."
|
|---|
| 93 | S DIR("?")=" Enter NO to quit this option."
|
|---|
| 94 | D ^DIR K DIR
|
|---|
| 95 | I 'Y G PRINTX
|
|---|
| 96 | ;
|
|---|
| 97 | ; kill ^XTMP scratch global
|
|---|
| 98 | S IBX="IBCFP" F S IBX=$O(^XTMP(IBX)) Q:IBX'?1"IBCFP"1.N K ^XTMP(IBX,$J)
|
|---|
| 99 | S IBXP=$$FMADD^XLFDT(DT,1)_U_DT_U_"MCS BATCH PRINT BILLS "_$$HTE^XLFDT($H)_" by "_$S($D(^VA(200,+$G(DUZ),0)):$P(^(0),"^"),1:"Unknown User")
|
|---|
| 100 | ;
|
|---|
| 101 | ; Loop thru selected claims, queue them and print them
|
|---|
| 102 | S IBIFN=0
|
|---|
| 103 | F S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN D
|
|---|
| 104 | . S IBFT=$$FT^IBCEF(IBIFN) ; form type of claim
|
|---|
| 105 | . I $P($G(^IBE(353,IBFT,0)),U,2)="" Q ; no printer defined
|
|---|
| 106 | . S IB0=$G(^DGCR(399,IBIFN,0))
|
|---|
| 107 | . I $P(IB0,U,13)=2 Q ; don't include MRA requests here
|
|---|
| 108 | . S DFN=+$P(IB0,U,2)
|
|---|
| 109 | . S PATNAME=$P($G(^DPT(DFN,0)),U,1)
|
|---|
| 110 | . S ZIP=$P($G(^DGCR(399,IBIFN,"M")),U,9) ; field 109 - curr ins zip
|
|---|
| 111 | . ; payer
|
|---|
| 112 | . S INS=+$P($G(^DGCR(399,IBIFN,"MP")),U,1)
|
|---|
| 113 | . I 'INS S INS=+$$CURR^IBCEF2(IBIFN)
|
|---|
| 114 | . S PAYER=$P($G(^DIC(36,INS,0)),U,1)
|
|---|
| 115 | . ;
|
|---|
| 116 | . S IBX=ZIP_U_PAYER_U_PATNAME
|
|---|
| 117 | . S IBS1=$P(IBX,U,$E(IBS,1))_" " ; primary sort data
|
|---|
| 118 | . S IBS2=$P(IBX,U,$E(IBS,2))_" " ; secondary sort data
|
|---|
| 119 | . S IBS3=$P(IBX,U,$E(IBS,3))_" " ; tertiary sort data
|
|---|
| 120 | . ;
|
|---|
| 121 | . S ^XTMP("IBCFP"_IBFT,$J,IBS1,IBS2,IBS3,IBIFN)=""
|
|---|
| 122 | . S ^XTMP("IBCFP"_IBFT,0)=IBXP
|
|---|
| 123 | . S IBDA=0
|
|---|
| 124 | . F S IBDA=$O(^TMP($J,"IBCEMCL",4,2,IBIFN,IBDA)) Q:'IBDA D
|
|---|
| 125 | .. N DIE,DA,DR,TXT
|
|---|
| 126 | .. S DIE=361,DA=IBDA,DR=".16////"_DT D ^DIE
|
|---|
| 127 | .. S TXT(1)="Claim queued for printing by the MCS - 'Resubmit by Print' action",TXT=1
|
|---|
| 128 | .. D NOTECHG^IBCECSA2(IBDA,0,.TXT,1)
|
|---|
| 129 | .. Q
|
|---|
| 130 | . ;
|
|---|
| 131 | . ; if this is an MRA secondary claim and MRA's are on file and
|
|---|
| 132 | . ; there is a printer defined for MRAs, then include them too
|
|---|
| 133 | . I $$MRAEXIST^IBCEMU1(IBIFN),$P($G(^IBE(353,6,0)),U,2)'="" D
|
|---|
| 134 | .. S ^XTMP("IBCFP6",$J,IBS1,IBS2,IBS3,IBIFN)=""
|
|---|
| 135 | .. S ^XTMP("IBCFP6",0)=IBXP
|
|---|
| 136 | .. Q
|
|---|
| 137 | . ;
|
|---|
| 138 | . ; if the claim's form type is a CMS-1500 and there is a printer
|
|---|
| 139 | . ; defined for Bill Addendums, then include them too
|
|---|
| 140 | . I IBFT=2,$P($G(^IBE(353,4,0)),U,2)'="" D
|
|---|
| 141 | .. S ^XTMP("IBCFP4",$J,IBS1,IBS2,IBS3,IBIFN)=""
|
|---|
| 142 | .. S ^XTMP("IBCFP4",0)=IBXP
|
|---|
| 143 | .. Q
|
|---|
| 144 | . ;
|
|---|
| 145 | . Q
|
|---|
| 146 | ;
|
|---|
| 147 | ; loop thru the ^XTMP scatch global and queue off form type job
|
|---|
| 148 | S IBX="IBCFP" K IBTASK
|
|---|
| 149 | F S IBX=$O(^XTMP(IBX)) Q:IBX'?1"IBCFP"1.N D
|
|---|
| 150 | . I '$D(^XTMP(IBX,$J)) Q
|
|---|
| 151 | . S IBFT=+$E(IBX,6,99)
|
|---|
| 152 | . S ZTIO=$P($G(^IBE(353,IBFT,0)),U,2) ; printer
|
|---|
| 153 | . S IBFTP=IBX ; 1st subscript
|
|---|
| 154 | . S IBJ=$J ; 2nd subscript
|
|---|
| 155 | . S ZTDTH=$H
|
|---|
| 156 | . S ZTSAVE("IBFTP")=""
|
|---|
| 157 | . S ZTSAVE("IBFT")=""
|
|---|
| 158 | . S ZTSAVE("IBJ")=""
|
|---|
| 159 | . S ZTSAVE("IBMCSPNT")=""
|
|---|
| 160 | . S ZTDESC="MCS BATCH PRINTING "_$$FTN^IBCU3(IBFT)
|
|---|
| 161 | . S ZTRTN="QBILL^IBCFP1"
|
|---|
| 162 | . I IBFT=6 S ZTRTN="QMRA^IBCEMU2" ; MRA print rtn
|
|---|
| 163 | . D ^%ZTLOAD
|
|---|
| 164 | . S IBTASK(IBFT)=+$G(ZTSK)
|
|---|
| 165 | . Q
|
|---|
| 166 | ;
|
|---|
| 167 | ; Display the queued task#'s
|
|---|
| 168 | I '$D(IBTASK) W !!?5,"Nothing was printed"
|
|---|
| 169 | I $D(IBTASK) D
|
|---|
| 170 | . W !
|
|---|
| 171 | . S IBFT=0 F S IBFT=$O(IBTASK(IBFT)) Q:'IBFT D
|
|---|
| 172 | .. W !,$J($$FTN^IBCU3(IBFT),15)," form type printing started with TaskMan task# ",IBTASK(IBFT),"."
|
|---|
| 173 | .. Q
|
|---|
| 174 | . ;
|
|---|
| 175 | . W !!?1,"Please Note: These EDI status messages will be removed from the CSA screen"
|
|---|
| 176 | . W !?15,"and the MCS screen once it has been confirmed that these claims"
|
|---|
| 177 | . W !?15,"have been successfully printed."
|
|---|
| 178 | . Q
|
|---|
| 179 | ;
|
|---|
| 180 | D PAUSE^VALM1
|
|---|
| 181 | ;
|
|---|
| 182 | ; rebuild the list
|
|---|
| 183 | KILL ^TMP($J,"IBCEMCA"),VALMHDR
|
|---|
| 184 | S VALMBG=1
|
|---|
| 185 | D UNLOCK^IBCEMCL
|
|---|
| 186 | D INIT^IBCEMCL
|
|---|
| 187 | I $G(IBCSAMCS)=1 S IBCSAMCS=2 ; flag to rebuild CSA
|
|---|
| 188 | ;
|
|---|
| 189 | PRINTX ;
|
|---|
| 190 | S VALMBCK="R"
|
|---|
| 191 | Q
|
|---|
| 192 | ;
|
|---|
