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

IBCEM4 ;ALB/TMP - IB ELECTRONIC MESSAGE SCREEN TEXT MAINT ;19-APR-2001
 ;;2.0;INTEGRATED BILLING;**137,368**;21-MAR-1994;Build 21
 ;;Per VHA Directive 2004-038, this routine should not be modified.
 ;
EN ; entry point for maintenance
 D EN^VALM("IBCE MESSAGE TEXT MAIN")
 Q
 ;
HDR ; Header code
 K VALMHDR
 Q
 ;
INIT ; Build list of text entries
 N Z,Z0
 S (IBCNT,VALMCNT)=0,VALMBG=1
 K ^TMP("IBCEMSGT",$J)
 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)
 Q
 ;
EXIT ; -- Clean up list
 K ^TMP("IBCEMSGT",$J)
 D CLEAN^VALM10
 Q
 ;
SET(Z,Z0) ; Set data into display global
 N X,IB
 S IBCNT=IBCNT+1,X="",IB=""
 S:$G(Z0)'="" Z0="    "_Z0
 I $G(Z0)="" D
 . S Z0=$S('Z:"*** DO NOT REQUIRE REVIEW ***",1:"*** REQUIRE REVIEW ***"),IB=$J("",(80-$L(Z0))\2),Z0=IB_Z0
 . I 'Z D SET(Z," ")
 I Z0'="" S X=$$SETFLD^VALM1(Z0,X,"TEXT")
 S VALMCNT=VALMCNT+1,^TMP("IBCEMSGT",$J,VALMCNT,0)=X
 S ^TMP("IBCEMSGT",$J,"IDX",VALMCNT,IBCNT)=""
 I IB'="" D CNTRL^VALM10(VALMCNT,2+$L(IB),$L(Z0)-$L(IB),IORVON,IORVOFF)
 Q
EDIT ; Add/edit message text
 N DA,DIC,DLAYGO,DIE,DR,DIR,X,Y,IBUPD,IBSTOP,IBY
 D FULL^VALM1
 S (IBSTOP,IBUPD)=0
 F  D  Q:IBSTOP
 . 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
 . S IBY=Y
 . I IBY'>0 S IBSTOP=1 Q
 . I $P(IBY,U,3) S IBUPD=1 Q
 . S DIC="^IBE(361.3,",DA=+IBY W ! D EN^DIQ W !
 . S DIE="^IBE(361.3,",DA=+IBY,DR=".01" D ^DIE ; edit
 . I '$D(^IBE(361.3,+IBY,0)) S IBUPD=1 Q
 . 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
 D:IBUPD INIT
 S VALMBCK="R"
 Q
 ;
CKREVU(IBTEXT,IBNR,IBSKIP,IBREV) ; Check IBTEXT contains 'no review
 ;        needed' text
 ; IBNR = returned if passed by reference - 'no review needed' text found
 ; IBSKIP = 1 if no check needed for 'always review'
 ; IBREV = returned if passed by reference and 'review always needed'
 ;         text found
 ;
 N T,Y,Z,Z0
 S (IBREV,Y)=0,Z="",IBTEXT=$$UP^XLFSTR($G(IBTEXT))
 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 text
 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 unnecessary
 Q Y
 ;
REPORT ; Produce a report of messages filed without review by user-selected
 ; date range for date received and sort by either bill# or message text
 N IBFR,IBTO,IBSORT,DIR,DA,DR,X,Y,ZTSAVE,ZTRTN,ZTDESC,ZTREQ
R1 S DIR("A")="FROM DATE RECEIVED: ",DIR(0)="DA^:"_DT_"::PAXE" D ^DIR K DIR
 Q:$D(DTOUT)!$D(DUOUT)
 S IBFR=Y W "   ",$G(Y(0))
R2 S DIR("A")="TO DATE RECEIVED: ",DIR(0)="DAO^"_IBFR_":"_DT_"::PAE" D ^DIR K DIR
 Q:$D(DTOUT)!$D(DUOUT)
 I Y'>0 W ! G R1
 S IBTO=Y W "   ",$G(Y(0))
 S DIR("A")="SORT BY",DIR(0)="SXBO^B:Bill #;M:Message Screen Text",DIR("B")="B" D ^DIR K DIR
 Q:$D(DTOUT)!$D(DUOUT)
 I (Y="")!("BM"'[Y) W ! G R2
 S IBSORT=Y
 S %ZIS="QM" D ^%ZIS Q:POP
 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
 U IO
ENRPT ; Queued job entrypoint
 N IB,IB0,IBDA,IB00,IB1,IBS1,IBPAGE,IBLINES,IBHDRDT,IBSB,IBSTOP,DIR,Y,X,Z
 W:$E(IOST,1,2)["C-" @IOF ;Only initial form feed for print to screen
 K ^TMP($J,"IBSORT")
 S IB=IBFR-.000001
 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
 . I $D(ZTQUEUED) Q:$$STOP(.ZTREQ,.ZTSTOP)
 . S IBS1=""
 . I IBSORT="M" D  ; Find text that caused auto-file
 .. 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
 .. I IBS1="" S IBS1="??"
 . I IBSORT="B" S IBS1=$P($G(^DGCR(399,+IB0,0)),U)
 . I IBS1'="" S ^TMP($J,"IBSORT",IBS1,IBDA)=IB0
 S IBHDRDT=$$FMTE^XLFDT($$NOW^XLFDT(),"2P")
 S (IBSTOP,IBLINES,IBPAGE)=0
 S IB1=1,IB="" F  S IB=$O(^TMP($J,"IBSORT",IB)) Q:IB=""!$G(ZTSTOP)  D  Q:IBSTOP
 . S IBSB=$S(IBSORT="M":"MESSAGE SCREEN TEXT: "_IB,1:"")
 . I IBSB'="" S IBSB=$J("",(80-$L(IBSB)\2))_IBSB
 . D:IB1 RHDR(IBSB,.IBSTOP) Q:IBSTOP
 . I 'IB1,IBSORT="M" D  Q:IBSTOP
 .. I IBLINES>(IOSL-5) D RHDR(IBSB,.IBSTOP) Q
 .. W !!,IBSB,! S IBLINES=IBLINES+3
 . S (IB1,IBDA)=0 F  S IBDA=$O(^TMP($J,"IBSORT",IB,IBDA)) Q:'IBDA!$G(ZTSTOP)  D  Q:IBSTOP
 .. I $D(ZTQUEUED),$$STOP(.ZTREQ,.ZTSTOP) W !,"*********** REPORT STOPPED BEFORE IT COMPLETED!!! ***********" Q
 .. S IB0=$G(^TMP($J,"IBSORT",IB,IBDA)),IB00=$G(^DGCR(399,+IB0,0))
 .. I $G(IBLINES)>(IOSL-5) D RHDR("",.IBSTOP) Q:IBSTOP
 .. 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)_"  "
 .. W $E($P($G(^DIC(36,+$$POLICY^IBCEF(+IB0,1,$P(IB0,U,7)),0)),U),1,20)
 .. S IBLINES=IBLINES+1
 .. I $G(IBLINES)>(IOSL-5) D RHDR("",.IBSTOP) Q:IBSTOP
 .. S Z=0 F  S Z=$O(^IBM(361,IBDA,1,Z)) Q:'Z  D  Q:IBSTOP
 ... N Z0,Z1
 ... S Z0=$G(^IBM(361,IBDA,1,Z,0))
 ... 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
 G:IBSTOP!$G(ZTSTOP) ENSTOP
 I $G(IB1) D RHDR("") W !,"NO RECORDS MATCHING SEARCH CRITERIA WERE FOUND",!
 ;
 I $E(IOST,1,2)["C-"  K DIR S DIR(0)="E" D ^DIR K DIR
ENSTOP I '$D(ZTQUEUED) D ^%ZISC
 I $D(ZTQUEUED),'$G(ZTSTOP) S ZTREQ="@"
 K ^TMP($J,"IBSORT")
 Q
 ;
RHDR(IBSB,IBSTOP) ; Report header
 ; IBSB'="" if sub header should print
 N Z,DIR,X,Y
 S IBPAGE=IBPAGE+1
 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
 W !,@IOF
 W !,?22,"MESSAGES FILED WITHOUT REVIEW REPORT",?65,"PAGE: ",IBPAGE
 S Z="RUN DATE: "_IBHDRDT W !,?(80-$L(Z)\2),Z
 S Z="DATE RECEIVED RANGE: "_$$FMTE^XLFDT(IBFR,"2D")_"-"_$$FMTE^XLFDT(IBTO,"2D") W !,?(80-$L(Z)\2),Z,!
 W !,$J("",40),"EVENT      DATE"
 W !,"BILL #      PATIENT NAME"_$J("",15)_" DATE     RECEIVED  INSURANCE CO",!
 S Z="",$P(Z,"-",81)="" W Z
 S IBLINES=7
 I $G(IBSB)'="" W !,IBSB,! S IBLINES=IBLINES+2
RHDRQ Q
 ;
STOP(IBSTOP,IBREQ) ; Check for job being stopped
 I $$S^%ZTLOAD S IBSTOP=1 K IBREQ
 Q $G(IBSTOP)
 ;