| 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 | ;
|
|---|
