IBCDE ;ALB/ARH - AUTOMATED BILLER ERRORS ; 8/6/93
;;2.0;INTEGRATED BILLING;**55,287**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
SETCOMM ;sets errors/comments into file (362.1) based on array passed in
;^TMP("IBCE",$J,IBDT,IBTRN,IBIFN,x)=error message (IBTRN OR IBIFN may be 0)
;if an entry already exists for event/bill its comments are deleted and replaced with what is passed in, if any
;
Q:'$D(^TMP("IBCE",$J))
S IBDT=0 F S IBDT=$O(^TMP("IBCE",$J,IBDT)) Q:'IBDT D
. S IBTRN="" F S IBTRN=$O(^TMP("IBCE",$J,IBDT,IBTRN)) Q:IBTRN="" D
.. S IBIFN="" F S IBIFN=$O(^TMP("IBCE",$J,IBDT,IBTRN,IBIFN)) Q:IBIFN="" D
... S IBDA=$$COMM1(IBTRN,IBIFN) Q:IBDA'>0 D COMM2(IBDA,"",1)
... S IBX=0 F S IBX=$O(^TMP("IBCE",$J,IBDT,IBTRN,IBIFN,IBX)) Q:'IBX D
.... D COMM2(IBDA,^(IBX))
K IBDT,IBTRN,IBIFN,IBDA,IBX,X,Y
Q
;
COMM1(TRN,IFN) ;returns the comment entry number for event and bill, updates comment date and bill IFN
;if an entry does not exits one is created, does not add any comments
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
S IBDA=$$FIND(TRN,IFN) I 'IBDA D G:IBDA<0 COMM1E ; create new comment entry
. S IBDA=$P(^IBA(362.1,0),U,3)+1 F Q:'$D(^IBA(362.1,IBDA)) S IBDA=IBDA+1
. 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
; edit existing comment entry, add date (DT) and bill number
S DIE="^IBA(362.1,",DA=IBDA,DR=".03////"_$S(+IFN:IFN,1:"")_$G(DR) D ^DIE K DIE,DA,DR,DIC
COMM1E Q IBDA
;
COMM2(IFNC,COMM,DEL) ;adds/deletes comments form a comment file entry, nothing returned
;if DEL is passed as true any comments existing for the entry are deleted
;if COMM contains text it is added as a comment to the entry
N X,Y,IBDA1 S IBDA1=0 I '$D(^IBA(362.1,+$G(IFNC),0)) G COMM2E
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
I $G(COMM)'="" D S ^IBA(362.1,+IFNC,11,IBDA1,0)=COMM
. 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
I IBDA1>0 S ^IBA(362.1,+IFNC,11,0)="^^"_IBDA1_"^"_IBDA1_"^"_DT_"^"
COMM2E Q
;
FIND(TRN,IFN) ;find an entry in the comments file, returns IFN of comment entry
;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)
;given that a comment entry is found for the event (TRN) then returns comment IFN based on following restrictions, otherwise returns 0
;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
;2) if not 1) and no bill number passed in then returns the IFN of the last comment entry found, if any
;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
N X,X1,Y S (X,Y)=0,TRN=+$G(TRN),IFN=+$G(IFN)
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
Q X
;
FINDB(IFN) ;search for any entries for a particular bill, returns string of comment file entry numbers separated by "^"
N X,Y S X="",TRN=+$G(TRN),IFN=+$G(IFN)
S Y=0 F S Y=$O(^IBA(362.1,"D",IFN,Y)) Q:'Y S X=Y_"^"_X
Q X
;
PRINT ;print error/comments file (362.1), OPTION - replace in IB*2*287
G ^IBCDP
Q
W !!,"Report requires 132 columns."
S IBDATES=$$FMDATES^IBCU2 I IBDATES="" G PE
S DHD="AUTOMATED BILLER ERRORS/COMMENTS FOR "_$$FMTE^XLFDT($P(IBDATES,U,1))_" - "_$$FMTE^XLFDT($P(IBDATES,U,2))
S (FLDS,BY)="[IB AB COMMENTS]",FR=$P(IBDATES,U,1)_",,?,",TO=$P(IBDATES,U,2)_",,?,",L=0,DIC="^IBA(362.1,"
D EN1^DIP
PE K X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIOEND,DIC,L,FLDS,BY,DHD,FR,TO,IBDATES
Q
;
EDIT ;edit auto bill parameters, OPTION
N IBFR,IBFR2
S IBFR=$P($G(^IBE(350.9,1,7)),U,1)
S DIE="^IBE(350.9,",DA=1,DR="7.01;7.03" D ^DIE I $D(Y) G EDITQ
S IBFR2=$P($G(^IBE(350.9,1,7)),U,1)
D:'IBFR CLEAN^IBCDC D:'IBFR2 ABOFF^IBCDC
E2 W ! S DIC="^IBE(356.6,",DIC(0)="AEQ" D ^DIC G EDITQ:Y<0
S DIE="^IBE(356.6,",DA=+Y,DR=".04;.05;.06" D ^DIE
G E2
EDITQ K DIE,DA,DR,X,Y
Q
DELDT ;deletes entries from file (362.1) based on date and if they have a bill, OPTION
S IBDT=$$FMADD^XLFDT(DT,-3),DIR("B")=$$FMTE^XLFDT(IBDT),DIR("?")="Enter a date before "_DIR("B")_"."
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."
S DIR(0)="DOA^2880101:"_IBDT_":EX",DIR("A")="End Date for Delete: "
D ^DIR K DIR G:'Y DELDTQ S IBDT=+Y
;
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
. S DIK="^IBA(362.1,",DA=IBCE D ^DIK W "."
DELDTQ K IBCE,DIK,DIC,DA,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCDE 5004 printed Dec 13, 2024@02:09:18 Page 2
IBCDE ;ALB/ARH - AUTOMATED BILLER ERRORS ; 8/6/93
+1 ;;2.0;INTEGRATED BILLING;**55,287**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
SETCOMM ;sets errors/comments into file (362.1) based on array passed in
+1 ;^TMP("IBCE",$J,IBDT,IBTRN,IBIFN,x)=error message (IBTRN OR IBIFN may be 0)
+2 ;if an entry already exists for event/bill its comments are deleted and replaced with what is passed in, if any
+3 ;
+4 if '$DATA(^TMP("IBCE",$JOB))
QUIT
+5 SET IBDT=0
FOR
SET IBDT=$ORDER(^TMP("IBCE",$JOB,IBDT))
if 'IBDT
QUIT
Begin DoDot:1
+6 SET IBTRN=""
FOR
SET IBTRN=$ORDER(^TMP("IBCE",$JOB,IBDT,IBTRN))
if IBTRN=""
QUIT
Begin DoDot:2
+7 SET IBIFN=""
FOR
SET IBIFN=$ORDER(^TMP("IBCE",$JOB,IBDT,IBTRN,IBIFN))
if IBIFN=""
QUIT
Begin DoDot:3
+8 SET IBDA=$$COMM1(IBTRN,IBIFN)
if IBDA'>0
QUIT
DO COMM2(IBDA,"",1)
+9 SET IBX=0
FOR
SET IBX=$ORDER(^TMP("IBCE",$JOB,IBDT,IBTRN,IBIFN,IBX))
if 'IBX
QUIT
Begin DoDot:4
+10 DO COMM2(IBDA,^(IBX))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+11 KILL IBDT,IBTRN,IBIFN,IBDA,IBX,X,Y
+12 QUIT
+13 ;
COMM1(TRN,IFN) ;returns the comment entry number for event and bill, updates comment date and bill IFN
+1 ;if an entry does not exits one is created, does not add any comments
+2 NEW IBDA,X,Y
SET IBDA=0
SET TRN=$GET(TRN)
SET IFN=$GET(IFN)
IF '$DATA(^IBT(356,+TRN,0))!(+IFN&('$DATA(^DGCR(399,+IFN,0))))
GOTO COMM1E
+3 ; create new comment entry
SET IBDA=$$FIND(TRN,IFN)
IF 'IBDA
Begin DoDot:1
+4 SET IBDA=$PIECE(^IBA(362.1,0),U,3)+1
FOR
if '$DATA(^IBA(362.1,IBDA))
QUIT
SET IBDA=IBDA+1
+5 SET DIC="^IBA(362.1,"
SET X=IBDA
SET DIC(0)="L"
SET DIC("DR")=".02////"_$SELECT(+TRN:TRN,1:"")
KILL DD,DO
DO FILE^DICN
KILL DD,DO,DIC
SET IBDA=+Y
SET DR=";.05////"_DT
End DoDot:1
if IBDA<0
GOTO COMM1E
+6 ; edit existing comment entry, add date (DT) and bill number
+7 SET DIE="^IBA(362.1,"
SET DA=IBDA
SET DR=".03////"_$SELECT(+IFN:IFN,1:"")_$GET(DR)
DO ^DIE
KILL DIE,DA,DR,DIC
COMM1E QUIT IBDA
+1 ;
COMM2(IFNC,COMM,DEL) ;adds/deletes comments form a comment file entry, nothing returned
+1 ;if DEL is passed as true any comments existing for the entry are deleted
+2 ;if COMM contains text it is added as a comment to the entry
+3 NEW X,Y,IBDA1
SET IBDA1=0
IF '$DATA(^IBA(362.1,+$GET(IFNC),0))
GOTO COMM2E
+4 IF +$GET(DEL)
IF $DATA(^IBA(362.1,+IFNC,11))
SET DIE="^IBA(362.1,"
SET DA=+IFNC
SET DR="11///@"
DO ^DIE
KILL DIE,DIC,DR,DA
+5 IF $GET(COMM)'=""
Begin DoDot:1
+6 SET IBDA1=+$PIECE($GET(^IBA(362.1,+IFNC,11,0)),U,3)+1
FOR
if '$DATA(^IBA(362.1,+IFNC,11,IBDA1))
QUIT
SET IBDA1=IBDA1+1
End DoDot:1
SET ^IBA(362.1,+IFNC,11,IBDA1,0)=COMM
+7 IF IBDA1>0
SET ^IBA(362.1,+IFNC,11,0)="^^"_IBDA1_"^"_IBDA1_"^"_DT_"^"
COMM2E QUIT
+1 ;
FIND(TRN,IFN) ;find an entry in the comments file, returns IFN of comment entry
+1 ;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)
+2 ;given that a comment entry is found for the event (TRN) then returns comment IFN based on following restrictions, otherwise returns 0
+3 ;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
+4 ;2) if not 1) and no bill number passed in then returns the IFN of the last comment entry found, if any
+5 ;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
+6 NEW X,X1,Y
SET (X,Y)=0
SET TRN=+$GET(TRN)
SET IFN=+$GET(IFN)
+7 FOR
SET Y=$ORDER(^IBA(362.1,"C",TRN,Y))
if 'Y
QUIT
SET X1=+$PIECE($GET(^IBA(362.1,Y,0)),U,3)
if ('X1)!('IFN)
SET X=Y
IF X1=IFN
SET X=Y
QUIT
+8 QUIT X
+9 ;
FINDB(IFN) ;search for any entries for a particular bill, returns string of comment file entry numbers separated by "^"
+1 NEW X,Y
SET X=""
SET TRN=+$GET(TRN)
SET IFN=+$GET(IFN)
+2 SET Y=0
FOR
SET Y=$ORDER(^IBA(362.1,"D",IFN,Y))
if 'Y
QUIT
SET X=Y_"^"_X
+3 QUIT X
+4 ;
PRINT ;print error/comments file (362.1), OPTION - replace in IB*2*287
+1 GOTO ^IBCDP
+2 QUIT
+3 WRITE !!,"Report requires 132 columns."
+4 SET IBDATES=$$FMDATES^IBCU2
IF IBDATES=""
GOTO PE
+5 SET DHD="AUTOMATED BILLER ERRORS/COMMENTS FOR "_$$FMTE^XLFDT($PIECE(IBDATES,U,1))_" - "_$$FMTE^XLFDT($PIECE(IBDATES,U,2))
+6 SET (FLDS,BY)="[IB AB COMMENTS]"
SET FR=$PIECE(IBDATES,U,1)_",,?,"
SET TO=$PIECE(IBDATES,U,2)_",,?,"
SET L=0
SET DIC="^IBA(362.1,"
+7 DO EN1^DIP
PE KILL X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIOEND,DIC,L,FLDS,BY,DHD,FR,TO,IBDATES
+1 QUIT
+2 ;
EDIT ;edit auto bill parameters, OPTION
+1 NEW IBFR,IBFR2
+2 SET IBFR=$PIECE($GET(^IBE(350.9,1,7)),U,1)
+3 SET DIE="^IBE(350.9,"
SET DA=1
SET DR="7.01;7.03"
DO ^DIE
IF $DATA(Y)
GOTO EDITQ
+4 SET IBFR2=$PIECE($GET(^IBE(350.9,1,7)),U,1)
+5 if 'IBFR
DO CLEAN^IBCDC
if 'IBFR2
DO ABOFF^IBCDC
E2 WRITE !
SET DIC="^IBE(356.6,"
SET DIC(0)="AEQ"
DO ^DIC
if Y<0
GOTO EDITQ
+1 SET DIE="^IBE(356.6,"
SET DA=+Y
SET DR=".04;.05;.06"
DO ^DIE
+2 GOTO E2
EDITQ KILL DIE,DA,DR,X,Y
+1 QUIT
DELDT ;deletes entries from file (362.1) based on date and if they have a bill, OPTION
+1 SET IBDT=$$FMADD^XLFDT(DT,-3)
SET DIR("B")=$$FMTE^XLFDT(IBDT)
SET DIR("?")="Enter a date before "_DIR("B")_"."
+2 SET DIR("?",1)="All entries in the Auto Biller Comments file not associated with a bill entered on or before this date will be deleted."
+3 SET DIR(0)="DOA^2880101:"_IBDT_":EX"
SET DIR("A")="End Date for Delete: "
+4 DO ^DIR
KILL DIR
if 'Y
GOTO DELDTQ
SET IBDT=+Y
+5 ;
+6 SET IBCE=0
FOR
SET IBCE=$ORDER(^IBA(362.1,IBCE))
if 'IBCE
QUIT
SET X=$GET(^IBA(362.1,IBCE,0))
IF $PIECE(X,U,5)'>IBDT
IF '$PIECE(X,U,3)
Begin DoDot:1
+7 SET DIK="^IBA(362.1,"
SET DA=IBCE
DO ^DIK
WRITE "."
End DoDot:1
DELDTQ KILL IBCE,DIK,DIC,DA,X,Y
+1 QUIT
