- 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 Feb 18, 2025@23:36:10 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 ;