- 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/IBTRED01.m
r613 r623 1 IBTRED01 2 ;;2.0;INTEGRATED BILLING;**389**;21-MAR-94;Build 6 3 ;;Per VHA Directive 2004-038, this routine should not be modified.4 5 % 6 7 8 REVIEW 9 10 11 12 13 14 15 16 17 18 19 20 21 22 COMM 23 24 25 26 27 28 29 30 31 32 33 34 SC 35 36 37 SC1 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 SCQ 55 56 UR 57 58 59 60 61 62 63 64 65 66 67 68 69 4 70 71 D SET^IBCNSP(START+2,OFFSET," Item: "_$P($$PIN^IBCSC5B(+IBDA),U,2))72 73 74 75 76 77 78 79 80 81 1 IBTRED01 ;ALB/AAS - EXPAND/EDIT CLAIMS TRACKING ENTRY - CONT; 01-JUL-1993 2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 % I '$G(IBTRN)!($G(IORVON)="") G ^IBTRED 6 D UR,REVIEW,SC 7 Q 8 REVIEW ; -- List Reviews done 9 N OFFSET,START,IBTRV,IDT,IBTRVD,IBTRTP 10 S START=24,OFFSET=2,IBLCNT=0 11 D SET^IBCNSP(START,OFFSET," Hospital Reviews Entered ",IORVON,IORVOFF) 12 S IDT="" F S IDT=$O(^IBT(356.1,"ATIDT",IBTRN,IDT)) Q:'IDT S IBTRV="" F S IBTRV=$O(^IBT(356.1,"ATIDT",IBTRN,IDT,IBTRV)) Q:'IBTRV D 13 .S IBLCNT=$G(IBLCNT)+1 14 .S IBTRVD=$G(^IBT(356.1,IBTRV,0)) 15 .S IBTRTP=$P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^") 16 .;D SET^IBCNSP(START+IBLCNT,OFFSET,$J(IBLCNT,2)_". "_$E(IBTRTP_" ",1,28)_" on "_$E($$DAT1^IBOUTL($P(IBTRVD,"^"),"2P")_" ",1,8)_" Status: "_$$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21))) 17 .S IBTEXT=$E(IBTRTP_" Status: "_$$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21))_" ",1,50) 18 .D SET^IBCNSP(START+IBLCNT,OFFSET,$J(IBLCNT,2)_". "_IBTEXT_" on "_$$DAT1^IBOUTL($P(IBTRVD,"^"),"2P")) 19 .Q 20 D COMM 21 Q 22 COMM ; -- List Communication Entries 23 N OFFSET,START,IDT,IBTRCD,IBCNT 24 S START=26+$G(IBLCNT),OFFSET=2 25 D SET^IBCNSP(START,OFFSET," Insurance Reviews Entered ",IORVON,IORVOFF) 26 S IDT="" F S IDT=$O(^IBT(356.2,"ATIDT",IBTRN,IDT)) Q:'IDT S IBTRC="" F S IBTRC=$O(^IBT(356.2,"ATIDT",IBTRN,IDT,IBTRC)) Q:'IBTRC D 27 .S IBLCNT=$G(IBLCNT)+1,IBCNT=$G(IBCNT)+1 28 .S IBTRCD=$G(^IBT(356.2,IBTRC,0)) 29 .S IBTEXT=$E($$EXPAND^IBTRE(356.2,.04,$P(IBTRCD,"^",4))_" Contact "_$$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11))_" ",1,50) 30 .D SET^IBCNSP(START+IBCNT,OFFSET,$J(IBCNT,2)_". "_IBTEXT_" on "_$$DAT1^IBOUTL(+IBTRCD,"2P")) 31 .Q 32 Q 33 ; 34 SC ; -- Show eligibility/sc conditions 35 N OFFSET,START,IDT,IBTRCD,IBCNT,I1,I2,I3 36 S START=28+$G(IBLCNT),OFFSET=2 37 SC1 D SET^IBCNSP(START,OFFSET," Service Connected Conditions: ",IORVON,IORVOFF) 38 D ELIG^VADPT 39 S IBLCNT=$G(IBLCNT)+1,IBCNT=$G(IBCNT)+1,I3=0 40 ; 41 D SET^IBCNSP(START+IBCNT,OFFSET,"Service Connected: "_$S('$G(VAEL(3)):"NO",1:$P(VAEL(3),"^",2)_"%")) 42 ; 43 F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I D 44 .S I1=^DPT(DFN,.372,I,0) 45 .Q:'$P(I1,"^",3) 46 .S I2=$G(^DIC(31,+I1,0)) 47 .S:$P(I2,"^",4)'="" I2=$P(I2,"^",4) 48 .S I2=$P(I2,"^") 49 .S IBLCNT=$G(IBLCNT)+1,IBCNT=$G(IBCNT)+1 50 .D SET^IBCNSP(START+IBCNT,OFFSET,$J(IBCNT-1,2)_". "_$E(I2_" ",1,45)_$J($P(I1,"^",2),3)_"%") 51 .S I3=I3+1 52 .Q 53 I 'I3 S IBLCNT=$G(IBLCNT)+1,IBCNT=$G(IBCNT)+1 D SET^IBCNSP(START+IBCNT,OFFSET,$S('$O(^DPT(DFN,.372,0)):"NONE STATED",1:"NO SC DISABILITIES LISTED")) S I3=1 54 SCQ Q 55 ; 56 UR ; -- ur information region 57 N OFFSET,START 58 S START=7,OFFSET=51 59 D SET^IBCNSP(START,OFFSET," Review Information ",IORVON,IORVOFF) 60 D SET^IBCNSP(START+1,OFFSET," Insurance Claim: "_$$EXPAND^IBTRE(356,.24,$P(IBTRND,"^",24))) 61 D SET^IBCNSP(START+2,OFFSET," Follow-up Type: "_$$EXPAND^IBTRE(356,1.07,$P(IBTRND1,"^",7))) 62 D SET^IBCNSP(START+3,OFFSET," Random Sample: "_$$EXPAND^IBTRE(356,.25,$P(IBTRND,"^",25))) 63 D SET^IBCNSP(START+4,OFFSET,"Special Condition: "_$$EXPAND^IBTRE(356,.26,$P(IBTRND,"^",26))) 64 D SET^IBCNSP(START+5,OFFSET," Local Addition: "_$$EXPAND^IBTRE(356,.27,$P(IBTRND,"^",27))) 65 D SET^IBCNSP(START+6,OFFSET," Ins. Reviewer: "_$$EXPAND^IBTRE(356,1.06,$P(IBTRND1,"^",6))) 66 D SET^IBCNSP(START+7,OFFSET,"Hospital Reviewer: "_$$EXPAND^IBTRE(356,1.05,$P(IBTRND1,"^",5))) 67 Q 68 ; 69 4 ; -- Visit region for prosthetics 70 N IBDA,IBRMPR S IBDA=$P(IBTRND,"^",9) D PRODATA^IBTUTL1(IBDA) 71 D SET^IBCNSP(START+2,OFFSET," Item: "_$G(IBRMPR(660,+IBDA,4,"E"))) 72 D SET^IBCNSP(START+3,OFFSET," Description: "_$G(IBRMPR(660,+IBDA,24,"E"))) 73 D SET^IBCNSP(START+4,OFFSET," Quantity: "_$J($G(IBRMPR(660,+IBDA,5,"E")),$L($G(IBRMPR(660,+IBDA,14,"E"))))) 74 D SET^IBCNSP(START+5,OFFSET," Total Cost: $"_$G(IBRMPR(660,+IBDA,14,"E"))) 75 D SET^IBCNSP(START+6,OFFSET," Transaction: "_$G(IBRMPR(660,+IBDA,2,"E"))) 76 D SET^IBCNSP(START+7,OFFSET," Vendor: "_$G(IBRMPR(660,+IBDA,7,"E"))) 77 D SET^IBCNSP(START+8,OFFSET," Source: "_$G(IBRMPR(660,+IBDA,12,"E"))) 78 D SET^IBCNSP(START+9,OFFSET," Delivery Date: "_$G(IBRMPR(660,+IBDA,10,"E"))) 79 D SET^IBCNSP(START+10,OFFSET," Remarks: "_$G(IBRMPR(660,+IBDA,16,"E"))) 80 D SET^IBCNSP(START+11,OFFSET," Return Status: "_$G(IBRMPR(660,+IBDA,17,"E"))) 81 Q
Note:
See TracChangeset
for help on using the changeset viewer.
