IBCEMCA3 ;ALB/ESG - Multiple CSA Message Management - Actions ;20-SEP-2005
;;2.0;INTEGRATED BILLING;**320,349**;21-MAR-1994;Build 46
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
PRINT ; resubmit by print
NEW DFN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FC,FORM,IB0,IB364,IBDA,IBFT,IBFTP
NEW IBH,IBIFN,IBJ,IBMCSPNT,IBQUIT,IBS,IBS1,IBS2,IBS3,IBTASK,IBX,IBXP,IBY,IBZ
NEW INS,NS,NSC,PATNAME,PAYER,X,Y,ZIP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
D FULL^VALM1
;
S NS=+$G(^TMP($J,"IBCEMCL",4))
I 'NS D G PRINTX
. W !!?5,"There are no selected messages." D PAUSE^VALM1
. Q
;
; count number of claims too
S IBIFN=0 F NSC=0:1 S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN
;
W !!?5,"Number of messages selected: ",NS
W !?7,"Number of claims selected: ",NSC
;
; check certain form types for a default printer
K FC S FC=0
F FORM=2,3,6 D
. N X S X=$G(^IBE(353,FORM,0))
. I $P(X,U,2)'="" Q ; billing printer defined
. S FC=FC+1,FC($P(X,U,1)_" ")=""
. Q
I FC D I IBQUIT G PRINTX
. N NM
. S IBQUIT=0
. W !!,*7,"Warning! The default billing printer is missing for the following form type",$S(FC>1:"s",1:""),":",!
. S NM="" F S NM=$O(FC(NM)) Q:NM="" W !?4,NM
. W !!,"Nothing will print for ",$S(FC>1:"these form types",1:"this form type"),". Printers are maintained in the option"
. W !,"'Select Default Device for Forms' on the System Manager's IB Menu."
. W ! S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="No"
. D ^DIR K DIR
. I 'Y S IBQUIT=1 ; No, don't continue quit out
. Q
;
; Ask the user for the 3 sort levels
W !
S IBS=""
S IBZ="Z:ZIP;I:INSURANCE COMPANY NAME;P:PATIENT NAME;"
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."
S DIR("?")=IBH
S DIR("A")="First Sort Claims By"
S DIR(0)="SB^"_IBZ
D ^DIR K DIR I $D(DIRUT) G PRINTX ; primary sort
S IBS=IBS_$S(Y="Z":1,Y="I":2,Y="P":3,1:0)
S IBX=$P($P(IBZ,Y_":",2),";",1)
;
S DIR("?")=IBH
S DIR("?",1)="Enter the field that the claims should be sorted on within "_IBX_"."
S DIR("?",2)="Press return if the order already entered is sufficient."
S DIR("?",3)=""
S DIR("A")="Then Sort Claims By"
S DIR(0)="SOB^"_IBZ
D ^DIR K DIR I Y'="",$D(DIRUT) G PRINTX ; secondary sort
S IBS=IBS_$S(Y="Z":1,Y="I":2,Y="P":3,1:0)
I Y="" G P1
S IBY=$P($P(IBZ,Y_":",2),";",1)
;
S DIR("?")=IBH
S DIR("?",1)="Enter the field that the claims should be sorted on within "_IBX_" and "_IBY_"."
S DIR("?",2)="Press return if the order already entered is sufficient."
S DIR("?",3)=""
S DIR("A")="Then Sort Claims By"
S DIR(0)="SOB^"_IBZ
D ^DIR K DIR I Y'="",$D(DIRUT) G PRINTX ; tertiary sort
S IBS=IBS_$S(Y="Z":1,Y="I":2,Y="P":3,1:0)
;
P1 ;
;
W !
S DIR(0)="S^2:2nd Notice;3:3rd Notice;C:Copy;O:Original"
S DIR("A")="(2)nd Notice, (3)rd Notice, (C)opy or (O)riginal"
S DIR("B")="C"
D ^DIR K DIR
I $D(DIRUT) G PRINTX
I Y="C" S Y=0 ; copy
I Y="O" S Y=1 ; original
S IBMCSPNT=Y
;
W !!,"Note: Any selected claims in a REQUEST MRA status will not be printed."
W !
S DIR(0)="Y"
S DIR("A")="OK to begin printing claims"
S DIR("B")="No"
S DIR("?",1)=" Enter YES to immediately begin printing the selected claims."
S DIR("?")=" Enter NO to quit this option."
D ^DIR K DIR
I 'Y G PRINTX
;
; kill ^XTMP scratch global
S IBX="IBCFP" F S IBX=$O(^XTMP(IBX)) Q:IBX'?1"IBCFP"1.N K ^XTMP(IBX,$J)
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")
;
; Loop thru selected claims, queue them and print them
S IBIFN=0
F S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN D
. S IBFT=$$FT^IBCEF(IBIFN) ; form type of claim
. I $P($G(^IBE(353,IBFT,0)),U,2)="" Q ; no printer defined
. S IB0=$G(^DGCR(399,IBIFN,0))
. I $P(IB0,U,13)=2 Q ; don't include MRA requests here
. S DFN=+$P(IB0,U,2)
. S PATNAME=$P($G(^DPT(DFN,0)),U,1)
. S ZIP=$P($G(^DGCR(399,IBIFN,"M")),U,9) ; field 109 - curr ins zip
. ; payer
. S INS=+$P($G(^DGCR(399,IBIFN,"MP")),U,1)
. I 'INS S INS=+$$CURR^IBCEF2(IBIFN)
. S PAYER=$P($G(^DIC(36,INS,0)),U,1)
. ;
. S IBX=ZIP_U_PAYER_U_PATNAME
. S IBS1=$P(IBX,U,$E(IBS,1))_" " ; primary sort data
. S IBS2=$P(IBX,U,$E(IBS,2))_" " ; secondary sort data
. S IBS3=$P(IBX,U,$E(IBS,3))_" " ; tertiary sort data
. ;
. S ^XTMP("IBCFP"_IBFT,$J,IBS1,IBS2,IBS3,IBIFN)=""
. S ^XTMP("IBCFP"_IBFT,0)=IBXP
. S IBDA=0
. F S IBDA=$O(^TMP($J,"IBCEMCL",4,2,IBIFN,IBDA)) Q:'IBDA D
.. N DIE,DA,DR,TXT
.. S DIE=361,DA=IBDA,DR=".16////"_DT D ^DIE
.. S TXT(1)="Claim queued for printing by the MCS - 'Resubmit by Print' action",TXT=1
.. D NOTECHG^IBCECSA2(IBDA,0,.TXT,1)
.. Q
. ;
. ; if this is an MRA secondary claim and MRA's are on file and
. ; there is a printer defined for MRAs, then include them too
. I $$MRAEXIST^IBCEMU1(IBIFN),$P($G(^IBE(353,6,0)),U,2)'="" D
.. S ^XTMP("IBCFP6",$J,IBS1,IBS2,IBS3,IBIFN)=""
.. S ^XTMP("IBCFP6",0)=IBXP
.. Q
. ;
. ; if the claim's form type is a CMS-1500 and there is a printer
. ; defined for Bill Addendums, then include them too
. I IBFT=2,$P($G(^IBE(353,4,0)),U,2)'="" D
.. S ^XTMP("IBCFP4",$J,IBS1,IBS2,IBS3,IBIFN)=""
.. S ^XTMP("IBCFP4",0)=IBXP
.. Q
. ;
. Q
;
; loop thru the ^XTMP scatch global and queue off form type job
S IBX="IBCFP" K IBTASK
F S IBX=$O(^XTMP(IBX)) Q:IBX'?1"IBCFP"1.N D
. I '$D(^XTMP(IBX,$J)) Q
. S IBFT=+$E(IBX,6,99)
. S ZTIO=$P($G(^IBE(353,IBFT,0)),U,2) ; printer
. S IBFTP=IBX ; 1st subscript
. S IBJ=$J ; 2nd subscript
. S ZTDTH=$H
. S ZTSAVE("IBFTP")=""
. S ZTSAVE("IBFT")=""
. S ZTSAVE("IBJ")=""
. S ZTSAVE("IBMCSPNT")=""
. S ZTDESC="MCS BATCH PRINTING "_$$FTN^IBCU3(IBFT)
. S ZTRTN="QBILL^IBCFP1"
. I IBFT=6 S ZTRTN="QMRA^IBCEMU2" ; MRA print rtn
. D ^%ZTLOAD
. S IBTASK(IBFT)=+$G(ZTSK)
. Q
;
; Display the queued task#'s
I '$D(IBTASK) W !!?5,"Nothing was printed"
I $D(IBTASK) D
. W !
. S IBFT=0 F S IBFT=$O(IBTASK(IBFT)) Q:'IBFT D
.. W !,$J($$FTN^IBCU3(IBFT),15)," form type printing started with TaskMan task# ",IBTASK(IBFT),"."
.. Q
. ;
. W !!?1,"Please Note: These EDI status messages will be removed from the CSA screen"
. W !?15,"and the MCS screen once it has been confirmed that these claims"
. W !?15,"have been successfully printed."
. Q
;
D PAUSE^VALM1
;
; rebuild the list
KILL ^TMP($J,"IBCEMCA"),VALMHDR
S VALMBG=1
D UNLOCK^IBCEMCL
D INIT^IBCEMCL
I $G(IBCSAMCS)=1 S IBCSAMCS=2 ; flag to rebuild CSA
;
PRINTX ;
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMCA3 6883 printed Apr 09, 2024@21:20:06 Page 2
IBCEMCA3 ;ALB/ESG - Multiple CSA Message Management - Actions ;20-SEP-2005
+1 ;;2.0;INTEGRATED BILLING;**320,349**;21-MAR-1994;Build 46
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
PRINT ; resubmit by print
+1 NEW DFN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FC,FORM,IB0,IB364,IBDA,IBFT,IBFTP
+2 NEW IBH,IBIFN,IBJ,IBMCSPNT,IBQUIT,IBS,IBS1,IBS2,IBS3,IBTASK,IBX,IBXP,IBY,IBZ
+3 NEW INS,NS,NSC,PATNAME,PAYER,X,Y,ZIP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+4 DO FULL^VALM1
+5 ;
+6 SET NS=+$GET(^TMP($JOB,"IBCEMCL",4))
+7 IF 'NS
Begin DoDot:1
+8 WRITE !!?5,"There are no selected messages."
DO PAUSE^VALM1
+9 QUIT
End DoDot:1
GOTO PRINTX
+10 ;
+11 ; count number of claims too
+12 SET IBIFN=0
FOR NSC=0:1
SET IBIFN=$ORDER(^TMP($JOB,"IBCEMCL",4,2,IBIFN))
if 'IBIFN
QUIT
+13 ;
+14 WRITE !!?5,"Number of messages selected: ",NS
+15 WRITE !?7,"Number of claims selected: ",NSC
+16 ;
+17 ; check certain form types for a default printer
+18 KILL FC
SET FC=0
+19 FOR FORM=2,3,6
Begin DoDot:1
+20 NEW X
SET X=$GET(^IBE(353,FORM,0))
+21 ; billing printer defined
IF $PIECE(X,U,2)'=""
QUIT
+22 SET FC=FC+1
SET FC($PIECE(X,U,1)_" ")=""
+23 QUIT
End DoDot:1
+24 IF FC
Begin DoDot:1
+25 NEW NM
+26 SET IBQUIT=0
+27 WRITE !!,*7,"Warning! The default billing printer is missing for the following form type",$SELECT(FC>1:"s",1:""),":",!
+28 SET NM=""
FOR
SET NM=$ORDER(FC(NM))
if NM=""
QUIT
WRITE !?4,NM
+29 WRITE !!,"Nothing will print for ",$SELECT(FC>1:"these form types",1:"this form type"),". Printers are maintained in the option"
+30 WRITE !,"'Select Default Device for Forms' on the System Manager's IB Menu."
+31 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="No"
+32 DO ^DIR
KILL DIR
+33 ; No, don't continue quit out
IF 'Y
SET IBQUIT=1
+34 QUIT
End DoDot:1
IF IBQUIT
GOTO PRINTX
+35 ;
+36 ; Ask the user for the 3 sort levels
+37 WRITE !
+38 SET IBS=""
+39 SET IBZ="Z:ZIP;I:INSURANCE COMPANY NAME;P:PATIENT NAME;"
+40 SET 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."
+41 SET DIR("?")=IBH
+42 SET DIR("A")="First Sort Claims By"
+43 SET DIR(0)="SB^"_IBZ
+44 ; primary sort
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO PRINTX
+45 SET IBS=IBS_$SELECT(Y="Z":1,Y="I":2,Y="P":3,1:0)
+46 SET IBX=$PIECE($PIECE(IBZ,Y_":",2),";",1)
+47 ;
+48 SET DIR("?")=IBH
+49 SET DIR("?",1)="Enter the field that the claims should be sorted on within "_IBX_"."
+50 SET DIR("?",2)="Press return if the order already entered is sufficient."
+51 SET DIR("?",3)=""
+52 SET DIR("A")="Then Sort Claims By"
+53 SET DIR(0)="SOB^"_IBZ
+54 ; secondary sort
DO ^DIR
KILL DIR
IF Y'=""
IF $DATA(DIRUT)
GOTO PRINTX
+55 SET IBS=IBS_$SELECT(Y="Z":1,Y="I":2,Y="P":3,1:0)
+56 IF Y=""
GOTO P1
+57 SET IBY=$PIECE($PIECE(IBZ,Y_":",2),";",1)
+58 ;
+59 SET DIR("?")=IBH
+60 SET DIR("?",1)="Enter the field that the claims should be sorted on within "_IBX_" and "_IBY_"."
+61 SET DIR("?",2)="Press return if the order already entered is sufficient."
+62 SET DIR("?",3)=""
+63 SET DIR("A")="Then Sort Claims By"
+64 SET DIR(0)="SOB^"_IBZ
+65 ; tertiary sort
DO ^DIR
KILL DIR
IF Y'=""
IF $DATA(DIRUT)
GOTO PRINTX
+66 SET IBS=IBS_$SELECT(Y="Z":1,Y="I":2,Y="P":3,1:0)
+67 ;
P1 ;
+1 ;
+2 WRITE !
+3 SET DIR(0)="S^2:2nd Notice;3:3rd Notice;C:Copy;O:Original"
+4 SET DIR("A")="(2)nd Notice, (3)rd Notice, (C)opy or (O)riginal"
+5 SET DIR("B")="C"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
GOTO PRINTX
+8 ; copy
IF Y="C"
SET Y=0
+9 ; original
IF Y="O"
SET Y=1
+10 SET IBMCSPNT=Y
+11 ;
+12 WRITE !!,"Note: Any selected claims in a REQUEST MRA status will not be printed."
+13 WRITE !
+14 SET DIR(0)="Y"
+15 SET DIR("A")="OK to begin printing claims"
+16 SET DIR("B")="No"
+17 SET DIR("?",1)=" Enter YES to immediately begin printing the selected claims."
+18 SET DIR("?")=" Enter NO to quit this option."
+19 DO ^DIR
KILL DIR
+20 IF 'Y
GOTO PRINTX
+21 ;
+22 ; kill ^XTMP scratch global
+23 SET IBX="IBCFP"
FOR
SET IBX=$ORDER(^XTMP(IBX))
if IBX'?1"IBCFP"1.N
QUIT
KILL ^XTMP(IBX,$JOB)
+24 SET IBXP=$$FMADD^XLFDT(DT,1)_U_DT_U_"MCS BATCH PRINT BILLS "_$$HTE^XLFDT($HOROLOG)_" by "_$SELECT($DATA(^VA(200,+$GET(DUZ),0)):$PIECE(^(0),"^"),1:"Unknown User")
+25 ;
+26 ; Loop thru selected claims, queue them and print them
+27 SET IBIFN=0
+28 FOR
SET IBIFN=$ORDER(^TMP($JOB,"IBCEMCL",4,2,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+29 ; form type of claim
SET IBFT=$$FT^IBCEF(IBIFN)
+30 ; no printer defined
IF $PIECE($GET(^IBE(353,IBFT,0)),U,2)=""
QUIT
+31 SET IB0=$GET(^DGCR(399,IBIFN,0))
+32 ; don't include MRA requests here
IF $PIECE(IB0,U,13)=2
QUIT
+33 SET DFN=+$PIECE(IB0,U,2)
+34 SET PATNAME=$PIECE($GET(^DPT(DFN,0)),U,1)
+35 ; field 109 - curr ins zip
SET ZIP=$PIECE($GET(^DGCR(399,IBIFN,"M")),U,9)
+36 ; payer
+37 SET INS=+$PIECE($GET(^DGCR(399,IBIFN,"MP")),U,1)
+38 IF 'INS
SET INS=+$$CURR^IBCEF2(IBIFN)
+39 SET PAYER=$PIECE($GET(^DIC(36,INS,0)),U,1)
+40 ;
+41 SET IBX=ZIP_U_PAYER_U_PATNAME
+42 ; primary sort data
SET IBS1=$PIECE(IBX,U,$EXTRACT(IBS,1))_" "
+43 ; secondary sort data
SET IBS2=$PIECE(IBX,U,$EXTRACT(IBS,2))_" "
+44 ; tertiary sort data
SET IBS3=$PIECE(IBX,U,$EXTRACT(IBS,3))_" "
+45 ;
+46 SET ^XTMP("IBCFP"_IBFT,$JOB,IBS1,IBS2,IBS3,IBIFN)=""
+47 SET ^XTMP("IBCFP"_IBFT,0)=IBXP
+48 SET IBDA=0
+49 FOR
SET IBDA=$ORDER(^TMP($JOB,"IBCEMCL",4,2,IBIFN,IBDA))
if 'IBDA
QUIT
Begin DoDot:2
+50 NEW DIE,DA,DR,TXT
+51 SET DIE=361
SET DA=IBDA
SET DR=".16////"_DT
DO ^DIE
+52 SET TXT(1)="Claim queued for printing by the MCS - 'Resubmit by Print' action"
SET TXT=1
+53 DO NOTECHG^IBCECSA2(IBDA,0,.TXT,1)
+54 QUIT
End DoDot:2
+55 ;
+56 ; if this is an MRA secondary claim and MRA's are on file and
+57 ; there is a printer defined for MRAs, then include them too
+58 IF $$MRAEXIST^IBCEMU1(IBIFN)
IF $PIECE($GET(^IBE(353,6,0)),U,2)'=""
Begin DoDot:2
+59 SET ^XTMP("IBCFP6",$JOB,IBS1,IBS2,IBS3,IBIFN)=""
+60 SET ^XTMP("IBCFP6",0)=IBXP
+61 QUIT
End DoDot:2
+62 ;
+63 ; if the claim's form type is a CMS-1500 and there is a printer
+64 ; defined for Bill Addendums, then include them too
+65 IF IBFT=2
IF $PIECE($GET(^IBE(353,4,0)),U,2)'=""
Begin DoDot:2
+66 SET ^XTMP("IBCFP4",$JOB,IBS1,IBS2,IBS3,IBIFN)=""
+67 SET ^XTMP("IBCFP4",0)=IBXP
+68 QUIT
End DoDot:2
+69 ;
+70 QUIT
End DoDot:1
+71 ;
+72 ; loop thru the ^XTMP scatch global and queue off form type job
+73 SET IBX="IBCFP"
KILL IBTASK
+74 FOR
SET IBX=$ORDER(^XTMP(IBX))
if IBX'?1"IBCFP"1.N
QUIT
Begin DoDot:1
+75 IF '$DATA(^XTMP(IBX,$JOB))
QUIT
+76 SET IBFT=+$EXTRACT(IBX,6,99)
+77 ; printer
SET ZTIO=$PIECE($GET(^IBE(353,IBFT,0)),U,2)
+78 ; 1st subscript
SET IBFTP=IBX
+79 ; 2nd subscript
SET IBJ=$JOB
+80 SET ZTDTH=$HOROLOG
+81 SET ZTSAVE("IBFTP")=""
+82 SET ZTSAVE("IBFT")=""
+83 SET ZTSAVE("IBJ")=""
+84 SET ZTSAVE("IBMCSPNT")=""
+85 SET ZTDESC="MCS BATCH PRINTING "_$$FTN^IBCU3(IBFT)
+86 SET ZTRTN="QBILL^IBCFP1"
+87 ; MRA print rtn
IF IBFT=6
SET ZTRTN="QMRA^IBCEMU2"
+88 DO ^%ZTLOAD
+89 SET IBTASK(IBFT)=+$GET(ZTSK)
+90 QUIT
End DoDot:1
+91 ;
+92 ; Display the queued task#'s
+93 IF '$DATA(IBTASK)
WRITE !!?5,"Nothing was printed"
+94 IF $DATA(IBTASK)
Begin DoDot:1
+95 WRITE !
+96 SET IBFT=0
FOR
SET IBFT=$ORDER(IBTASK(IBFT))
if 'IBFT
QUIT
Begin DoDot:2
+97 WRITE !,$JUSTIFY($$FTN^IBCU3(IBFT),15)," form type printing started with TaskMan task# ",IBTASK(IBFT),"."
+98 QUIT
End DoDot:2
+99 ;
+100 WRITE !!?1,"Please Note: These EDI status messages will be removed from the CSA screen"
+101 WRITE !?15,"and the MCS screen once it has been confirmed that these claims"
+102 WRITE !?15,"have been successfully printed."
+103 QUIT
End DoDot:1
+104 ;
+105 DO PAUSE^VALM1
+106 ;
+107 ; rebuild the list
+108 KILL ^TMP($JOB,"IBCEMCA"),VALMHDR
+109 SET VALMBG=1
+110 DO UNLOCK^IBCEMCL
+111 DO INIT^IBCEMCL
+112 ; flag to rebuild CSA
IF $GET(IBCSAMCS)=1
SET IBCSAMCS=2
+113 ;
PRINTX ;
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
