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

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

initial load of WorldVistAEHR

File size: 4.8 KB
Line 
1IBCDE ;ALB/ARH - AUTOMATED BILLER ERRORS ; 8/6/93
2 ;;2.0;INTEGRATED BILLING;**55,287**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5SETCOMM ;sets errors/comments into file (362.1) based on array passed in
6 ;^TMP("IBCE",$J,IBDT,IBTRN,IBIFN,x)=error message (IBTRN OR IBIFN may be 0)
7 ;if an entry already exists for event/bill its comments are deleted and replaced with what is passed in, if any
8 ;
9 Q:'$D(^TMP("IBCE",$J))
10 S IBDT=0 F S IBDT=$O(^TMP("IBCE",$J,IBDT)) Q:'IBDT D
11 . S IBTRN="" F S IBTRN=$O(^TMP("IBCE",$J,IBDT,IBTRN)) Q:IBTRN="" D
12 .. S IBIFN="" F S IBIFN=$O(^TMP("IBCE",$J,IBDT,IBTRN,IBIFN)) Q:IBIFN="" D
13 ... S IBDA=$$COMM1(IBTRN,IBIFN) Q:IBDA'>0 D COMM2(IBDA,"",1)
14 ... S IBX=0 F S IBX=$O(^TMP("IBCE",$J,IBDT,IBTRN,IBIFN,IBX)) Q:'IBX D
15 .... D COMM2(IBDA,^(IBX))
16 K IBDT,IBTRN,IBIFN,IBDA,IBX,X,Y
17 Q
18 ;
19COMM1(TRN,IFN) ;returns the comment entry number for event and bill, updates comment date and bill IFN
20 ;if an entry does not exits one is created, does not add any comments
21 N IBDA,X,Y S IBDA=0,TRN=$G(TRN),IFN=$G(IFN) I '$D(^IBT(356,+TRN,0))!(+IFN&('$D(^DGCR(399,+IFN,0)))) G COMM1E
22 S IBDA=$$FIND(TRN,IFN) I 'IBDA D G:IBDA<0 COMM1E ; create new comment entry
23 . S IBDA=$P(^IBA(362.1,0),U,3)+1 F Q:'$D(^IBA(362.1,IBDA)) S IBDA=IBDA+1
24 . S DIC="^IBA(362.1,",X=IBDA,DIC(0)="L",DIC("DR")=".02////"_$S(+TRN:TRN,1:"") K DD,DO D FILE^DICN K DD,DO,DIC S IBDA=+Y,DR=";.05////"_DT
25 ; edit existing comment entry, add date (DT) and bill number
26 S DIE="^IBA(362.1,",DA=IBDA,DR=".03////"_$S(+IFN:IFN,1:"")_$G(DR) D ^DIE K DIE,DA,DR,DIC
27COMM1E Q IBDA
28 ;
29COMM2(IFNC,COMM,DEL) ;adds/deletes comments form a comment file entry, nothing returned
30 ;if DEL is passed as true any comments existing for the entry are deleted
31 ;if COMM contains text it is added as a comment to the entry
32 N X,Y,IBDA1 S IBDA1=0 I '$D(^IBA(362.1,+$G(IFNC),0)) G COMM2E
33 I +$G(DEL),$D(^IBA(362.1,+IFNC,11)) S DIE="^IBA(362.1,",DA=+IFNC,DR="11///@" D ^DIE K DIE,DIC,DR,DA
34 I $G(COMM)'="" D S ^IBA(362.1,+IFNC,11,IBDA1,0)=COMM
35 . S IBDA1=+$P($G(^IBA(362.1,+IFNC,11,0)),U,3)+1 F Q:'$D(^IBA(362.1,+IFNC,11,IBDA1)) S IBDA1=IBDA1+1
36 I IBDA1>0 S ^IBA(362.1,+IFNC,11,0)="^^"_IBDA1_"^"_IBDA1_"^"_DT_"^"
37COMM2E Q
38 ;
39FIND(TRN,IFN) ;find an entry in the comments file, returns IFN of comment entry
40 ;returns comment entry that may not match with bill number if either the bill number passed in or comment entry bill number is null (a comment entry may be initially created with no bill number)
41 ;given that a comment entry is found for the event (TRN) then returns comment IFN based on following restrictions, otherwise returns 0
42 ;1) if an exact match between bill number passed in and comment entry bill number is found (including null) then the IFN of that comment entry is returned
43 ;2) if not 1) and no bill number passed in then returns the IFN of the last comment entry found, if any
44 ;3) if not 1) and a bill number is passed in then returns the IFN of thelast comment entry found that does not have an associated bill number, if any
45 N X,X1,Y S (X,Y)=0,TRN=+$G(TRN),IFN=+$G(IFN)
46 F S Y=$O(^IBA(362.1,"C",TRN,Y)) Q:'Y S X1=+$P($G(^IBA(362.1,Y,0)),U,3) S:('X1)!('IFN) X=Y I X1=IFN S X=Y Q
47 Q X
48 ;
49FINDB(IFN) ;search for any entries for a particular bill, returns string of comment file entry numbers separated by "^"
50 N X,Y S X="",TRN=+$G(TRN),IFN=+$G(IFN)
51 S Y=0 F S Y=$O(^IBA(362.1,"D",IFN,Y)) Q:'Y S X=Y_"^"_X
52 Q X
53 ;
54PRINT ;print error/comments file (362.1), OPTION - replace in IB*2*287
55 G ^IBCDP
56 Q
57 W !!,"Report requires 132 columns."
58 S IBDATES=$$FMDATES^IBCU2 I IBDATES="" G PE
59 S DHD="AUTOMATED BILLER ERRORS/COMMENTS FOR "_$$FMTE^XLFDT($P(IBDATES,U,1))_" - "_$$FMTE^XLFDT($P(IBDATES,U,2))
60 S (FLDS,BY)="[IB AB COMMENTS]",FR=$P(IBDATES,U,1)_",,?,",TO=$P(IBDATES,U,2)_",,?,",L=0,DIC="^IBA(362.1,"
61 D EN1^DIP
62PE K X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIOEND,DIC,L,FLDS,BY,DHD,FR,TO,IBDATES
63 Q
64 ;
65EDIT ;edit auto bill parameters, OPTION
66 N IBFR,IBFR2
67 S IBFR=$P($G(^IBE(350.9,1,7)),U,1)
68 S DIE="^IBE(350.9,",DA=1,DR="7.01;7.03" D ^DIE I $D(Y) G EDITQ
69 S IBFR2=$P($G(^IBE(350.9,1,7)),U,1)
70 D:'IBFR CLEAN^IBCDC D:'IBFR2 ABOFF^IBCDC
71E2 W ! S DIC="^IBE(356.6,",DIC(0)="AEQ" D ^DIC G EDITQ:Y<0
72 S DIE="^IBE(356.6,",DA=+Y,DR=".04;.05;.06" D ^DIE
73 G E2
74EDITQ K DIE,DA,DR,X,Y
75 Q
76DELDT ;deletes entries from file (362.1) based on date and if they have a bill, OPTION
77 S IBDT=$$FMADD^XLFDT(DT,-3),DIR("B")=$$FMTE^XLFDT(IBDT),DIR("?")="Enter a date before "_DIR("B")_"."
78 S DIR("?",1)="All entries in the Auto Biller Comments file not associated with a bill entered on or before this date will be deleted."
79 S DIR(0)="DOA^2880101:"_IBDT_":EX",DIR("A")="End Date for Delete: "
80 D ^DIR K DIR G:'Y DELDTQ S IBDT=+Y
81 ;
82 S IBCE=0 F S IBCE=$O(^IBA(362.1,IBCE)) Q:'IBCE S X=$G(^IBA(362.1,IBCE,0)) I $P(X,U,5)'>IBDT,'$P(X,U,3) D
83 . S DIK="^IBA(362.1,",DA=IBCE D ^DIK W "."
84DELDTQ K IBCE,DIK,DIC,DA,X,Y
85 Q
Note: See TracBrowser for help on using the repository browser.