Index: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEM4.m
===================================================================
--- WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEM4.m	(revision 613)
+++ WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEM4.m	(revision 623)
@@ -1,146 +1,146 @@
-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)
-	;
+IBCEM4 ;ALB/TMP - IB ELECTRONIC MESSAGE SCREEN TEXT MAINT ;19-APR-2001
+ ;;2.0;INTEGRATED BILLING;**137**;21-MAR-1994
+ ;;Per VHA Directive 10-93-142, 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=""
+ 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
+ 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
+ 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)
+ ;
