Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEMCA1

IBCEMCA1.m

Go to the documentation of this file. 
  1. IBCEMCA1 ;ALB/ESG - Multiple CSA Message Management - Actions ;20-SEP-2005
  1.  ;;2.0;INTEGRATED BILLING;**320,718**;21-MAR-1994;Build 73
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  Q
  1. REVSTAT ; change review status
  1.  NEW DIR,X,Y,DA,DIRUT,DIROUT,DTOUT,DUOUT,NS,IBRVUST,IBFNRVAC,IBRVCMT
  1.  NEW DIC,DWLW,DWPK,DIWESUB,DIWETXT,LN,IBDA,IBOLD,DIE,DA,DR
  1.  D FULL^VALM1
  1.  S NS=+$G(^TMP($J,"IBCEMCL",4))
  1.  I 'NS D  G REVSTATX
  1.  . W !!?5,"There are no selected messages." D PAUSE^VALM1
  1.  . Q
  1.  ;
  1.  W !!?5,"Number of messages selected:  ",NS,!
  1.  ;
  1.  ; reader call for the new review status field
  1.  S DIR(0)="361,.09"
  1.  S DIR("A")="Enter the REVIEW STATUS for the selected message"_$S(NS>1:"s",1:"")
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) G REVSTATX
  1.  M IBRVUST=Y
  1.  I IBRVUST'=2 G RVCQ    ; skip down to the confirmation
  1.  ;
  1. RSQ2 ; Reader call for the final review action field
  1.  W !
  1.  S DIR(0)="361,.1"
  1.  S DIR("A")="Enter the FINAL REVIEW ACTION for the selected message"_$S(NS>1:"s",1:"")
  1.  D ^DIR K DIR
  1.  I X="",Y="" W !!?5,"This field is required when the review has been completed." G RSQ2
  1.  I $D(DIRUT) G REVSTATX
  1.  M IBFNRVAC=Y
  1.  ;
  1. RSQ3 ; review comment text
  1.  W !
  1.  K ^TMP($J,"IBCEMCA1-COMMENTS"),IBRVCMT
  1.  S DIC="^TMP($J,""IBCEMCA1-COMMENTS"","
  1.  S DWLW=75,DWPK=1,DIWESUB="REVIEW COMMENTS"
  1.  S DIWETXT="These comments are optional"
  1.  I IBFNRVAC="O" S DIWETXT="These comments are required because OTHER ACTION was selected."
  1.  D EN^DIWE
  1.  M IBRVCMT=^TMP($J,"IBCEMCA1-COMMENTS")
  1.  K ^TMP($J,"IBCEMCA1-COMMENTS")
  1.  I IBFNRVAC="O",'$D(IBRVCMT(0)) D  G RSQ3
  1.  . W !!?5,"Comments are required when the Final Review Action is OTHER ACTION."
  1.  . D PAUSE^VALM1
  1.  . Q
  1.  I $P($G(IBRVCMT(0)),U,4) S IBRVCMT=$P($G(IBRVCMT(0)),U,4)
  1.  ;
  1. RVCQ ; display a summary of the user responses and get confirmation
  1.  W !!,"  Number of selected",!,"     Status Messages:  ",NS
  1.  W !?7,"Review Status:  ",$G(IBRVUST(0))
  1.  I IBRVUST=2 D
  1.  . W !," Final Review Action:  ",$G(IBFNRVAC(0))
  1.  . W !?5,"Review Comments:  "
  1.  . I '$D(IBRVCMT(0)) W "<none>"
  1.  . E  S LN=0 F  S LN=$O(IBRVCMT(LN)) Q:'LN  W !?5,IBRVCMT(LN,0)
  1.  . Q
  1.  W !
  1.  S DIR(0)="YO"
  1.  S DIR("A")="OK to proceed",DIR("B")="No"
  1.  D ^DIR K DIR
  1.  I Y'=1 G REVSTATX
  1.  ;
  1.  ; Loop thru selected status messages and update them
  1.  S IBDA=0
  1.  F  S IBDA=$O(^TMP($J,"IBCEMCL",4,1,IBDA)) Q:'IBDA  D
  1.  . S IBOLD=$P($G(^IBM(361,IBDA,0)),U,9)    ; old review status
  1.  . S DIE=361,DA=IBDA
  1.  . S DR=".09////"_IBRVUST
  1.  . I $G(IBFNRVAC)'="" S DR=DR_";.1////"_$G(IBFNRVAC)
  1.  . D ^DIE
  1.  . I $D(IBRVCMT(0)) D NOTECHG^IBCECSA2(IBDA,0,.IBRVCMT,1)
  1.  . I IBOLD'=IBRVUST D NOTECHG^IBCECSA2(IBDA,0)
  1.  . L -^IBM(361,IBDA)       ; unlock
  1.  . Q
  1.  W "   ... Done!"
  1.  ;
  1.  ; rebuild the list
  1.  KILL ^TMP($J,"IBCEMCA"),VALMHDR
  1.  S VALMBG=1
  1.  D INIT^IBCEMCL
  1.  I $G(IBCSAMCS)=1 S IBCSAMCS=2   ; flag to rebuild CSA
  1.  ;
  1. REVSTATX ;
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. COMMENT ; enter review comments
  1.  NEW NS,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBRVCMT,DIC,DWLW,DWPK,DIWESUB,IBDA,LN
  1.  D FULL^VALM1
  1.  S NS=+$G(^TMP($J,"IBCEMCL",4))
  1.  I 'NS D  G COMMX
  1.  . W !!?5,"There are no selected messages." D PAUSE^VALM1
  1.  . Q
  1.  ;
  1.  W !!?5,"Number of messages selected:  ",NS,!
  1.  ;
  1.  S DIR(0)="YO",DIR("B")="Yes"
  1.  S DIR("A")="Do you want to add a new Review Comment for all of these messages"
  1.  I NS=1 S DIR("A")="Do you want to add a new Review Comment for this message"
  1.  D ^DIR K DIR
  1.  I Y'=1 G COMMX
  1.  ;
  1.  ; review comment text
  1.  W !
  1.  K ^TMP($J,"IBCEMCA1-COMMENTS"),IBRVCMT
  1.  S DIC="^TMP($J,""IBCEMCA1-COMMENTS"","
  1.  S DWLW=75,DWPK=1,DIWESUB="REVIEW COMMENTS"
  1.  D EN^DIWE
  1.  M IBRVCMT=^TMP($J,"IBCEMCA1-COMMENTS")
  1.  K ^TMP($J,"IBCEMCA1-COMMENTS")
  1.  I $P($G(IBRVCMT(0)),U,4) S IBRVCMT=$P($G(IBRVCMT(0)),U,4)
  1.  I '$D(IBRVCMT(0)) G COMMX    ; no comments entered
  1.  ;
  1.  ; final confirmation
  1.  W !
  1.  S LN=0 F  S LN=$O(IBRVCMT(LN)) Q:'LN  W !?5,IBRVCMT(LN,0)
  1.  W !
  1.  S DIR(0)="YO"
  1.  S DIR("A")="OK to add this comment for all selected status messages",DIR("B")="No"
  1.  I NS=1 S DIR("A")="OK to add this comment for the selected status message"
  1.  D ^DIR K DIR
  1.  I Y'=1 G COMMX
  1.  ;
  1.  ; Loop thru selected status messages and update them
  1.  S IBDA=0
  1.  F  S IBDA=$O(^TMP($J,"IBCEMCL",4,1,IBDA)) Q:'IBDA  D
  1.  . D NOTECHG^IBCECSA2(IBDA,0,.IBRVCMT,1)
  1.  . L -^IBM(361,IBDA)       ; unlock
  1.  . Q
  1.  W "   ... Done!"
  1.  ;
  1.  ; rebuild the list
  1.  KILL ^TMP($J,"IBCEMCA"),VALMHDR
  1.  S VALMBG=1
  1.  D INIT^IBCEMCL
  1.  ;
  1. COMMX ;
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. RETRAN ; retransmit claims
  1.  NEW NS,IBIFN,NSC,DIR,X,Y,DUOUT,DTOUT,DIRUT,DIROUT,IBDA,IB364
  1.  D FULL^VALM1
  1.  S NS=+$G(^TMP($J,"IBCEMCL",4))
  1.  I 'NS D  G RETRANX
  1.  . W !!?5,"There are no selected messages." D PAUSE^VALM1
  1.  . Q
  1.  ;
  1.  ; count number of claims too
  1.  S IBIFN=0 F NSC=0:1 S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN
  1.  ;
  1.  W !!?5,"Number of messages selected:  ",NS
  1.  W !?7,"Number of claims selected:  ",NSC,!
  1.  ;
  1.  S DIR("A",1)="In order to retransmit these claims, the transmission status for all of these"
  1.  S DIR("A",2)="claims will be reset to be ""READY FOR EXTRACT"".  These claims will then be"
  1.  S DIR("A",3)="sent with the next regularly scheduled claims transmission process."
  1.  S DIR("A",4)=""
  1.  S DIR("A")="Do you want to retransmit these claims"
  1.  I NSC=1 D
  1.  . S DIR("A",1)="In order to retransmit this claim, the transmission status for this claim will"
  1.  . S DIR("A",2)="be reset to be ""READY FOR EXTRACT"".  This claim will then be sent with the"
  1.  . S DIR("A",3)="next regularly scheduled claims transmission process."
  1.  . S DIR("A")="Do you want to retransmit this claim"
  1.  . Q
  1.  S DIR(0)="YO",DIR("B")="No" D ^DIR K DIR
  1.  I Y'=1 G RETRANX
  1.  ;
  1.  ; Loop thru selected claims and add new transmission records in a
  1.  ; "Ready to Extract" status
  1.  S IBIFN=0
  1.  F  S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN  D
  1.  . S IBDA=+$O(^TMP($J,"IBCEMCL",4,2,IBIFN,""),-1)  ; most recent 361 ien
  1.  . S IB364=+$P($G(^IBM(361,IBDA,0)),U,11)          ; transmit bill 364 ien
  1.  . I 'IBDA!'IB364 Q
  1.  . D UPDEDI^IBCEM(IB364,"R")        ; update EDI files for transmission
  1.  . ;JWS;IB*2.0*718;EBILL-2653;add parameter to set [10] of 364 entry for claim resubmission
  1.  . S Y=$$ADDTBILL^IBCB1(IBIFN,1,1)    ; add new transmission record
  1.  . Q
  1.  W "   ... Done!"
  1.  ;
  1.  ; rebuild the list
  1.  KILL ^TMP($J,"IBCEMCA"),VALMHDR
  1.  S VALMBG=1
  1.  D UNLOCK^IBCEMCL
  1.  D INIT^IBCEMCL
  1.  I $G(IBCSAMCS)=1 S IBCSAMCS=2   ; flag to rebuild CSA
  1.  ;
  1. RETRANX ;
  1.  S VALMBCK="R"
  1.  Q
  1.  ;