- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEM4.m
r613 r623 1 IBCEM4 2 ;;2.0;INTEGRATED BILLING;**137,368**;21-MAR-1994;Build 21 3 ;;Per VHA Directive 2004-038, this routine should not be modified.4 5 EN 6 7 8 9 HDR 10 11 12 13 INIT 14 15 16 17 18 19 20 EXIT 21 22 23 24 25 SET(Z,Z0) 26 27 28 29 30 31 32 33 34 35 36 37 EDIT 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 CKREVU(IBTEXT,IBNR,IBSKIP,IBREV) 55 56 57 58 59 60 61 62 S (IBREV,Y)=0,Z="",IBTEXT=$$UP^XLFSTR($G(IBTEXT)) 63 I '$G(IBSKIP) F S Z=$O(^IBE(361.3,"AC",1,Z)) Q:Z="" I IBTEXT[$$UP^XLFSTR(Z)S IBREV=1 Q ; Always review messages with this text64 I 'IBREV S Z="" F S Z=$O(^IBE(361.3,"AC",0,Z)) Q:Z="" I IBTEXT[$$UP^XLFSTR(Z)S Y=1,IBNR=Z Q ; Message contains text to make review unnecessary65 66 67 REPORT 68 69 70 R1 71 72 73 R2 74 75 76 77 78 79 80 81 82 83 84 ENRPT 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 ENSTOP 123 124 125 126 127 RHDR(IBSB,IBSTOP) 128 129 130 131 132 133 134 135 136 137 138 139 140 141 RHDRQ 142 143 STOP(IBSTOP,IBREQ) 144 145 146 1 IBCEM4 ;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 ; 5 EN ; entry point for maintenance 6 D EN^VALM("IBCE MESSAGE TEXT MAIN") 7 Q 8 ; 9 HDR ; Header code 10 K VALMHDR 11 Q 12 ; 13 INIT ; 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 ; 20 EXIT ; -- Clean up list 21 K ^TMP("IBCEMSGT",$J) 22 D CLEAN^VALM10 23 Q 24 ; 25 SET(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 37 EDIT ; 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 ; 54 CKREVU(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 ; 67 REPORT ; 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 70 R1 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)) 73 R2 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 84 ENRPT ; 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 122 ENSTOP I '$D(ZTQUEUED) D ^%ZISC 123 I $D(ZTQUEUED),'$G(ZTSTOP) S ZTREQ="@" 124 K ^TMP($J,"IBSORT") 125 Q 126 ; 127 RHDR(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 141 RHDRQ Q 142 ; 143 STOP(IBSTOP,IBREQ) ; Check for job being stopped 144 I $$S^%ZTLOAD S IBSTOP=1 K IBREQ 145 Q $G(IBSTOP) 146 ;
Note:
See TracChangeset
for help on using the changeset viewer.
