source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTUTL2.m@ 699

Last change on this file since 699 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1IBTUTL2 ;ALB/AAS - CLAIMS TRACKING UTILITY ROUTINE ; 21-JUN-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ADDR(IBTRVDT,IBTRN) ; -- add new entry to reviews file, ibt(356.1
6 ; -- Input IBTRVDT := Review date (in internal fileman format)
7 ; IBTRN := pointer to tracking module
8 ;
9 N %DT,DD,DO,DIC,DR,DIE,DLAYGO
10 S DIC="^IBT(356.1,",DIC(0)="L",DLAYGO=356.1
11 S DIC("DR")=".02////"_IBTRN
12 S X=IBTRVDT D FILE^DICN
13 S IBTRV=+Y,IBNEW=1
14ADDRQ Q
15 ;
16PRE(IBTRVDT,IBTRN,IBX) ; -- add a review
17 ; -- Input IBTRVDT := Review date (in internal fileman format)
18 ; IBTRN := pointer to tracking module
19 ; IBX := code for review
20 ;
21 N X,Y,DA,DR,DIE,DIC,IBXIFN,IBNRVDT,IBDAYS
22 D ADDR(IBTRVDT,IBTRN)
23 I IBTRV<1 G PREQ
24 ;
25 ; -- don't differentiate between scheduled and unscheduled
26 I IBX=10!(IBX=20) S IBX=15 ; just admission review
27 ;
28 S IBDAYS=$S(IBX=15:1,1:$$RDAY^IBTRV31(IBTRN))
29 S:'$G(IBX) IBX=30 S IBXIFN=$O(^IBE(356.11,"ACODE",IBX,0))
30 ;S X1=IBTRVDT,X2=$S(IBX=15:3,1:"") I X2 D C^%DTC S IBNRVDT=X
31 S DA=IBTRV,DIE="^IBT(356.1,"
32 L +^IBT(356.1,+IBTRV):10 I '$T G PREQ
33 S DR=".19////1;.03////^S X=$G(IBDAYS);.2////^S X=$$NXTRVDT^IBTRV31(IBTRV);.21////1;.22////"_IBXIFN_";1.01///NOW;1.02////"_DUZ
34 D ^DIE K DA,DR,DIE
35 L -^IBT(356.1,+IBTRV)
36PREQ Q
37 ;
38SCH(DFN,IBTDT,IBSCH) ; -- add scheduled admission entries
39 ; -- input dfn := patient pointer to 2
40 ; ibtdt := episode date
41 ;
42 N X,Y,DA,DR,DIE,DIC
43 ;S IBETYP=+$O(^IBE(356.6,"B","SCHEDULED ADMISSION",0))
44 S IBETYP=+$O(^IBE(356.6,"AC",5,0)) ;scheduled admission type
45 S X=$O(^IBT(356,"APTY",DFN,IBETYP,IBTDT,0)) I X S IBTRN=X G SCHQ
46 D ADDT^IBTUTL
47 I IBTRN<1 G SCHQ
48 S DA=IBTRN,DIE="^IBT(356,"
49 I '$G(IBSCH) S X=0 F S X=$O(^DGS(41.1,"B",DFN,X)) Q:'X I $P(^DGS(41.1,+X,0),"^",2)=IBTDT S IBSCH=X Q
50 L +^IBT(356,+IBTRN):5 I '$T G SCHQ
51 S DR=$$ADMDR^IBTUTL(IBTDT,IBETYP,"",0)
52 I $G(IBSCH) S DR=DR_";.32////"_IBSCH
53 D ^DIE K DA,DR,DIE
54 L -^IBT(356,+IBTRN)
55 ;
56 ; -- add required ins. action if insured
57 I $P(^IBT(356,IBTRN,0),U,24) D COM^IBTUTL3(IBTDT,IBTRN,10)
58SCHQ Q
Note: See TracBrowser for help on using the repository browser.