IBJTA1 ;ALB/ARH - TPI ACTIONS ;2/14/95
 ;;2.0;INTEGRATED BILLING;**39,137,377**;21-MAR-94;Build 23
 ;;Per VHA Directive 2004-038, this routine should not be modified.
 ;
CP ; -- IBJT CHANGE PATIENT action: change patient, only available on AL screen
 ;    user selects new patient, then Active Bills screen rebuilt with that patients active bills
 N VALMQUIT,IBDFN
 D FULL^VALM1
 S IBDFN=DFN S DFN=+$$PAT^IBJTU2 I 'DFN S DFN=IBDFN
 K ^TMP("IBJTLA",$J),^TMP("IBJTLAX",$J)
 D BLDA^IBJTLA1,HDR^IBJTLA
 S VALMBCK="R",VALMBG=1
CPQ Q
 ;
CB ; -- IBJT CHANGE BILL action: change bill, only available on CI screen
 ;    user enters new bill number then Claim Info screen rebuilt/redisplayed for that bill
 ;    if option entered through Active List screen then only allows bills for current patient
 N VALMQUIT,IBIFN1,IBDFN1
 D FULL^VALM1
 S IBDFN1=DFN,IBIFN1=IBIFN
 I $D(^TMP("IBJTLA",$J)) S DIC("S")="I $P(^(0),U,2)="_DFN
 S IBIFN=+$$BILL^IBJTU2 I 'IBIFN S IBIFN=IBIFN1
 S DFN=$P(^DGCR(399,+IBIFN,0),U,2)
 D CLEAN^VALM10 K IBXSAVE,IBXDATA D BLD^IBJTCA1,HDR^IBJTCA
 S VALMBCK="R",VALMBG=1
CBQ Q
 ;
CDI ; -- IBJT CHANGE DATES INACTIVE action: Change Date range for Inactive screen
 ;    user enters end date for search for inactive bills for a patient, Inactive Bills screen then rebuilt with
 ;    inactive bills for the patient and new date range,  IBEND passed to screen build
 ;    if IBBEG is defined the day before is used as the default end date, otherwise, today
 ;    this way the defaults will work backwards until end of bills, then restarts with today
 D FULL^VALM1
 S DIR("?",1)="Enter most recent date to include in list."
 S DIR("?")="A search for inactive bills for this patient will begin on the date entered and go back at least 6 months into the past.  If the patient has few bills then the search may span more than six months."
 S DIR("B")=$S(+$G(IBBEG):$$DATE^IBJU1($$FMADD^XLFDT(IBBEG,-1)),1:"TODAY")
 S DIR(0)="DO^::EX",DIR("A")="End Date"
 D ^DIR K DIR I 'Y!($D(DIRUT))!(Y=$G(IBEND)) S VALMSG="Date range was not changed." G CDIQ
 K ^TMP("IBJTLB",$J),^TMP("IBJTLBX",$J)
 S IBEND=Y D BLDA^IBJTLB1,HDR^IBJTLB
CDIQ S VALMBCK="R",VALMBG=1
 K VALMB,VALMBEG,VALMEND,DIRUT
 Q
 ;
ARCA ;  -- IBJT AR COMMENT ADD action:  add a comment transaction to the AR account, IBIFN required
 ;     IBARCOMM set to indicate AR Profile screen needs to be rebuilt when it is reentered
 ;     will cause the AR screen to be rebuilt including the new information if the AR screen is already open
 N AUTHDT,MRADT,STATUS,VALMQUIT,DIR
 D FULL^VALM1
 S STATUS=$P($G(^DGCR(399,IBIFN,0)),U,13)
 S AUTHDT=$P($G(^DGCR(399,IBIFN,"S")),U,10)
 S MRADT=$P($G(^DGCR(399,IBIFN,"S")),U,7)
 ; if claim status is "NOT REVIEWED" or claim status is "CANCELLED" with neither MRA request date
 ; nor Authorization date present, display an error and bail out.
 I STATUS=1!(STATUS=7&(MRADT="")&(AUTHDT="")) D  G ARCAQ
 .S DIR(0)="EA",DIR("A",1)="A comment can not be added for an incomplete or cancelled while incomplete claim.",DIR("A")="Press RETURN to continue: " D ^DIR K DIR
 ; if claim status is "REQUEST MRA" or claim status is "CANCELLED" with MRA request date present,
 ; but no Authorization date, enter MRA comments.
 I STATUS=2!(STATUS=7&(MRADT'="")&(AUTHDT="")) D:$G(IBIFN) CMNT^IBCECOB6 G ARCAR
 ; otherwise, enter AR comments.
 D ADJUST^RCJIBFN3(IBIFN)
 I $D(^TMP("IBJTTA",$J)) S IBARCOMM=1
 K ^TMP("IBJTTC",$J)
ARCAR ; rebuild comments screen
 D BLD^IBJTTC,HDR^IBJTTC
ARCAQ S VALMBCK="R",VALMBG=1
 Q
 ;
HS ; -- IBJT HS HEALTH SUMMARY action: health summary (inpt (350.9,2.08), outpt (350.9,2.09))
 ;    if a Health Summary has been defined for the type of care (Inpt/Outpt) it is printed to the screen
 ;    type of care is taken from the current bill if there is one otherwise the user is asked
 ;    requires HS 2.5 or greater, if 2.7 is available then a date range can be used
 ;    if date range used it is taken from the current bill if available otherwise askes user
 N X,Y,IBX,IBHS,DIR,DIRUT,IBIOPT,IBDT1,IBDT2,IBHSVER
 S (IBIOPT,IBHS)=0,IBHSVER=$$VERSION^XPDUTL("HEALTH SUMMARY")
 I IBHSVER<2.5 S VALMSG="Health Summary package not available." G HSQ
 D FULL^VALM1
 I +$G(IBIFN) D  I 'IBIOPT G HSQ
 . S IBX=$G(^DGCR(399,+IBIFN,0)) I '$G(DFN) S DFN=$P(IBX,U,2) I 'DFN Q
 . S IBIOPT=$S($P(IBX,U,5)<1:0,$P(IBX,U,5)<3:1,1:2)
 . S IBDT1=$G(^DGCR(399,+IBIFN,"U")),IBDT2=$P(IBDT1,U,2),IBDT1=+IBDT1
 ;
 I '$G(IBIFN) D  I 'IBIOPT G HSQ
 . S DIR(0)="SOB^I:Inpatient;O:Outpatient",DIR("A")="Inpatient or Outpatient Health Summary?" D ^DIR K DIR
 . S IBIOPT=$S(Y="I":1,Y="O":2,1:0) Q:'IBIOPT
 . ;
 . Q:IBHSVER<2.7
 . W !!,"Enter the date range the Health Summary should cover."
 . S IBDT1=$$DR^IBJTU2($$FMADD^XLFDT(DT,-365),DT),IBDT2=$P(IBDT1,U,2),IBDT1=+IBDT1
 ;
 S IBX=$G(^IBE(350.9,1,2)),IBHS=$S(IBIOPT=1:$P(IBX,U,8),1:$P(IBX,U,9))
 ;
 I 'IBHS S VALMSG="No Health Summary Type chosen for "_$S(IBIOPT=1:"In",1:"Out")_"patient." G HSQ
 I IBHSVER<2.7 D ENX^GMTSDVR(DFN,IBHS) G HSQ
 D ENX^GMTSDVR(DFN,IBHS,IBDT1,IBDT2)
HSQ S VALMBCK="R"
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTA1   5116     printed  Sep 23, 2025@20:00:01                                                                                                                                                                                                      Page 2
IBJTA1    ;ALB/ARH - TPI ACTIONS ;2/14/95
 +1       ;;2.0;INTEGRATED BILLING;**39,137,377**;21-MAR-94;Build 23
 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.
 +3       ;
CP        ; -- IBJT CHANGE PATIENT action: change patient, only available on AL screen
 +1       ;    user selects new patient, then Active Bills screen rebuilt with that patients active bills
 +2        NEW VALMQUIT,IBDFN
 +3        DO FULL^VALM1
 +4        SET IBDFN=DFN
           SET DFN=+$$PAT^IBJTU2
           IF 'DFN
               SET DFN=IBDFN
 +5        KILL ^TMP("IBJTLA",$JOB),^TMP("IBJTLAX",$JOB)
 +6        DO BLDA^IBJTLA1
           DO HDR^IBJTLA
 +7        SET VALMBCK="R"
           SET VALMBG=1
CPQ        QUIT 
 +1       ;
CB        ; -- IBJT CHANGE BILL action: change bill, only available on CI screen
 +1       ;    user enters new bill number then Claim Info screen rebuilt/redisplayed for that bill
 +2       ;    if option entered through Active List screen then only allows bills for current patient
 +3        NEW VALMQUIT,IBIFN1,IBDFN1
 +4        DO FULL^VALM1
 +5        SET IBDFN1=DFN
           SET IBIFN1=IBIFN
 +6        IF $DATA(^TMP("IBJTLA",$JOB))
               SET DIC("S")="I $P(^(0),U,2)="_DFN
 +7        SET IBIFN=+$$BILL^IBJTU2
           IF 'IBIFN
               SET IBIFN=IBIFN1
 +8        SET DFN=$PIECE(^DGCR(399,+IBIFN,0),U,2)
 +9        DO CLEAN^VALM10
           KILL IBXSAVE,IBXDATA
           DO BLD^IBJTCA1
           DO HDR^IBJTCA
 +10       SET VALMBCK="R"
           SET VALMBG=1
CBQ        QUIT 
 +1       ;
CDI       ; -- IBJT CHANGE DATES INACTIVE action: Change Date range for Inactive screen
 +1       ;    user enters end date for search for inactive bills for a patient, Inactive Bills screen then rebuilt with
 +2       ;    inactive bills for the patient and new date range,  IBEND passed to screen build
 +3       ;    if IBBEG is defined the day before is used as the default end date, otherwise, today
 +4       ;    this way the defaults will work backwards until end of bills, then restarts with today
 +5        DO FULL^VALM1
 +6        SET DIR("?",1)="Enter most recent date to include in list."
 +7        SET DIR("?")="A search for inactive bills for this patient will begin on the date entered and go back at least 6 months into the past.  If the patient has few bills then the search may span more than six months."
 +8        SET DIR("B")=$SELECT(+$GET(IBBEG):$$DATE^IBJU1($$FMADD^XLFDT(IBBEG,-1)),1:"TODAY")
 +9        SET DIR(0)="DO^::EX"
           SET DIR("A")="End Date"
 +10       DO ^DIR
           KILL DIR
           IF 'Y!($DATA(DIRUT))!(Y=$GET(IBEND))
               SET VALMSG="Date range was not changed."
               GOTO CDIQ
 +11       KILL ^TMP("IBJTLB",$JOB),^TMP("IBJTLBX",$JOB)
 +12       SET IBEND=Y
           DO BLDA^IBJTLB1
           DO HDR^IBJTLB
CDIQ       SET VALMBCK="R"
           SET VALMBG=1
 +1        KILL VALMB,VALMBEG,VALMEND,DIRUT
 +2        QUIT 
 +3       ;
ARCA      ;  -- IBJT AR COMMENT ADD action:  add a comment transaction to the AR account, IBIFN required
 +1       ;     IBARCOMM set to indicate AR Profile screen needs to be rebuilt when it is reentered
 +2       ;     will cause the AR screen to be rebuilt including the new information if the AR screen is already open
 +3        NEW AUTHDT,MRADT,STATUS,VALMQUIT,DIR
 +4        DO FULL^VALM1
 +5        SET STATUS=$PIECE($GET(^DGCR(399,IBIFN,0)),U,13)
 +6        SET AUTHDT=$PIECE($GET(^DGCR(399,IBIFN,"S")),U,10)
 +7        SET MRADT=$PIECE($GET(^DGCR(399,IBIFN,"S")),U,7)
 +8       ; if claim status is "NOT REVIEWED" or claim status is "CANCELLED" with neither MRA request date
 +9       ; nor Authorization date present, display an error and bail out.
 +10       IF STATUS=1!(STATUS=7&(MRADT="")&(AUTHDT=""))
               Begin DoDot:1
 +11               SET DIR(0)="EA"
                   SET DIR("A",1)="A comment can not be added for an incomplete or cancelled while incomplete claim."
                   SET DIR("A")="Press RETURN to continue: "
                   DO ^DIR
                   KILL DIR
               End DoDot:1
               GOTO ARCAQ
 +12      ; if claim status is "REQUEST MRA" or claim status is "CANCELLED" with MRA request date present,
 +13      ; but no Authorization date, enter MRA comments.
 +14       IF STATUS=2!(STATUS=7&(MRADT'="")&(AUTHDT=""))
               if $GET(IBIFN)
                   DO CMNT^IBCECOB6
               GOTO ARCAR
 +15      ; otherwise, enter AR comments.
 +16       DO ADJUST^RCJIBFN3(IBIFN)
 +17       IF $DATA(^TMP("IBJTTA",$JOB))
               SET IBARCOMM=1
 +18       KILL ^TMP("IBJTTC",$JOB)
ARCAR     ; rebuild comments screen
 +1        DO BLD^IBJTTC
           DO HDR^IBJTTC
ARCAQ      SET VALMBCK="R"
           SET VALMBG=1
 +1        QUIT 
 +2       ;
HS        ; -- IBJT HS HEALTH SUMMARY action: health summary (inpt (350.9,2.08), outpt (350.9,2.09))
 +1       ;    if a Health Summary has been defined for the type of care (Inpt/Outpt) it is printed to the screen
 +2       ;    type of care is taken from the current bill if there is one otherwise the user is asked
 +3       ;    requires HS 2.5 or greater, if 2.7 is available then a date range can be used
 +4       ;    if date range used it is taken from the current bill if available otherwise askes user
 +5        NEW X,Y,IBX,IBHS,DIR,DIRUT,IBIOPT,IBDT1,IBDT2,IBHSVER
 +6        SET (IBIOPT,IBHS)=0
           SET IBHSVER=$$VERSION^XPDUTL("HEALTH SUMMARY")
 +7        IF IBHSVER<2.5
               SET VALMSG="Health Summary package not available."
               GOTO HSQ
 +8        DO FULL^VALM1
 +9        IF +$GET(IBIFN)
               Begin DoDot:1
 +10               SET IBX=$GET(^DGCR(399,+IBIFN,0))
                   IF '$GET(DFN)
                       SET DFN=$PIECE(IBX,U,2)
                       IF 'DFN
                           QUIT 
 +11               SET IBIOPT=$SELECT($PIECE(IBX,U,5)<1:0,$PIECE(IBX,U,5)<3:1,1:2)
 +12               SET IBDT1=$GET(^DGCR(399,+IBIFN,"U"))
                   SET IBDT2=$PIECE(IBDT1,U,2)
                   SET IBDT1=+IBDT1
               End DoDot:1
               IF 'IBIOPT
                   GOTO HSQ
 +13      ;
 +14       IF '$GET(IBIFN)
               Begin DoDot:1
 +15               SET DIR(0)="SOB^I:Inpatient;O:Outpatient"
                   SET DIR("A")="Inpatient or Outpatient Health Summary?"
                   DO ^DIR
                   KILL DIR
 +16               SET IBIOPT=$SELECT(Y="I":1,Y="O":2,1:0)
                   if 'IBIOPT
                       QUIT 
 +17      ;
 +18               if IBHSVER<2.7
                       QUIT 
 +19               WRITE !!,"Enter the date range the Health Summary should cover."
 +20               SET IBDT1=$$DR^IBJTU2($$FMADD^XLFDT(DT,-365),DT)
                   SET IBDT2=$PIECE(IBDT1,U,2)
                   SET IBDT1=+IBDT1
               End DoDot:1
               IF 'IBIOPT
                   GOTO HSQ
 +21      ;
 +22       SET IBX=$GET(^IBE(350.9,1,2))
           SET IBHS=$SELECT(IBIOPT=1:$PIECE(IBX,U,8),1:$PIECE(IBX,U,9))
 +23      ;
 +24       IF 'IBHS
               SET VALMSG="No Health Summary Type chosen for "_$SELECT(IBIOPT=1:"In",1:"Out")_"patient."
               GOTO HSQ
 +25       IF IBHSVER<2.7
               DO ENX^GMTSDVR(DFN,IBHS)
               GOTO HSQ
 +26       DO ENX^GMTSDVR(DFN,IBHS,IBDT1,IBDT2)
HSQ        SET VALMBCK="R"
 +1        QUIT