- 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 Feb 18, 2025@23:35:43 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
