source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEMCA3.m@ 868

Last change on this file since 868 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1IBCEMCA3 ;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 ;
7PRINT ; 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 ;
75P1 ;
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 ;
189PRINTX ;
190 S VALMBCK="R"
191 Q
192 ;
Note: See TracBrowser for help on using the repository browser.