- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJTA1.m
r613 r623 1 IBJTA1 ;ALB/ARH - TPI ACTIONS ;2/14/95 2 ;;2.0;INTEGRATED BILLING;**39,137,377**;21-MAR-94;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 CP ; -- IBJT CHANGE PATIENT action: change patient, only available on AL screen 6 ; user selects new patient, then Active Bills screen rebuilt with that patients active bills 7 N VALMQUIT,IBDFN 8 D FULL^VALM1 9 S IBDFN=DFN S DFN=+$$PAT^IBJTU2 I 'DFN S DFN=IBDFN 10 K ^TMP("IBJTLA",$J),^TMP("IBJTLAX",$J) 11 D BLDA^IBJTLA1,HDR^IBJTLA 12 S VALMBCK="R",VALMBG=1 13 CPQ Q 14 ; 15 CB ; -- IBJT CHANGE BILL action: change bill, only available on CI screen 16 ; user enters new bill number then Claim Info screen rebuilt/redisplayed for that bill 17 ; if option entered through Active List screen then only allows bills for current patient 18 N VALMQUIT,IBIFN1,IBDFN1 19 D FULL^VALM1 20 S IBDFN1=DFN,IBIFN1=IBIFN 21 I $D(^TMP("IBJTLA",$J)) S DIC("S")="I $P(^(0),U,2)="_DFN 22 S IBIFN=+$$BILL^IBJTU2 I 'IBIFN S IBIFN=IBIFN1 23 S DFN=$P(^DGCR(399,+IBIFN,0),U,2) 24 D CLEAN^VALM10 K IBXSAVE,IBXDATA D BLD^IBJTCA1,HDR^IBJTCA 25 S VALMBCK="R",VALMBG=1 26 CBQ Q 27 ; 28 CDI ; -- IBJT CHANGE DATES INACTIVE action: Change Date range for Inactive screen 29 ; user enters end date for search for inactive bills for a patient, Inactive Bills screen then rebuilt with 30 ; inactive bills for the patient and new date range, IBEND passed to screen build 31 ; if IBBEG is defined the day before is used as the default end date, otherwise, today 32 ; this way the defaults will work backwards until end of bills, then restarts with today 33 D FULL^VALM1 34 S DIR("?",1)="Enter most recent date to include in list." 35 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." 36 S DIR("B")=$S(+$G(IBBEG):$$DATE^IBJU1($$FMADD^XLFDT(IBBEG,-1)),1:"TODAY") 37 S DIR(0)="DO^::EX",DIR("A")="End Date" 38 D ^DIR K DIR I 'Y!($D(DIRUT))!(Y=$G(IBEND)) S VALMSG="Date range was not changed." G CDIQ 39 K ^TMP("IBJTLB",$J),^TMP("IBJTLBX",$J) 40 S IBEND=Y D BLDA^IBJTLB1,HDR^IBJTLB 41 CDIQ S VALMBCK="R",VALMBG=1 42 K VALMB,VALMBEG,VALMEND,DIRUT 43 Q 44 ; 45 ARCA ; -- IBJT AR COMMENT ADD action: add a comment transaction to the AR account, IBIFN required 46 ; IBARCOMM set to indicate AR Profile screen needs to be rebuilt when it is reentered 47 ; will cause the AR screen to be rebuilt including the new information if the AR screen is already open 48 N AUTHDT,MRADT,STATUS,VALMQUIT,DIR 49 D FULL^VALM1 50 S STATUS=$P($G(^DGCR(399,IBIFN,0)),U,13) 51 S AUTHDT=$P($G(^DGCR(399,IBIFN,"S")),U,10) 52 S MRADT=$P($G(^DGCR(399,IBIFN,"S")),U,7) 53 ; if claim status is "NOT REVIEWED" or claim status is "CANCELLED" with neither MRA request date 54 ; nor Authorization date present, display an error and bail out. 55 I STATUS=1!(STATUS=7&(MRADT="")&(AUTHDT="")) D G ARCAQ 56 .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 57 ; if claim status is "REQUEST MRA" or claim status is "CANCELLED" with MRA request date present, 58 ; but no Authorization date, enter MRA comments. 59 I STATUS=2!(STATUS=7&(MRADT'="")&(AUTHDT="")) D:$G(IBIFN) CMNT^IBCECOB6 G ARCAR 60 ; otherwise, enter AR comments. 61 D ADJUST^RCJIBFN3(IBIFN) 62 I $D(^TMP("IBJTTA",$J)) S IBARCOMM=1 63 K ^TMP("IBJTTC",$J) 64 ARCAR ; rebuild comments screen 65 D BLD^IBJTTC,HDR^IBJTTC 66 ARCAQ S VALMBCK="R",VALMBG=1 67 Q 68 ; 69 HS ; -- IBJT HS HEALTH SUMMARY action: health summary (inpt (350.9,2.08), outpt (350.9,2.09)) 70 ; if a Health Summary has been defined for the type of care (Inpt/Outpt) it is printed to the screen 71 ; type of care is taken from the current bill if there is one otherwise the user is asked 72 ; requires HS 2.5 or greater, if 2.7 is available then a date range can be used 73 ; if date range used it is taken from the current bill if available otherwise askes user 74 N X,Y,IBX,IBHS,DIR,DIRUT,IBIOPT,IBDT1,IBDT2,IBHSVER 75 S (IBIOPT,IBHS)=0,IBHSVER=$$VERSION^XPDUTL("HEALTH SUMMARY") 76 I IBHSVER<2.5 S VALMSG="Health Summary package not available." G HSQ 77 D FULL^VALM1 78 I +$G(IBIFN) D I 'IBIOPT G HSQ 79 . S IBX=$G(^DGCR(399,+IBIFN,0)) I '$G(DFN) S DFN=$P(IBX,U,2) I 'DFN Q 80 . S IBIOPT=$S($P(IBX,U,5)<1:0,$P(IBX,U,5)<3:1,1:2) 81 . S IBDT1=$G(^DGCR(399,+IBIFN,"U")),IBDT2=$P(IBDT1,U,2),IBDT1=+IBDT1 82 ; 83 I '$G(IBIFN) D I 'IBIOPT G HSQ 84 . S DIR(0)="SOB^I:Inpatient;O:Outpatient",DIR("A")="Inpatient or Outpatient Health Summary?" D ^DIR K DIR 85 . S IBIOPT=$S(Y="I":1,Y="O":2,1:0) Q:'IBIOPT 86 . ; 87 . Q:IBHSVER<2.7 88 . W !!,"Enter the date range the Health Summary should cover." 89 . S IBDT1=$$DR^IBJTU2($$FMADD^XLFDT(DT,-365),DT),IBDT2=$P(IBDT1,U,2),IBDT1=+IBDT1 90 ; 91 S IBX=$G(^IBE(350.9,1,2)),IBHS=$S(IBIOPT=1:$P(IBX,U,8),1:$P(IBX,U,9)) 92 ; 93 I 'IBHS S VALMSG="No Health Summary Type chosen for "_$S(IBIOPT=1:"In",1:"Out")_"patient." G HSQ 94 I IBHSVER<2.7 D ENX^GMTSDVR(DFN,IBHS) G HSQ 95 D ENX^GMTSDVR(DFN,IBHS,IBDT1,IBDT2) 96 HSQ S VALMBCK="R" 97 Q 1 IBJTA1 ;ALB/ARH - TPI ACTIONS ;2/14/95 2 ;;2.0;INTEGRATED BILLING;**39,137**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 CP ; -- IBJT CHANGE PATIENT action: change patient, only available on AL screen 6 ; user selects new patient, then Active Bills screen rebuilt with that patients active bills 7 N VALMQUIT,IBDFN 8 D FULL^VALM1 9 S IBDFN=DFN S DFN=+$$PAT^IBJTU2 I 'DFN S DFN=IBDFN 10 K ^TMP("IBJTLA",$J),^TMP("IBJTLAX",$J) 11 D BLDA^IBJTLA1,HDR^IBJTLA 12 S VALMBCK="R",VALMBG=1 13 CPQ Q 14 ; 15 CB ; -- IBJT CHANGE BILL action: change bill, only available on CI screen 16 ; user enters new bill number then Claim Info screen rebuilt/redisplayed for that bill 17 ; if option entered through Active List screen then only allows bills for current patient 18 N VALMQUIT,IBIFN1,IBDFN1 19 D FULL^VALM1 20 S IBDFN1=DFN,IBIFN1=IBIFN 21 I $D(^TMP("IBJTLA",$J)) S DIC("S")="I $P(^(0),U,2)="_DFN 22 S IBIFN=+$$BILL^IBJTU2 I 'IBIFN S IBIFN=IBIFN1 23 S DFN=$P(^DGCR(399,+IBIFN,0),U,2) 24 D CLEAN^VALM10 K IBXSAVE,IBXDATA D BLD^IBJTCA1,HDR^IBJTCA 25 S VALMBCK="R",VALMBG=1 26 CBQ Q 27 ; 28 CDI ; -- IBJT CHANGE DATES INACTIVE action: Change Date range for Inactive screen 29 ; user enters end date for search for inactive bills for a patient, Inactive Bills screen then rebuilt with 30 ; inactive bills for the patient and new date range, IBEND passed to screen build 31 ; if IBBEG is defined the day before is used as the default end date, otherwise, today 32 ; this way the defaults will work backwards until end of bills, then restarts with today 33 D FULL^VALM1 34 S DIR("?",1)="Enter most recent date to include in list." 35 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." 36 S DIR("B")=$S(+$G(IBBEG):$$DATE^IBJU1($$FMADD^XLFDT(IBBEG,-1)),1:"TODAY") 37 S DIR(0)="DO^::EX",DIR("A")="End Date" 38 D ^DIR K DIR I 'Y!($D(DIRUT))!(Y=$G(IBEND)) S VALMSG="Date range was not changed." G CDIQ 39 K ^TMP("IBJTLB",$J),^TMP("IBJTLBX",$J) 40 S IBEND=Y D BLDA^IBJTLB1,HDR^IBJTLB 41 CDIQ S VALMBCK="R",VALMBG=1 42 K VALMB,VALMBEG,VALMEND,DIRUT 43 Q 44 ; 45 ARCA ; -- IBJT AR COMMENT ADD action: add a comment transaction to the AR account, IBIFN required 46 ; IBARCOMM set to indicate AR Profile screen needs to be rebuilt when it is reentered 47 ; will cause the AR screen to be rebuilt including the new information if the AR screen is already open 48 N VALMQUIT,DIR 49 D FULL^VALM1 50 I $P($G(^DGCR(399,IBIFN,0)),U,13)=2 D G ARCAQ 51 . S DIR(0)="EA",DIR("A",1)="A/R comments cannot be added for a bill awaiting an MRA request",DIR("A")="Press RETURN to continue: " D ^DIR K DIR 52 D ADJUST^RCJIBFN3(IBIFN) 53 I $D(^TMP("IBJTTA",$J)) S IBARCOMM=1 54 K ^TMP("IBJTTC",$J) D BLD^IBJTTC,HDR^IBJTTC 55 ARCAQ S VALMBCK="R",VALMBG=1 56 Q 57 ; 58 HS ; -- IBJT HS HEALTH SUMMARY action: health summary (inpt (350.9,2.08), outpt (350.9,2.09)) 59 ; if a Health Summary has been defined for the type of care (Inpt/Outpt) it is printed to the screen 60 ; type of care is taken from the current bill if there is one otherwise the user is asked 61 ; requires HS 2.5 or greater, if 2.7 is available then a date range can be used 62 ; if date range used it is taken from the current bill if available otherwise askes user 63 N X,Y,IBX,IBHS,DIR,DIRUT,IBIOPT,IBDT1,IBDT2,IBHSVER 64 S (IBIOPT,IBHS)=0,IBHSVER=$$VERSION^XPDUTL("HEALTH SUMMARY") 65 I IBHSVER<2.5 S VALMSG="Health Summary package not available." G HSQ 66 D FULL^VALM1 67 I +$G(IBIFN) D I 'IBIOPT G HSQ 68 . S IBX=$G(^DGCR(399,+IBIFN,0)) I '$G(DFN) S DFN=$P(IBX,U,2) I 'DFN Q 69 . S IBIOPT=$S($P(IBX,U,5)<1:0,$P(IBX,U,5)<3:1,1:2) 70 . S IBDT1=$G(^DGCR(399,+IBIFN,"U")),IBDT2=$P(IBDT1,U,2),IBDT1=+IBDT1 71 ; 72 I '$G(IBIFN) D I 'IBIOPT G HSQ 73 . S DIR(0)="SOB^I:Inpatient;O:Outpatient",DIR("A")="Inpatient or Outpatient Health Summary?" D ^DIR K DIR 74 . S IBIOPT=$S(Y="I":1,Y="O":2,1:0) Q:'IBIOPT 75 . ; 76 . Q:IBHSVER<2.7 77 . W !!,"Enter the date range the Health Summary should cover." 78 . S IBDT1=$$DR^IBJTU2($$FMADD^XLFDT(DT,-365),DT),IBDT2=$P(IBDT1,U,2),IBDT1=+IBDT1 79 ; 80 S IBX=$G(^IBE(350.9,1,2)),IBHS=$S(IBIOPT=1:$P(IBX,U,8),1:$P(IBX,U,9)) 81 ; 82 I 'IBHS S VALMSG="No Health Summary Type chosen for "_$S(IBIOPT=1:"In",1:"Out")_"patient." G HSQ 83 I IBHSVER<2.7 D ENX^GMTSDVR(DFN,IBHS) G HSQ 84 D ENX^GMTSDVR(DFN,IBHS,IBDT1,IBDT2) 85 HSQ S VALMBCK="R" 86 Q
Note:
See TracChangeset
for help on using the changeset viewer.
