IBCECSA2 ;ALB/CXW - IB CLAIMS STATUS AWAITING RESOLUTION SCREEN ;28-JUL-1999
;;2.0;INTEGRATED BILLING;**137,181,197,320**;21-MAR-1994
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; -- claims status awaiting resolution detail
D EN^VALM("IBCEM CSA MSG")
Q
;
HDR ; -- header code
; IBA - EOB ien from summary selection
N IBST,IBST0
Q:'$G(IBA)
S IBST0=$G(^IBM(361,+$P(IBA,U,2),0)),IBST=$P(IBST0,U,9)
S VALMHDR(2)="Message Status = "_$$EXPAND^IBTRE(361,.09,IBST)
I $P(IBST0,U,14) S VALMHDR(2)=VALMHDR(2)_" (AUTOMATICALLY REVIEWED)"
S VALMHDR(1)=$J("",23)_"CLAIMS STATUS AWAITING RESOLUTION-DETAIL"
Q
;
INIT ; -- init variables and list array
N I,X,Y,Z,ZZ,IBZ,IBZ0,IBX,IBCNT
K ^TMP("IBCECSC",$J)
SCR S VALMCNT=0,IBCNT=1
S IBA=+$O(IBDAX(0)),IBA=$G(IBDAX(IBA))
Q:IBA=""
S X=""
S IBX=$S($D(^TMP("IBCECSB",$J)):$G(^TMP("IBCECSB",$J,$P(IBA,U,3),$P(IBA,U,4),$P(IBA,U,6),$P(IBA,U,2))),1:"")
D SETL1^IBCECSA1(IBX,.X)
D SET(X,IBCNT)
D SET("",IBCNT) ; blank line
;
S X=$E(" Svc Loc: "_$P(IBX,U,7)_$J("",30),1,30)_$J("",14)_"Division: "_$E($P(IBX,U,8),1,26)
D SET(X,IBCNT)
S X=$E(" Biller Name: "_$P($P(IBX,U,9),"~")_$J("",30),1,30)_$J("",10)_"Days Pending: "_$P(IBX,U,11)
D SET(X,IBCNT)
S IBZ=$P(IBA,U,2),IBZ0=$G(^IBM(361,IBZ,0))
S X=$E(" Date Rec'd: "_$$FMTE^XLFDT($P(IBZ0,U,2),"2Z")_$J("",30),1,30)_$J("",10)_"Dt Generated: "_$S($P(IBZ0,U,12):$$FMTE^XLFDT($P(IBZ0,U,12),"2Z"),1:"")
D SET(X,IBCNT),SET("",IBCNT)
;
D SET("Message Text:",IBCNT)
S X=0 F S X=$O(^IBM(361,IBZ,1,X)) Q:'X D
. S Y=" "_$G(^IBM(361,IBZ,1,X,0))
. D SET(Y,IBCNT)
. Q
D SET("",IBCNT)
;
S ZZ="" F S ZZ=$O(^IBM(361,IBZ,2,"B",ZZ),-1) Q:ZZ="" S Z=0 F S Z=$O(^IBM(361,IBZ,2,"B",ZZ,Z)) Q:'Z D
. S I=$G(^IBM(361,IBZ,2,Z,0))
. S Y=$$SETSTR^VALM1("Review Date: "_$$EXTERNAL^DILFD(361.02,.01,,ZZ),"",2,40)
. D SET(Y,IBCNT)
. I $P(I,U,2) S Y=$$SETSTR^VALM1("Reviewed By: "_$P($G(^VA(200,+$P(I,U,2),0)),U,1),"",2,70) D SET(Y,IBCNT)
. D SET(" Comments:",IBCNT)
. S X=0 F S X=$O(^IBM(361,IBZ,2,Z,1,X)) Q:'X D
.. S Y=" "_$G(^IBM(361,IBZ,2,Z,1,X,0))
.. D SET(Y,IBCNT)
.. Q
. D SET("",IBCNT)
. Q
INITQ Q
;
HELP ; help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; exit code
K ^TMP("IBCECSC",$J)
D CLEAN^VALM10
Q
;
SET(X,CNT) ;
S VALMCNT=VALMCNT+1
S ^TMP("IBCECSC",$J,VALMCNT,0)=X
S ^TMP("IBCECSC",$J,"IDX",VALMCNT,CNT)=""
S ^TMP("IBCECSC",$J,CNT)=VALMCNT
Q
;
UPDTX(IBDA,IBST) ; Update transmit bill record
; IBDA = ien of entry in 364
; IBST = status to stuff
N X,Y,DR,DIE,DA
S DR=".03////"_IBST_";.04///NOW",DA=IBDA,DIE="^IBA(364," D:DA ^DIE
Q
;
STATUS ; Edit rev stat
;IBA - EOB ien
N DA,DIE,DR,IBOLD,DIC,DO,DD,DLAYGO,IBDA,IBFINAL,IBO,IBNEW,IBFACT
D FULL^VALM1
S DIE="^IBM(361,"
S (IBDA,DA)=$P(IBA,U,2)
G:'DA STATUSQ
S IBOLD=$P($G(^IBM(361,DA,0)),U,9),IBFINAL=0,IBO=$S(IBOLD'="":"/"_IBOLD,1:"@")
S DR="@1;.09;I +X<2 S IBFINAL=0,Y=""@99"";S IBFINAL=1;.1;I X="""" W !,""For a final status, this field is required"" S Y=""@98"";S Y=""@99"";@98;.09///"_IBO_";S Y=""@1"";@99"
L +^IBM(361,IBDA):3 I '$T D G STATUSQ
. W !,"Sorry, another user currently editing this entry (#"_IBDA_")."
D ^DIE
;
I $G(IBFINAL) D ;Final status selected - enter remarks
. N Z
. S Z=IBDA
. N IBDA,Q,DIE,DR,DA,X,Y
. S IBDA(1)=Z,IBDA=""
. D ADDCOM(.IBDA,.DUZ,.IBCOM)
. I $P($G(^IBM(361,IBDA(1),0)),U,10)="O",'$O(^IBM(361,IBDA(1),2,+IBDA,0)) D ; Require remarks for 'OTHER ACTION' final status
.. W !,"Since OTHER ACTION final status was selected, you must enter a",!," comment explaining the OTHER ACTION" D ADDCOM(.IBDA,.DUZ,.IBCOM,1)
.. I IBDA D
... ; Delete entry without a comment
... D KILLREV(.IBDA)
.. I '$O(^IBM(361,IBDA(1),2,+IBDA,0)) S DIE="^IBM(361,",DA=IBDA(1),DR=".20///@;.09///"_IBO D ^DIE W !,"The review status was not changed because no comment was entered",! Q
S IBNEW=$P($G(^IBM(361,DA,0)),U,9)
;if time out-no change in review status
S IBFACT=$P($G(^IBM(361,DA,0)),U,10)
I $G(IBFINAL),IBFACT="",IBNEW>1 D G STATUSQ
. W !,"The review status was not changed because no final status was selected"
. S DR=".09////"_IBOLD,DIE="^IBM(361," D ^DIE
I IBNEW>1,$P(^IBM(361,DA,0),U,11) D
. I "CR"'[IBFACT D
.. W !,"NO FURTHER ACTION WILL BE ALLOWED REGARDING THIS ELECTRONIC MESSAGE"
.. I $$PRINTUPD^IBCEU0("",$P(^IBM(361,DA,0),U,11)) D Q
... W !," SINCE THIS CLAIM WAS PRINTED AT THE CLEARINGHOUSE"
... S IBFACT="N"
.. S DIR(0)="YA",DIR("A")="IS THIS THE FINAL ELECTRONIC MESSAGE YOU EXPECT TO RECEIVE FOR THIS BILL?: ",DIR("B")="NO"
.. S DIR("?",1)="If you respond YES to this prompt, the transmit status of this bill will",DIR("?",2)=" be set to CLOSED. No further electronic processing of this bill will be"
..S DIR("?",3)=" allowed. If you respond NO to this prompt, this electronic message will",DIR("?",4)=" be filed as reviewed, but the bill's transmit status will not be changed."
.. S DIR("?",5)=" You may wish to periodically print a list of bills with a non-final",DIR("?",6)=" (closed/cancelled/etc) status to ensure the electronic processing of all"
.. S DIR("?",7)=" bills has been completed. Closing the transmit bill record here will",DIR("?")=" eliminate the bill from this list."
.. W ! D ^DIR K DIR W !
.. Q:Y'=1
.. S DIR("A",1)="SINCE YOU HAVE INDICATED THIS BILL HAS RECEIVED ITS FINAL ELECTRONIC MESSAGE",DIR("A",2)=" AND NO FURTHER ACTION WILL BE TAKEN ON IT, THE STATUS OF THE TRANSMIT",DIR("A",3)=" RECORD FOR THIS BILL WILL BE CHANGED TO CLOSED"
.. S DIR("A")="IS THIS WHAT YOU MEANT TO DO?: ",DIR("B")="YES",DIR(0)="YA" W ! D ^DIR W ! K DIR
.. Q:Y'=1
.. S IBFACT="N"
. I "NCR"[IBFACT D UPDEDI^IBCEM(+$P(^IBM(361,DA,0),U,11),IBFACT) Q
S $P(IBX,U,12)=$S(IBNEW=1:"*",1:"")
I IBOLD'=IBNEW D ;Note the change and who made it
. D NOTECHG(IBDA,0),HDR,INIT
L -^IBM(361,DA)
S VALMBCK="R"
Q
;
NOTECHG(IBDA,IBAUTO,IBNTEXT,IBUSER) ; Enter who/when review stat change was entered
; IBDA = ien of entry in file 361
; IBAUTO = flag to say auto-review was used (1=used, 0=not used)
; IBNTEXT = array containing the lines of text to store if not using the
; default text IBNTEXT = # of lines
; IBUSER = flag which says to also stuff the .02 reviewed by field
N IBIEN,IBTEXT,DA,X,Y,DIC,DO,DLAYGO,DD
S DA(1)=IBDA,DIC="^IBM(361,"_DA(1)_",2,",DIC(0)="L",DLAYGO=361.02
S X=$$NOW^XLFDT
I $G(IBUSER),$G(DUZ) S DIC("DR")=".02////"_$G(DUZ)
D FILE^DICN K DIC,DD,DO,DLAYGO
Q:Y'>0
S DA(2)=DA(1),DA(1)=+Y,IBIEN=DA(1)_","_DA(2)_","
I $G(IBNTEXT) D
. M IBTEXT=IBNTEXT
E D
. S IBTEXT(1)="REVIEW STATUS "_$S($G(IBAUTO):"AUTOMATICALLY ",1:"")_"CHANGED TO '"_$$EXTERNAL^DILFD(361,.09,,$P(^IBM(361,DA(2),0),U,9))_"' BY: "_$$EXTERNAL^DILFD(361.02,.02,,+$G(DUZ))
D WP^DIE(361.02,IBIEN,.03,,"IBTEXT") K ^TMP("DIERR",$J)
Q
;
STATUSQ ;
D PAUSE^VALM1
S VALMBCK="R"
Q
;
COM ; Enter/Edit Review Comments
; IBA - EOB ien
N DA,DIC,X,Y,DO,DD,DLAYGO,IBDA,IB0,IBNEW,IBCOM
D FULL^VALM1
W !
S (IBDA(1),DA(1))=+$P(IBA,U,2)
L +^IBM(361,IBDA(1)):3 I '$T D G COMQ
. W !,*7,"Sorry, another user currently editing this entry."
. D PAUSE^VALM1
;
S Z=0 F S Z=$O(^IBM(361,IBDA(1),2,Z)) Q:'Z I $P($G(^(Z,0)),U,2)=DUZ S IBCOM(DUZ,Z)=""
S IBNEW=0
I '$D(IBCOM(DUZ)) D
. N DO,DD,DIC,DLAYGO,DIR,X,Y
. S DIR(0)="YA",DIR("B")="YES",DIR("A",1)="There are no comments previously entered by you",DIR("A")="Do you want to add a new comment?: "
. S DIR("?",1)="You are only allowed to edit your own comments."
. S DIR("?")="You may enter a new comment here."
. D ^DIR K DIR
. W !
. I Y'=1 S IBDA=-1 Q
. D ADDCOM(.IBDA,.DUZ,.IBCOM)
;
E D
. S DIC="^IBM(361,"_IBDA(1)_",2,",DIC("S")="I $P(^(0),U,2)=DUZ",DIC(0)="AEMQ",DIC("A")="Select REVIEW DATE to edit or press ENTER to add a new comment: " D ^DIC K DIC S IBDA=+Y
. I IBDA>0 D Q ;User selected an existing entry
.. D ADDCOM(.IBDA,.DUZ,.IBCOM,1)
.. I $D(^IBM(361,IBDA(1),2,IBDA)),'$O(^IBM(361,IBDA(1),2,IBDA,1,0)) D KILLREV(.IBDA)
. S DIR(0)="YAO",DIR("A")="DO YOU WANT TO ADD A NEW REVIEW COMMENT?: ",DIR("B")="NO" D ^DIR K DIR Q:Y'=1
. D ADDCOM(.IBDA,.DUZ,.IBCOM)
L -^IBM(361,IBDA(1))
G:IBDA'>0 COMQ
D PAUSE^VALM1
D HDR,INIT
COMQ S VALMBCK="R"
Q
;
ADDCOM(IBDA,DUZ,IBCOM,ADD) ; Add review comment to file 361
; IBDA = array containing the DA references for the file add -
; pass by reference
; DUZ = ien of the user
; ADD = flag when set to 1 says the review date exists,
; just allow comment entry
; Returns IBDA = the entry # of the comment
; and IBCOM array referencing any comments added by the user
;
N DA,DIC,DD,DO,DLAYGO,X,Y
S DR=$S($G(DUZ):".02////"_DUZ_";",1:"")_".03"
I '$G(ADD) D
. K DO,DD
. S DIC="^IBM(361,"_IBDA(1)_",2,",DA(1)=IBDA(1),X=$$NOW^XLFDT
. W !,"New Review Date: "_$$FMTE^XLFDT(X,"2Z")
. S DIC("DR")=DR,DLAYGO=361.02
. S DIC(0)="L",DIC("P")=$$GETSPEC^IBEFUNC(361,2)
. D FILE^DICN K DIC,DD,DO,DLAYGO
. S IBDA=+Y
I IBDA>0 D
. I $G(ADD) S DIE="^IBM(361,"_IBDA(1)_",2,",DA(1)=IBDA(1),DA=IBDA D ^DIE
. I '$O(^IBM(361,IBDA(1),2,IBDA,0)) D KILLREV(.IBDA) Q
. S IBCOM(DUZ,IBDA)=""
Q
;
KILLREV(IBDA) ; Deletes a review date if no comments entered
N DA,DIK
S DA=IBDA,DA(1)=IBDA(1),DIK="^IBM(361,"_IBDA(1)_",2,"
K IBCOM(DUZ,IBDA)
D ^DIK
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCECSA2 9433 printed Apr 09, 2024@21:19:44 Page 2
IBCECSA2 ;ALB/CXW - IB CLAIMS STATUS AWAITING RESOLUTION SCREEN ;28-JUL-1999
+1 ;;2.0;INTEGRATED BILLING;**137,181,197,320**;21-MAR-1994
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; -- claims status awaiting resolution detail
+1 DO EN^VALM("IBCEM CSA MSG")
+2 QUIT
+3 ;
HDR ; -- header code
+1 ; IBA - EOB ien from summary selection
+2 NEW IBST,IBST0
+3 if '$GET(IBA)
QUIT
+4 SET IBST0=$GET(^IBM(361,+$PIECE(IBA,U,2),0))
SET IBST=$PIECE(IBST0,U,9)
+5 SET VALMHDR(2)="Message Status = "_$$EXPAND^IBTRE(361,.09,IBST)
+6 IF $PIECE(IBST0,U,14)
SET VALMHDR(2)=VALMHDR(2)_" (AUTOMATICALLY REVIEWED)"
+7 SET VALMHDR(1)=$JUSTIFY("",23)_"CLAIMS STATUS AWAITING RESOLUTION-DETAIL"
+8 QUIT
+9 ;
INIT ; -- init variables and list array
+1 NEW I,X,Y,Z,ZZ,IBZ,IBZ0,IBX,IBCNT
+2 KILL ^TMP("IBCECSC",$JOB)
SCR SET VALMCNT=0
SET IBCNT=1
+1 SET IBA=+$ORDER(IBDAX(0))
SET IBA=$GET(IBDAX(IBA))
+2 if IBA=""
QUIT
+3 SET X=""
+4 SET IBX=$SELECT($DATA(^TMP("IBCECSB",$JOB)):$GET(^TMP("IBCECSB",$JOB,$PIECE(IBA,U,3),$PIECE(IBA,U,4),$PIECE(IBA,U,6),$PIECE(IBA,U,2))),1:"")
+5 DO SETL1^IBCECSA1(IBX,.X)
+6 DO SET(X,IBCNT)
+7 ; blank line
DO SET("",IBCNT)
+8 ;
+9 SET X=$EXTRACT(" Svc Loc: "_$PIECE(IBX,U,7)_$JUSTIFY("",30),1,30)_$JUSTIFY("",14)_"Division: "_$EXTRACT($PIECE(IBX,U,8),1,26)
+10 DO SET(X,IBCNT)
+11 SET X=$EXTRACT(" Biller Name: "_$PIECE($PIECE(IBX,U,9),"~")_$JUSTIFY("",30),1,30)_$JUSTIFY("",10)_"Days Pending: "_$PIECE(IBX,U,11)
+12 DO SET(X,IBCNT)
+13 SET IBZ=$PIECE(IBA,U,2)
SET IBZ0=$GET(^IBM(361,IBZ,0))
+14 SET X=$EXTRACT(" Date Rec'd: "_$$FMTE^XLFDT($PIECE(IBZ0,U,2),"2Z")_$JUSTIFY("",30),1,30)_$JUSTIFY("",10)_"Dt Generated: "_$SELECT($PIECE(IBZ0,U,12):$$FMTE^XLFDT($PIECE(IBZ0,U,12),"2Z"),1:"")
+15 DO SET(X,IBCNT)
DO SET("",IBCNT)
+16 ;
+17 DO SET("Message Text:",IBCNT)
+18 SET X=0
FOR
SET X=$ORDER(^IBM(361,IBZ,1,X))
if 'X
QUIT
Begin DoDot:1
+19 SET Y=" "_$GET(^IBM(361,IBZ,1,X,0))
+20 DO SET(Y,IBCNT)
+21 QUIT
End DoDot:1
+22 DO SET("",IBCNT)
+23 ;
+24 SET ZZ=""
FOR
SET ZZ=$ORDER(^IBM(361,IBZ,2,"B",ZZ),-1)
if ZZ=""
QUIT
SET Z=0
FOR
SET Z=$ORDER(^IBM(361,IBZ,2,"B",ZZ,Z))
if 'Z
QUIT
Begin DoDot:1
+25 SET I=$GET(^IBM(361,IBZ,2,Z,0))
+26 SET Y=$$SETSTR^VALM1("Review Date: "_$$EXTERNAL^DILFD(361.02,.01,,ZZ),"",2,40)
+27 DO SET(Y,IBCNT)
+28 IF $PIECE(I,U,2)
SET Y=$$SETSTR^VALM1("Reviewed By: "_$PIECE($GET(^VA(200,+$PIECE(I,U,2),0)),U,1),"",2,70)
DO SET(Y,IBCNT)
+29 DO SET(" Comments:",IBCNT)
+30 SET X=0
FOR
SET X=$ORDER(^IBM(361,IBZ,2,Z,1,X))
if 'X
QUIT
Begin DoDot:2
+31 SET Y=" "_$GET(^IBM(361,IBZ,2,Z,1,X,0))
+32 DO SET(Y,IBCNT)
+33 QUIT
End DoDot:2
+34 DO SET("",IBCNT)
+35 QUIT
End DoDot:1
INITQ QUIT
+1 ;
HELP ; help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; exit code
+1 KILL ^TMP("IBCECSC",$JOB)
+2 DO CLEAN^VALM10
+3 QUIT
+4 ;
SET(X,CNT) ;
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBCECSC",$JOB,VALMCNT,0)=X
+3 SET ^TMP("IBCECSC",$JOB,"IDX",VALMCNT,CNT)=""
+4 SET ^TMP("IBCECSC",$JOB,CNT)=VALMCNT
+5 QUIT
+6 ;
UPDTX(IBDA,IBST) ; Update transmit bill record
+1 ; IBDA = ien of entry in 364
+2 ; IBST = status to stuff
+3 NEW X,Y,DR,DIE,DA
+4 SET DR=".03////"_IBST_";.04///NOW"
SET DA=IBDA
SET DIE="^IBA(364,"
if DA
DO ^DIE
+5 QUIT
+6 ;
STATUS ; Edit rev stat
+1 ;IBA - EOB ien
+2 NEW DA,DIE,DR,IBOLD,DIC,DO,DD,DLAYGO,IBDA,IBFINAL,IBO,IBNEW,IBFACT
+3 DO FULL^VALM1
+4 SET DIE="^IBM(361,"
+5 SET (IBDA,DA)=$PIECE(IBA,U,2)
+6 if 'DA
GOTO STATUSQ
+7 SET IBOLD=$PIECE($GET(^IBM(361,DA,0)),U,9)
SET IBFINAL=0
SET IBO=$SELECT(IBOLD'="":"/"_IBOLD,1:"@")
+8 SET DR="@1;.09;I +X<2 S IBFINAL=0,Y=""@99"";S IBFINAL=1;.1;I X="""" W !,""For a final status, this field is required"" S Y=""@98"";S Y=""@99"";@98;.09///"_IBO_";S Y=""@1"";@99"
+9 LOCK +^IBM(361,IBDA):3
IF '$TEST
Begin DoDot:1
+10 WRITE !,"Sorry, another user currently editing this entry (#"_IBDA_")."
End DoDot:1
GOTO STATUSQ
+11 DO ^DIE
+12 ;
+13 ;Final status selected - enter remarks
IF $GET(IBFINAL)
Begin DoDot:1
+14 NEW Z
+15 SET Z=IBDA
+16 NEW IBDA,Q,DIE,DR,DA,X,Y
+17 SET IBDA(1)=Z
SET IBDA=""
+18 DO ADDCOM(.IBDA,.DUZ,.IBCOM)
+19 ; Require remarks for 'OTHER ACTION' final status
IF $PIECE($GET(^IBM(361,IBDA(1),0)),U,10)="O"
IF '$ORDER(^IBM(361,IBDA(1),2,+IBDA,0))
Begin DoDot:2
+20 WRITE !,"Since OTHER ACTION final status was selected, you must enter a",!," comment explaining the OTHER ACTION"
DO ADDCOM(.IBDA,.DUZ,.IBCOM,1)
+21 IF IBDA
Begin DoDot:3
+22 ; Delete entry without a comment
+23 DO KILLREV(.IBDA)
End DoDot:3
+24 IF '$ORDER(^IBM(361,IBDA(1),2,+IBDA,0))
SET DIE="^IBM(361,"
SET DA=IBDA(1)
SET DR=".20///@;.09///"_IBO
DO ^DIE
WRITE !,"The review status was not changed because no comment was entered",!
QUIT
End DoDot:2
End DoDot:1
+25 SET IBNEW=$PIECE($GET(^IBM(361,DA,0)),U,9)
+26 ;if time out-no change in review status
+27 SET IBFACT=$PIECE($GET(^IBM(361,DA,0)),U,10)
+28 IF $GET(IBFINAL)
IF IBFACT=""
IF IBNEW>1
Begin DoDot:1
+29 WRITE !,"The review status was not changed because no final status was selected"
+30 SET DR=".09////"_IBOLD
SET DIE="^IBM(361,"
DO ^DIE
End DoDot:1
GOTO STATUSQ
+31 IF IBNEW>1
IF $PIECE(^IBM(361,DA,0),U,11)
Begin DoDot:1
+32 IF "CR"'[IBFACT
Begin DoDot:2
+33 WRITE !,"NO FURTHER ACTION WILL BE ALLOWED REGARDING THIS ELECTRONIC MESSAGE"
+34 IF $$PRINTUPD^IBCEU0("",$PIECE(^IBM(361,DA,0),U,11))
Begin DoDot:3
+35 WRITE !," SINCE THIS CLAIM WAS PRINTED AT THE CLEARINGHOUSE"
+36 SET IBFACT="N"
End DoDot:3
QUIT
+37 SET DIR(0)="YA"
SET DIR("A")="IS THIS THE FINAL ELECTRONIC MESSAGE YOU EXPECT TO RECEIVE FOR THIS BILL?: "
SET DIR("B")="NO"
+38 SET DIR("?",1)="If you respond YES to this prompt, the transmit status of this bill will"
SET DIR("?",2)=" be set to CLOSED. No further electronic processing of this bill will be"
+39 SET DIR("?",3)=" allowed. If you respond NO to this prompt, this electronic message will"
SET DIR("?",4)=" be filed as reviewed, but the bill's transmit status will not be changed."
+40 SET DIR("?",5)=" You may wish to periodically print a list of bills with a non-final"
SET DIR("?",6)=" (closed/cancelled/etc) status to ensure the electronic processing of all"
+41 SET DIR("?",7)=" bills has been completed. Closing the transmit bill record here will"
SET DIR("?")=" eliminate the bill from this list."
+42 WRITE !
DO ^DIR
KILL DIR
WRITE !
+43 if Y'=1
QUIT
+44 SET DIR("A",1)="SINCE YOU HAVE INDICATED THIS BILL HAS RECEIVED ITS FINAL ELECTRONIC MESSAGE"
SET DIR("A",2)=" AND NO FURTHER ACTION WILL BE TAKEN ON IT, THE STATUS OF THE TRANSMIT"
SET DIR("A",3)=" RECORD FOR THIS BILL WILL BE CHANGED TO CLOSED"
+45 SET DIR("A")="IS THIS WHAT YOU MEANT TO DO?: "
SET DIR("B")="YES"
SET DIR(0)="YA"
WRITE !
DO ^DIR
WRITE !
KILL DIR
+46 if Y'=1
QUIT
+47 SET IBFACT="N"
End DoDot:2
+48 IF "NCR"[IBFACT
DO UPDEDI^IBCEM(+$PIECE(^IBM(361,DA,0),U,11),IBFACT)
QUIT
End DoDot:1
+49 SET $PIECE(IBX,U,12)=$SELECT(IBNEW=1:"*",1:"")
+50 ;Note the change and who made it
IF IBOLD'=IBNEW
Begin DoDot:1
+51 DO NOTECHG(IBDA,0)
DO HDR
DO INIT
End DoDot:1
+52 LOCK -^IBM(361,DA)
+53 SET VALMBCK="R"
+54 QUIT
+55 ;
NOTECHG(IBDA,IBAUTO,IBNTEXT,IBUSER) ; Enter who/when review stat change was entered
+1 ; IBDA = ien of entry in file 361
+2 ; IBAUTO = flag to say auto-review was used (1=used, 0=not used)
+3 ; IBNTEXT = array containing the lines of text to store if not using the
+4 ; default text IBNTEXT = # of lines
+5 ; IBUSER = flag which says to also stuff the .02 reviewed by field
+6 NEW IBIEN,IBTEXT,DA,X,Y,DIC,DO,DLAYGO,DD
+7 SET DA(1)=IBDA
SET DIC="^IBM(361,"_DA(1)_",2,"
SET DIC(0)="L"
SET DLAYGO=361.02
+8 SET X=$$NOW^XLFDT
+9 IF $GET(IBUSER)
IF $GET(DUZ)
SET DIC("DR")=".02////"_$GET(DUZ)
+10 DO FILE^DICN
KILL DIC,DD,DO,DLAYGO
+11 if Y'>0
QUIT
+12 SET DA(2)=DA(1)
SET DA(1)=+Y
SET IBIEN=DA(1)_","_DA(2)_","
+13 IF $GET(IBNTEXT)
Begin DoDot:1
+14 MERGE IBTEXT=IBNTEXT
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 SET IBTEXT(1)="REVIEW STATUS "_$SELECT($GET(IBAUTO):"AUTOMATICALLY ",1:"")_"CHANGED TO '"_$$EXTERNAL^DILFD(361,.09,,$PIECE(^IBM(361,DA(2),0),U,9))_"' BY: "_$$EXTERNAL^DILFD(361.02,.02,,+$GET(DUZ))
End DoDot:1
+17 DO WP^DIE(361.02,IBIEN,.03,,"IBTEXT")
KILL ^TMP("DIERR",$JOB)
+18 QUIT
+19 ;
STATUSQ ;
+1 DO PAUSE^VALM1
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
COM ; Enter/Edit Review Comments
+1 ; IBA - EOB ien
+2 NEW DA,DIC,X,Y,DO,DD,DLAYGO,IBDA,IB0,IBNEW,IBCOM
+3 DO FULL^VALM1
+4 WRITE !
+5 SET (IBDA(1),DA(1))=+$PIECE(IBA,U,2)
+6 LOCK +^IBM(361,IBDA(1)):3
IF '$TEST
Begin DoDot:1
+7 WRITE !,*7,"Sorry, another user currently editing this entry."
+8 DO PAUSE^VALM1
End DoDot:1
GOTO COMQ
+9 ;
+10 SET Z=0
FOR
SET Z=$ORDER(^IBM(361,IBDA(1),2,Z))
if 'Z
QUIT
IF $PIECE($GET(^(Z,0)),U,2)=DUZ
SET IBCOM(DUZ,Z)=""
+11 SET IBNEW=0
+12 IF '$DATA(IBCOM(DUZ))
Begin DoDot:1
+13 NEW DO,DD,DIC,DLAYGO,DIR,X,Y
+14 SET DIR(0)="YA"
SET DIR("B")="YES"
SET DIR("A",1)="There are no comments previously entered by you"
SET DIR("A")="Do you want to add a new comment?: "
+15 SET DIR("?",1)="You are only allowed to edit your own comments."
+16 SET DIR("?")="You may enter a new comment here."
+17 DO ^DIR
KILL DIR
+18 WRITE !
+19 IF Y'=1
SET IBDA=-1
QUIT
+20 DO ADDCOM(.IBDA,.DUZ,.IBCOM)
End DoDot:1
+21 ;
+22 IF '$TEST
Begin DoDot:1
+23 SET DIC="^IBM(361,"_IBDA(1)_",2,"
SET DIC("S")="I $P(^(0),U,2)=DUZ"
SET DIC(0)="AEMQ"
SET DIC("A")="Select REVIEW DATE to edit or press ENTER to add a new comment: "
DO ^DIC
KILL DIC
SET IBDA=+Y
+24 ;User selected an existing entry
IF IBDA>0
Begin DoDot:2
+25 DO ADDCOM(.IBDA,.DUZ,.IBCOM,1)
+26 IF $DATA(^IBM(361,IBDA(1),2,IBDA))
IF '$ORDER(^IBM(361,IBDA(1),2,IBDA,1,0))
DO KILLREV(.IBDA)
End DoDot:2
QUIT
+27 SET DIR(0)="YAO"
SET DIR("A")="DO YOU WANT TO ADD A NEW REVIEW COMMENT?: "
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if Y'=1
QUIT
+28 DO ADDCOM(.IBDA,.DUZ,.IBCOM)
End DoDot:1
+29 LOCK -^IBM(361,IBDA(1))
+30 if IBDA'>0
GOTO COMQ
+31 DO PAUSE^VALM1
+32 DO HDR
DO INIT
COMQ SET VALMBCK="R"
+1 QUIT
+2 ;
ADDCOM(IBDA,DUZ,IBCOM,ADD) ; Add review comment to file 361
+1 ; IBDA = array containing the DA references for the file add -
+2 ; pass by reference
+3 ; DUZ = ien of the user
+4 ; ADD = flag when set to 1 says the review date exists,
+5 ; just allow comment entry
+6 ; Returns IBDA = the entry # of the comment
+7 ; and IBCOM array referencing any comments added by the user
+8 ;
+9 NEW DA,DIC,DD,DO,DLAYGO,X,Y
+10 SET DR=$SELECT($GET(DUZ):".02////"_DUZ_";",1:"")_".03"
+11 IF '$GET(ADD)
Begin DoDot:1
+12 KILL DO,DD
+13 SET DIC="^IBM(361,"_IBDA(1)_",2,"
SET DA(1)=IBDA(1)
SET X=$$NOW^XLFDT
+14 WRITE !,"New Review Date: "_$$FMTE^XLFDT(X,"2Z")
+15 SET DIC("DR")=DR
SET DLAYGO=361.02
+16 SET DIC(0)="L"
SET DIC("P")=$$GETSPEC^IBEFUNC(361,2)
+17 DO FILE^DICN
KILL DIC,DD,DO,DLAYGO
+18 SET IBDA=+Y
End DoDot:1
+19 IF IBDA>0
Begin DoDot:1
+20 IF $GET(ADD)
SET DIE="^IBM(361,"_IBDA(1)_",2,"
SET DA(1)=IBDA(1)
SET DA=IBDA
DO ^DIE
+21 IF '$ORDER(^IBM(361,IBDA(1),2,IBDA,0))
DO KILLREV(.IBDA)
QUIT
+22 SET IBCOM(DUZ,IBDA)=""
End DoDot:1
+23 QUIT
+24 ;
KILLREV(IBDA) ; Deletes a review date if no comments entered
+1 NEW DA,DIK
+2 SET DA=IBDA
SET DA(1)=IBDA(1)
SET DIK="^IBM(361,"_IBDA(1)_",2,"
+3 KILL IBCOM(DUZ,IBDA)
+4 DO ^DIK
+5 QUIT
+6 ;
