Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJTRA1.m

    r613 r623  
    1 IBJTRA1 ;ALB/AAS,ARH - TPI CT INSURANCE COMMUNICATIONS BUILD ; 4/1/95
    2         ;;2.0;INTEGRATED BILLING;**39,91,347,389**;21-MAR-94;Build 6
    3         ;;Per VHA Directive 2004-038, this routine should not be modified.
    4         ;
    5         ; copyed from IBTRC with modifications to show reviews for multiple events
    6         ;
    7         ;
    8 BLD     ; -- Build list of Insurance contacts, including reviews, appeals, and denials
    9         K ^TMP("IBJTRA",$J),^TMP("IBJTRADX",$J),IBJTA1,IBJTA2
    10         N X,IBI,IBJ,J,IBTRC,IBTRCD,IBTRCD1,IBJTEVNT,IBCNT,IBTRN,IBTRND,IBETYP,IBBEG
    11         S VALMSG=$$MSG^IBTUTL3(DFN)
    12         S (IBTRC,IBCNT,VALMCNT)=0,IBI=""
    13         D IFNTRN^IBJTU5(IBIFN,.IBJTA1,.IBJTA2)
    14         I 'IBJTA1 S IBCNT=1 D SET1(" ") S IBCNT=2 D SET1("No Claims Tracking Entries.") G BLDQ
    15         S IBJ=0 F  S IBJ=$O(IBJTA2(IBJ)) Q:'IBJ  S IBTRN=IBJTA2(IBJ) D
    16         .S IBTRND=$G(^IBT(356,IBTRN,0))
    17         .S IBJTEVNT="    "_$$EVNT(IBTRND)
    18         .F  S IBI=$O(^IBT(356.2,"ATIDT",IBTRN,IBI)) Q:'IBI  S IBTRC=0 F  S IBTRC=$O(^IBT(356.2,"ATIDT",IBTRN,IBI,IBTRC)) Q:'IBTRC  D
    19         ..S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
    20         ..S IBTRCD1=$G(^IBT(356.2,+IBTRC,1))
    21         ..Q:'+$P(IBTRCD,"^",19)  ;quit if inactive
    22         ..S IBCNT=IBCNT+1
    23         ..I IBJTEVNT'="" D SET(" ",0),SET(IBJTEVNT,0) S IBJTEVNT=""
    24         ..S IBETYP=$G(^IBE(356.11,+$P(IBTRCD,"^",4),0))
    25         ..W "."
    26         ..S X=""
    27         ..S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
    28         ..S X=$$SETFLD^VALM1($P($$DAT1^IBOUTL(+IBTRCD,"2P")," "),X,"DATE")
    29         ..S X=$$SETFLD^VALM1($P($G(^DIC(36,+$P(IBTRCD,"^",8),0)),"^"),X,"INS CO")
    30         ..S X=$$SETFLD^VALM1($$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)),X,"ACTION")
    31         ..;
    32         ..S X=$$SETFLD^VALM1($P(IBETYP,"^",3),X,"TYPE")
    33         ..S X=$$SETFLD^VALM1($P(IBTRCD,"^",28),X,"PRE-CERT")
    34         ..I $P(IBTRCD,"^",13) S X=$$SETFLD^VALM1($J($$DAY^IBTUTL3($P(IBTRCD,"^",12),$P(IBTRCD,"^",13),IBTRN),3),X,"DAYS")
    35         ..I $P($G(^IBE(356.7,+$P(IBTRCD,"^",11),0)),"^",3)=20 S X=$$SETFLD^VALM1($J($$DAY^IBTUTL3($P(IBTRCD,"^",15),$P(IBTRCD,"^",16),IBTRN),3),X,"DAYS")
    36         ..I $P(IBTRCD1,"^",7)!($P(IBTRCD1,"^",8)) S X=$$SETFLD^VALM1("ALL",X,"DAYS")
    37         ..S X=$$SETFLD^VALM1($P(IBTRCD,"^",6),X,"CONTACT")
    38         ..S X=$$SETFLD^VALM1($P(IBTRCD,"^",7),X,"PHONE")
    39         ..S X=$$SETFLD^VALM1($P(IBTRCD,"^",9),X,"REF NO")
    40         ..I $P(IBETYP,"^",2)=60!($P(IBETYP,"^",2)=65) D APPEAL^IBTRC3
    41         ..D SET(X,1)
    42         I 'IBCNT S IBCNT=1 D SET1(" ") S IBCNT=2 D SET1("No Insurance Reviews for Episodes on this Bill.") G BLDQ
    43 BLDQ    K IBJTA1,IBJTA2
    44         Q
    45         ;
    46 SET1(X) ; set array (no selection)
    47         S VALMCNT=VALMCNT+1
    48         S ^TMP("IBJTRA",$J,VALMCNT,0)=X
    49         Q
    50         ;
    51 SET(X,Y)        ; -- set arrays
    52         S VALMCNT=VALMCNT+1
    53         S ^TMP("IBJTRA",$J,VALMCNT,0)=X
    54         S ^TMP("IBJTRA",$J,"IDX",VALMCNT,IBCNT)=""
    55         I +$G(Y) S ^TMP("IBJTRADX",$J,IBCNT)=VALMCNT_"^"_IBTRC
    56         Q
    57         ;
    58 EVNT(IBTRND)    ; return line for display on event
    59         N X,Y,IBTYP S X="" I $G(IBTRND)="" G EVNTQ
    60         S IBTYP=+$P(IBTRND,U,18)
    61         S X=$$EXSET^IBJU1(IBTYP,356,.18)
    62         I IBTYP=2 S X=X_" of "_$P($G(^DIC(40.7,+$$SCE^IBSDU(+$P(IBTRND,U,4),3),0)),U,1)
    63         I IBTYP=3 S X=X_" of "_$P($$PIN^IBCSC5B(+$P(IBTRND,U,9)),U,2)
    64         I IBTYP=4 S X=X_" of "_$$FILE^IBRXUTL(+$P(IBTRND,U,8),.01)
    65         S X=X_" on "_$$DAT1^IBOUTL($P(IBTRND,U,6),"2P")
    66 EVNTQ   Q X
     1IBJTRA1 ;ALB/AAS,ARH - TPI CT INSURANCE COMMUNICATIONS BUILD ; 4/1/95
     2 ;;2.0;INTEGRATED BILLING;**39,91,347**;21-MAR-94;Build 24
     3 ;;Per VHA Directive 2004-038, this routine should not be modified.
     4 ;
     5 ; copyed from IBTRC with modifications to show reviews for multiple events
     6 ;
     7 ;
     8BLD ; -- Build list of Insurance contacts, including reviews, appeals, and denials
     9 K ^TMP("IBJTRA",$J),^TMP("IBJTRADX",$J),IBJTA1,IBJTA2
     10 N X,IBI,IBJ,J,IBTRC,IBTRCD,IBTRCD1,IBJTEVNT,IBCNT,IBTRN,IBTRND,IBETYP,IBBEG
     11 S VALMSG=$$MSG^IBTUTL3(DFN)
     12 S (IBTRC,IBCNT,VALMCNT)=0,IBI=""
     13 D IFNTRN^IBJTU5(IBIFN,.IBJTA1,.IBJTA2)
     14 I 'IBJTA1 S IBCNT=1 D SET1(" ") S IBCNT=2 D SET1("No Claims Tracking Entries.") G BLDQ
     15 S IBJ=0 F  S IBJ=$O(IBJTA2(IBJ)) Q:'IBJ  S IBTRN=IBJTA2(IBJ) D
     16 .S IBTRND=$G(^IBT(356,IBTRN,0))
     17 .S IBJTEVNT="    "_$$EVNT(IBTRND)
     18 .F  S IBI=$O(^IBT(356.2,"ATIDT",IBTRN,IBI)) Q:'IBI  S IBTRC=0 F  S IBTRC=$O(^IBT(356.2,"ATIDT",IBTRN,IBI,IBTRC)) Q:'IBTRC  D
     19 ..S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
     20 ..S IBTRCD1=$G(^IBT(356.2,+IBTRC,1))
     21 ..Q:'+$P(IBTRCD,"^",19)  ;quit if inactive
     22 ..S IBCNT=IBCNT+1
     23 ..I IBJTEVNT'="" D SET(" ",0),SET(IBJTEVNT,0) S IBJTEVNT=""
     24 ..S IBETYP=$G(^IBE(356.11,+$P(IBTRCD,"^",4),0))
     25 ..W "."
     26 ..S X=""
     27 ..S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
     28 ..S X=$$SETFLD^VALM1($P($$DAT1^IBOUTL(+IBTRCD,"2P")," "),X,"DATE")
     29 ..S X=$$SETFLD^VALM1($P($G(^DIC(36,+$P(IBTRCD,"^",8),0)),"^"),X,"INS CO")
     30 ..S X=$$SETFLD^VALM1($$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)),X,"ACTION")
     31 ..;
     32 ..S X=$$SETFLD^VALM1($P(IBETYP,"^",3),X,"TYPE")
     33 ..S X=$$SETFLD^VALM1($P(IBTRCD,"^",28),X,"PRE-CERT")
     34 ..I $P(IBTRCD,"^",13) S X=$$SETFLD^VALM1($J($$DAY^IBTUTL3($P(IBTRCD,"^",12),$P(IBTRCD,"^",13),IBTRN),3),X,"DAYS")
     35 ..I $P($G(^IBE(356.7,+$P(IBTRCD,"^",11),0)),"^",3)=20 S X=$$SETFLD^VALM1($J($$DAY^IBTUTL3($P(IBTRCD,"^",15),$P(IBTRCD,"^",16),IBTRN),3),X,"DAYS")
     36 ..I $P(IBTRCD1,"^",7)!($P(IBTRCD1,"^",8)) S X=$$SETFLD^VALM1("ALL",X,"DAYS")
     37 ..S X=$$SETFLD^VALM1($P(IBTRCD,"^",6),X,"CONTACT")
     38 ..S X=$$SETFLD^VALM1($P(IBTRCD,"^",7),X,"PHONE")
     39 ..S X=$$SETFLD^VALM1($P(IBTRCD,"^",9),X,"REF NO")
     40 ..I $P(IBETYP,"^",2)=60!($P(IBETYP,"^",2)=65) D APPEAL^IBTRC3
     41 ..D SET(X,1)
     42 I 'IBCNT S IBCNT=1 D SET1(" ") S IBCNT=2 D SET1("No Insurance Reviews for Episodes on this Bill.") G BLDQ
     43BLDQ K IBJTA1,IBJTA2
     44 Q
     45 ;
     46SET1(X) ; set array (no selection)
     47 S VALMCNT=VALMCNT+1
     48 S ^TMP("IBJTRA",$J,VALMCNT,0)=X
     49 Q
     50 ;
     51SET(X,Y) ; -- set arrays
     52 S VALMCNT=VALMCNT+1
     53 S ^TMP("IBJTRA",$J,VALMCNT,0)=X
     54 S ^TMP("IBJTRA",$J,"IDX",VALMCNT,IBCNT)=""
     55 I +$G(Y) S ^TMP("IBJTRADX",$J,IBCNT)=VALMCNT_"^"_IBTRC
     56 Q
     57 ;
     58EVNT(IBTRND) ; return line for display on event
     59 N X,Y,IBTYP S X="" I $G(IBTRND)="" G EVNTQ
     60 S IBTYP=+$P(IBTRND,U,18)
     61 S X=$$EXSET^IBJU1(IBTYP,356,.18)
     62 I IBTYP=2 S X=X_" of "_$P($G(^DIC(40.7,+$$SCE^IBSDU(+$P(IBTRND,U,4),3),0)),U,1)
     63 I IBTYP=3 S Y=+$P($G(^RMPR(660,+$P(IBTRND,U,9),0)),U,6),X=X_" of "_$$EXSET^IBJU1(Y,660,4)
     64 I IBTYP=4 S X=X_" of "_$$FILE^IBRXUTL(+$P(IBTRND,U,8),.01)
     65 S X=X_" on "_$$DAT1^IBOUTL($P(IBTRND,U,6),"2P")
     66EVNTQ Q X
Note: See TracChangeset for help on using the changeset viewer.