source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEM4.m@ 1259

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

revised back to 6/30/08 version

File size: 6.0 KB
Line 
1IBCEM4 ;ALB/TMP - IB ELECTRONIC MESSAGE SCREEN TEXT MAINT ;19-APR-2001
2 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-1994
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; entry point for maintenance
6 D EN^VALM("IBCE MESSAGE TEXT MAIN")
7 Q
8 ;
9HDR ; Header code
10 K VALMHDR
11 Q
12 ;
13INIT ; Build list of text entries
14 N Z,Z0
15 S (IBCNT,VALMCNT)=0,VALMBG=1
16 K ^TMP("IBCEMSGT",$J)
17 S Z="" F S Z=$O(^IBE(361.3,"AC",Z),-1) Q:Z="" D SET(Z) S Z0="" F S Z0=$O(^IBE(361.3,"AC",Z,Z0)) Q:Z0="" D SET(Z,Z0)
18 Q
19 ;
20EXIT ; -- Clean up list
21 K ^TMP("IBCEMSGT",$J)
22 D CLEAN^VALM10
23 Q
24 ;
25SET(Z,Z0) ; Set data into display global
26 N X,IB
27 S IBCNT=IBCNT+1,X="",IB=""
28 S:$G(Z0)'="" Z0=" "_Z0
29 I $G(Z0)="" D
30 . S Z0=$S('Z:"*** DO NOT REQUIRE REVIEW ***",1:"*** REQUIRE REVIEW ***"),IB=$J("",(80-$L(Z0))\2),Z0=IB_Z0
31 . I 'Z D SET(Z," ")
32 I Z0'="" S X=$$SETFLD^VALM1(Z0,X,"TEXT")
33 S VALMCNT=VALMCNT+1,^TMP("IBCEMSGT",$J,VALMCNT,0)=X
34 S ^TMP("IBCEMSGT",$J,"IDX",VALMCNT,IBCNT)=""
35 I IB'="" D CNTRL^VALM10(VALMCNT,2+$L(IB),$L(Z0)-$L(IB),IORVON,IORVOFF)
36 Q
37EDIT ; Add/edit message text
38 N DA,DIC,DLAYGO,DIE,DR,DIR,X,Y,IBUPD,IBSTOP,IBY
39 D FULL^VALM1
40 S (IBSTOP,IBUPD)=0
41 F D Q:IBSTOP
42 . S DIC(0)="AELMQ",DLAYGO=361.3,DIC="^IBE(361.3,",DIC("DR")="@1;.02;I X="""" W !,""MUST HAVE A VALUE FOR THIS FIELD"" S Y=""@1""" W ! D ^DIC
43 . S IBY=Y
44 . I IBY'>0 S IBSTOP=1 Q
45 . I $P(IBY,U,3) S IBUPD=1 Q
46 . S DIC="^IBE(361.3,",DA=+IBY W ! D EN^DIQ W !
47 . S DIE="^IBE(361.3,",DA=+IBY,DR=".01" D ^DIE ; edit
48 . I '$D(^IBE(361.3,+IBY,0)) S IBUPD=1 Q
49 . I $P(IBY,U,2)'=$P(^IBE(361.3,+IBY,0),U) S IBUPD=1,DIE="^IBE(361.3,",DR=".05////"_$G(DUZ)_";.06///^S X=""NOW""" D ^DIE
50 D:IBUPD INIT
51 S VALMBCK="R"
52 Q
53 ;
54CKREVU(IBTEXT,IBNR,IBSKIP,IBREV) ; Check IBTEXT contains 'no review
55 ; needed' text
56 ; IBNR = returned if passed by reference - 'no review needed' text found
57 ; IBSKIP = 1 if no check needed for 'always review'
58 ; IBREV = returned if passed by reference and 'review always needed'
59 ; text found
60 ;
61 N T,Y,Z,Z0
62 S (IBREV,Y)=0,Z=""
63 I '$G(IBSKIP) F S Z=$O(^IBE(361.3,"AC",1,Z)) Q:Z="" I IBTEXT[Z S IBREV=1 Q ; Always review messages with this text
64 I 'IBREV S Z="" F S Z=$O(^IBE(361.3,"AC",0,Z)) Q:Z="" I IBTEXT[Z S Y=1,IBNR=Z Q ; Message contains text to make review unnecessary
65 Q Y
66 ;
67REPORT ; Produce a report of messages filed without review by user-selected
68 ; date range for date received and sort by either bill# or message text
69 N IBFR,IBTO,IBSORT,DIR,DA,DR,X,Y,ZTSAVE,ZTRTN,ZTDESC,ZTREQ
70R1 S DIR("A")="FROM DATE RECEIVED: ",DIR(0)="DA^:"_DT_"::PAXE" D ^DIR K DIR
71 Q:$D(DTOUT)!$D(DUOUT)
72 S IBFR=Y W " ",$G(Y(0))
73R2 S DIR("A")="TO DATE RECEIVED: ",DIR(0)="DAO^"_IBFR_":"_DT_"::PAE" D ^DIR K DIR
74 Q:$D(DTOUT)!$D(DUOUT)
75 I Y'>0 W ! G R1
76 S IBTO=Y W " ",$G(Y(0))
77 S DIR("A")="SORT BY",DIR(0)="SXBO^B:Bill #;M:Message Screen Text",DIR("B")="B" D ^DIR K DIR
78 Q:$D(DTOUT)!$D(DUOUT)
79 I (Y="")!("BM"'[Y) W ! G R2
80 S IBSORT=Y
81 S %ZIS="QM" D ^%ZIS Q:POP
82 I $D(IO("Q")) K IO("Q") S ZTRTN="ENRPT^IBCEM4",ZTSAVE("IB*")="",ZTDESC="IB - MESSAGES FILED WITHOUT REVIEW REPORT" D ^%ZTLOAD K ZTSK D HOME^%ZIS Q
83 U IO
84ENRPT ; Queued job entrypoint
85 N IB,IB0,IBDA,IB00,IB1,IBS1,IBPAGE,IBLINES,IBHDRDT,IBSB,IBSTOP,DIR,Y,X,Z
86 W:$E(IOST,1,2)["C-" @IOF ;Only initial form feed for print to screen
87 K ^TMP($J,"IBSORT")
88 S IB=IBFR-.000001
89 F S IB=$O(^IBM(361,"ARD",IB)) Q:'IB!$G(ZTSTOP) S IBDA=0 F S IBDA=$O(^IBM(361,"ARD",IB,IBDA)) Q:'IBDA!$G(ZTSTOP) S IB0=$G(^IBM(361,IBDA,0)) Q:IB0=""!'$P(IB0,U,14) D
90 . I $D(ZTQUEUED) Q:$$STOP(.ZTREQ,.ZTSTOP)
91 . S IBS1=""
92 . I IBSORT="M" D ; Find text that caused auto-file
93 .. S Z=0 F S Z=$O(^IBM(361,IBDA,1,Z)) Q:'Z I $$CKREVU($G(^IBM(361,IBDA,1,Z,0)),.IBS1,1) Q
94 .. I IBS1="" S IBS1="??"
95 . I IBSORT="B" S IBS1=$P($G(^DGCR(399,+IB0,0)),U)
96 . I IBS1'="" S ^TMP($J,"IBSORT",IBS1,IBDA)=IB0
97 S IBHDRDT=$$FMTE^XLFDT($$NOW^XLFDT(),"2P")
98 S (IBSTOP,IBLINES,IBPAGE)=0
99 S IB1=1,IB="" F S IB=$O(^TMP($J,"IBSORT",IB)) Q:IB=""!$G(ZTSTOP) D Q:IBSTOP
100 . S IBSB=$S(IBSORT="M":"MESSAGE SCREEN TEXT: "_IB,1:"")
101 . I IBSB'="" S IBSB=$J("",(80-$L(IBSB)\2))_IBSB
102 . D:IB1 RHDR(IBSB,.IBSTOP) Q:IBSTOP
103 . I 'IB1,IBSORT="M" D Q:IBSTOP
104 .. I IBLINES>(IOSL-5) D RHDR(IBSB,.IBSTOP) Q
105 .. W !!,IBSB,! S IBLINES=IBLINES+3
106 . S (IB1,IBDA)=0 F S IBDA=$O(^TMP($J,"IBSORT",IB,IBDA)) Q:'IBDA!$G(ZTSTOP) D Q:IBSTOP
107 .. I $D(ZTQUEUED),$$STOP(.ZTREQ,.ZTSTOP) W !,"*********** REPORT STOPPED BEFORE IT COMPLETED!!! ***********" Q
108 .. S IB0=$G(^TMP($J,"IBSORT",IB,IBDA)),IB00=$G(^DGCR(399,+IB0,0))
109 .. I $G(IBLINES)>(IOSL-5) D RHDR("",.IBSTOP) Q:IBSTOP
110 .. W !,$E($$BN1^PRCAFN(+IB0)_$J("",10),1,10)," ",$E($P($G(^DPT(+$P(IB00,U,2),0)),U)_$J("",25),1,25)_" "_$E($$FMTE^XLFDT($P(IB00,U,3),"2D")_$J("",8),1,8)_" "_$E($$FMTE^XLFDT($P(IB0,U,2),"2D")_$J("",8),1,8)_" "
111 .. W $E($P($G(^DIC(36,+$$POLICY^IBCEF(+IB0,1,$P(IB0,U,7)),0)),U),1,20)
112 .. S IBLINES=IBLINES+1
113 .. I $G(IBLINES)>(IOSL-5) D RHDR("",.IBSTOP) Q:IBSTOP
114 .. S Z=0 F S Z=$O(^IBM(361,IBDA,1,Z)) Q:'Z D Q:IBSTOP
115 ... N Z0,Z1
116 ... S Z0=$G(^IBM(361,IBDA,1,Z,0))
117 ... F Z1=1:75:$L(Z0) D:$G(IBLINES)>(IOSL-5) RHDR("",.IBSTOP) Q:IBSTOP W !,?5,$E(Z0,Z1,Z1+74) S IBLINES=IBLINES+1
118 G:IBSTOP!$G(ZTSTOP) ENSTOP
119 I $G(IB1) D RHDR("") W !,"NO RECORDS MATCHING SEARCH CRITERIA WERE FOUND",!
120 ;
121 I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR
122ENSTOP I '$D(ZTQUEUED) D ^%ZISC
123 I $D(ZTQUEUED),'$G(ZTSTOP) S ZTREQ="@"
124 K ^TMP($J,"IBSORT")
125 Q
126 ;
127RHDR(IBSB,IBSTOP) ; Report header
128 ; IBSB'="" if sub header should print
129 N Z,DIR,X,Y
130 S IBPAGE=IBPAGE+1
131 I IBPAGE>1,$E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S IBSTOP=1 G RHDRQ
132 W !,@IOF
133 W !,?22,"MESSAGES FILED WITHOUT REVIEW REPORT",?65,"PAGE: ",IBPAGE
134 S Z="RUN DATE: "_IBHDRDT W !,?(80-$L(Z)\2),Z
135 S Z="DATE RECEIVED RANGE: "_$$FMTE^XLFDT(IBFR,"2D")_"-"_$$FMTE^XLFDT(IBTO,"2D") W !,?(80-$L(Z)\2),Z,!
136 W !,$J("",40),"EVENT DATE"
137 W !,"BILL # PATIENT NAME"_$J("",15)_" DATE RECEIVED INSURANCE CO",!
138 S Z="",$P(Z,"-",81)="" W Z
139 S IBLINES=7
140 I $G(IBSB)'="" W !,IBSB,! S IBLINES=IBLINES+2
141RHDRQ Q
142 ;
143STOP(IBSTOP,IBREQ) ; Check for job being stopped
144 I $$S^%ZTLOAD S IBSTOP=1 K IBREQ
145 Q $G(IBSTOP)
146 ;
Note: See TracBrowser for help on using the repository browser.