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

IBCEMCA3.m

Go to the documentation of this file. 
  1. IBCEMCA3 ;ALB/ESG - Multiple CSA Message Management - Actions ;20-SEP-2005
  1.  ;;2.0;INTEGRATED BILLING;**320,349**;21-MAR-1994;Build 46
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. PRINT ; resubmit by print
  1.  NEW DFN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FC,FORM,IB0,IB364,IBDA,IBFT,IBFTP
  1.  NEW IBH,IBIFN,IBJ,IBMCSPNT,IBQUIT,IBS,IBS1,IBS2,IBS3,IBTASK,IBX,IBXP,IBY,IBZ
  1.  NEW INS,NS,NSC,PATNAME,PAYER,X,Y,ZIP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  D FULL^VALM1
  1.  ;
  1.  S NS=+$G(^TMP($J,"IBCEMCL",4))
  1.  I 'NS D  G PRINTX
  1.  . W !!?5,"There are no selected messages." D PAUSE^VALM1
  1.  . Q
  1.  ;
  1.  ; count number of claims too
  1.  S IBIFN=0 F NSC=0:1 S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN
  1.  ;
  1.  W !!?5,"Number of messages selected:  ",NS
  1.  W !?7,"Number of claims selected:  ",NSC
  1.  ;
  1.  ; check certain form types for a default printer
  1.  K FC S FC=0
  1.  F FORM=2,3,6 D
  1.  . N X S X=$G(^IBE(353,FORM,0))
  1.  . I $P(X,U,2)'="" Q   ; billing printer defined
  1.  . S FC=FC+1,FC($P(X,U,1)_" ")=""
  1.  . Q
  1.  I FC D  I IBQUIT G PRINTX
  1.  . N NM
  1.  . S IBQUIT=0
  1.  . W !!,*7,"Warning!  The default billing printer is missing for the following form type",$S(FC>1:"s",1:""),":",!
  1.  . S NM="" F  S NM=$O(FC(NM)) Q:NM=""  W !?4,NM
  1.  . W !!,"Nothing will print for ",$S(FC>1:"these form types",1:"this form type"),".  Printers are maintained in the option"
  1.  . W !,"'Select Default Device for Forms' on the System Manager's IB Menu."
  1.  . W ! S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="No"
  1.  . D ^DIR K DIR
  1.  . I 'Y S IBQUIT=1   ; No, don't continue quit out
  1.  . Q
  1.  ;
  1.  ; Ask the user for the 3 sort levels
  1.  W !
  1.  S IBS=""
  1.  S IBZ="Z:ZIP;I:INSURANCE COMPANY NAME;P:PATIENT NAME;"
  1.  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."
  1.  S DIR("?")=IBH
  1.  S DIR("A")="First Sort Claims By"
  1.  S DIR(0)="SB^"_IBZ
  1.  D ^DIR K DIR I $D(DIRUT) G PRINTX                   ; primary sort
  1.  S IBS=IBS_$S(Y="Z":1,Y="I":2,Y="P":3,1:0)
  1.  S IBX=$P($P(IBZ,Y_":",2),";",1)
  1.  ;
  1.  S DIR("?")=IBH
  1.  S DIR("?",1)="Enter the field that the claims should be sorted on within "_IBX_"."
  1.  S DIR("?",2)="Press return if the order already entered is sufficient."
  1.  S DIR("?",3)=""
  1.  S DIR("A")="Then Sort Claims By"
  1.  S DIR(0)="SOB^"_IBZ
  1.  D ^DIR K DIR I Y'="",$D(DIRUT) G PRINTX             ; secondary sort
  1.  S IBS=IBS_$S(Y="Z":1,Y="I":2,Y="P":3,1:0)
  1.  I Y="" G P1
  1.  S IBY=$P($P(IBZ,Y_":",2),";",1)
  1.  ;
  1.  S DIR("?")=IBH
  1.  S DIR("?",1)="Enter the field that the claims should be sorted on within "_IBX_" and "_IBY_"."
  1.  S DIR("?",2)="Press return if the order already entered is sufficient."
  1.  S DIR("?",3)=""
  1.  S DIR("A")="Then Sort Claims By"
  1.  S DIR(0)="SOB^"_IBZ
  1.  D ^DIR K DIR I Y'="",$D(DIRUT) G PRINTX             ; tertiary sort
  1.  S IBS=IBS_$S(Y="Z":1,Y="I":2,Y="P":3,1:0)
  1.  ;
  1. P1 ;
  1.  ;
  1.  W !
  1.  S DIR(0)="S^2:2nd Notice;3:3rd Notice;C:Copy;O:Original"
  1.  S DIR("A")="(2)nd Notice, (3)rd Notice, (C)opy or (O)riginal"
  1.  S DIR("B")="C"
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) G PRINTX
  1.  I Y="C" S Y=0   ; copy
  1.  I Y="O" S Y=1   ; original
  1.  S IBMCSPNT=Y
  1.  ;
  1.  W !!,"Note:  Any selected claims in a REQUEST MRA status will not be printed."
  1.  W !
  1.  S DIR(0)="Y"
  1.  S DIR("A")="OK to begin printing claims"
  1.  S DIR("B")="No"
  1.  S DIR("?",1)="   Enter YES to immediately begin printing the selected claims."
  1.  S DIR("?")="   Enter NO to quit this option."
  1.  D ^DIR K DIR
  1.  I 'Y G PRINTX
  1.  ;
  1.  ; kill ^XTMP scratch global
  1.  S IBX="IBCFP" F  S IBX=$O(^XTMP(IBX)) Q:IBX'?1"IBCFP"1.N  K ^XTMP(IBX,$J)
  1.  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")
  1.  ;
  1.  ; Loop thru selected claims, queue them and print them
  1.  S IBIFN=0
  1.  F  S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN  D
  1.  . S IBFT=$$FT^IBCEF(IBIFN)   ; form type of claim
  1.  . I $P($G(^IBE(353,IBFT,0)),U,2)="" Q    ; no printer defined
  1.  . S IB0=$G(^DGCR(399,IBIFN,0))
  1.  . I $P(IB0,U,13)=2 Q    ; don't include MRA requests here
  1.  . S DFN=+$P(IB0,U,2)
  1.  . S PATNAME=$P($G(^DPT(DFN,0)),U,1)
  1.  . S ZIP=$P($G(^DGCR(399,IBIFN,"M")),U,9)   ; field 109 - curr ins zip
  1.  . ; payer
  1.  . S INS=+$P($G(^DGCR(399,IBIFN,"MP")),U,1)
  1.  . I 'INS S INS=+$$CURR^IBCEF2(IBIFN)
  1.  . S PAYER=$P($G(^DIC(36,INS,0)),U,1)
  1.  . ;
  1.  . S IBX=ZIP_U_PAYER_U_PATNAME
  1.  . S IBS1=$P(IBX,U,$E(IBS,1))_" "     ; primary sort data
  1.  . S IBS2=$P(IBX,U,$E(IBS,2))_" "     ; secondary sort data
  1.  . S IBS3=$P(IBX,U,$E(IBS,3))_" "     ; tertiary sort data
  1.  . ;
  1.  . S ^XTMP("IBCFP"_IBFT,$J,IBS1,IBS2,IBS3,IBIFN)=""
  1.  . S ^XTMP("IBCFP"_IBFT,0)=IBXP
  1.  . S IBDA=0
  1.  . F  S IBDA=$O(^TMP($J,"IBCEMCL",4,2,IBIFN,IBDA)) Q:'IBDA  D
  1.  .. N DIE,DA,DR,TXT
  1.  .. S DIE=361,DA=IBDA,DR=".16////"_DT D ^DIE
  1.  .. S TXT(1)="Claim queued for printing by the MCS - 'Resubmit by Print' action",TXT=1
  1.  .. D NOTECHG^IBCECSA2(IBDA,0,.TXT,1)
  1.  .. Q
  1.  . ;
  1.  . ; if this is an MRA secondary claim and MRA's are on file and
  1.  . ; there is a printer defined for MRAs, then include them too
  1.  . I $$MRAEXIST^IBCEMU1(IBIFN),$P($G(^IBE(353,6,0)),U,2)'="" D
  1.  .. S ^XTMP("IBCFP6",$J,IBS1,IBS2,IBS3,IBIFN)=""
  1.  .. S ^XTMP("IBCFP6",0)=IBXP
  1.  .. Q
  1.  . ;
  1.  . ; if the claim's form type is a CMS-1500 and there is a printer
  1.  . ; defined for Bill Addendums, then include them too
  1.  . I IBFT=2,$P($G(^IBE(353,4,0)),U,2)'="" D
  1.  .. S ^XTMP("IBCFP4",$J,IBS1,IBS2,IBS3,IBIFN)=""
  1.  .. S ^XTMP("IBCFP4",0)=IBXP
  1.  .. Q
  1.  . ;
  1.  . Q
  1.  ;
  1.  ; loop thru the ^XTMP scatch global and queue off form type job
  1.  S IBX="IBCFP" K IBTASK
  1.  F  S IBX=$O(^XTMP(IBX)) Q:IBX'?1"IBCFP"1.N  D
  1.  . I '$D(^XTMP(IBX,$J)) Q
  1.  . S IBFT=+$E(IBX,6,99)
  1.  . S ZTIO=$P($G(^IBE(353,IBFT,0)),U,2)  ; printer
  1.  . S IBFTP=IBX                          ; 1st subscript
  1.  . S IBJ=$J                             ; 2nd subscript
  1.  . S ZTDTH=$H
  1.  . S ZTSAVE("IBFTP")=""
  1.  . S ZTSAVE("IBFT")=""
  1.  . S ZTSAVE("IBJ")=""
  1.  . S ZTSAVE("IBMCSPNT")=""
  1.  . S ZTDESC="MCS BATCH PRINTING "_$$FTN^IBCU3(IBFT)
  1.  . S ZTRTN="QBILL^IBCFP1"
  1.  . I IBFT=6 S ZTRTN="QMRA^IBCEMU2"      ; MRA print rtn
  1.  . D ^%ZTLOAD
  1.  . S IBTASK(IBFT)=+$G(ZTSK)
  1.  . Q
  1.  ;
  1.  ; Display the queued task#'s
  1.  I '$D(IBTASK) W !!?5,"Nothing was printed"
  1.  I $D(IBTASK) D
  1.  . W !
  1.  . S IBFT=0 F  S IBFT=$O(IBTASK(IBFT)) Q:'IBFT  D
  1.  .. W !,$J($$FTN^IBCU3(IBFT),15)," form type printing started with TaskMan task# ",IBTASK(IBFT),"."
  1.  .. Q
  1.  . ;
  1.  . W !!?1,"Please Note:  These EDI status messages will be removed from the CSA screen"
  1.  . W !?15,"and the MCS screen once it has been confirmed that these claims"
  1.  . W !?15,"have been successfully printed."
  1.  . Q
  1.  ;
  1.  D PAUSE^VALM1
  1.  ;
  1.  ; rebuild the list
  1.  KILL ^TMP($J,"IBCEMCA"),VALMHDR
  1.  S VALMBG=1
  1.  D UNLOCK^IBCEMCL
  1.  D INIT^IBCEMCL
  1.  I $G(IBCSAMCS)=1 S IBCSAMCS=2   ; flag to rebuild CSA
  1.  ;
  1. PRINTX ;
  1.  S VALMBCK="R"
  1.  Q
  1.  ;