- IBTUBAV ;ALB/AAS - UNBILLED AMOUNTS - AVERAGE BILL AMOUNT LOGIC ; 29-SEP-94
- ;;2.0;INTEGRATED BILLING;**19,123**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- % ; - Entry point for manual option.
- I '$D(DT) D DT^DICRW
- W !
- ;
- DATE ; - Select date.
- W ! D DT2^IBTUBOU("Average Bill Amounts") G:IBTIMON="^" END
- ;
- DEV ; - Select device.
- W !!,"This will automatically be tasked to run and needs no device."
- W !!,"A mail Message will be sent when the process completes."
- W !,"Use the option View Unbilled Amounts to see cumulative totals.",!!
- S ZTRTN="DQ^IBTUBAV",ZTSAVE("IB*")="",ZTIO=""
- S ZTDESC="IB - Generate Avg. Bill Amounts for a Month"
- D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
- ;
- AUTO ; - Entry point for scheduled option (update monthly number of bills
- ; and prior 12 months fields).
- ;
- S IBCOMP=1 ; This will cause the mail msg to be sent to all the users
- ; on the Unbilled Amounts mail group (see SEND^IBTUBUL).
- ;
- DQ ; - Entry point for user options when queued.
- K ^TMP($J,"IBTUBAV"),^TMP($J,"IBTUBAV1")
- ;
- ; - If no IBTIMON or in the future, sets it with current Month
- I '$G(IBTIMON)!($G(IBTIMON)>(DT\100*100)) S IBTIMON=DT\100*100
- ;
- ; - Sets IBGMON with the 1st month 1 year prior to IBTIMON
- S IBGMON=IBTIMON-10000
- ;
- ; AUG/1993 should be the first month in the Unbilled Amounts File
- I IBGMON>2930800,'$D(^IBE(356.19,2930800,0)) D
- . S IBGMON=2930800
- ;
- ; - Calculate/Store the Unbilled Amounts Data for the past 12 months
- ; (Prior to IBTIMON, does NOT include IBTIMON)
- F Q:IBGMON'<IBTIMON D
- . ; - If there is no entry for the month, try to create an entry
- . I '$D(^IBE(356.19,IBGMON,0)),'$$ADD(IBGMON) D Q
- . . S IBGMON=$$FMADD^XLFDT(IBGMON,32)\100*100
- . ;
- . D MONTH(IBGMON) ; - Calculate MONTHLY totals and store if necessary
- . D YEAR(IBGMON) ; - Calculate YEARLY totals and store if necessary
- . ;
- . S IBGMON=$$FMADD^XLFDT(IBGMON,32)\100*100
- ;
- ; - Calculate/Store MONTHLY & YEARLY totals for IBTIMON, if not the
- ; current month
- I $$ADD(IBTIMON),IBTIMON<(DT\100*100) D MONTH(IBTIMON,1)
- D YEAR(IBTIMON,1)
- ;
- I $D(^TMP($J,"IBTUBAV"))!($D(^TMP($J,"IBTUBAV1"))) D SEND
- ;
- END K ^TMP($J,"IBTUBAV"),^TMP($J,"IBTUBAV1")
- I $D(ZTQUEUED) S ZTREQ="@" Q
- K IBTIMON,IBCOMP,D,DIRUT,D0,%DT
- Q
- ;
- MONTH(IBYRMO,IBOVRW) ; - Calculate/update Inpatient Unbilled Amounts
- ; Input: IBYRMO - YEAR/MONTH (YYYMM00) being calculated/updated
- ; IBOVRW - Overwrite the data currently on file? (1-YES/0-NO)
- ;
- N BGDT,ENDT,IBAVG,IBAMT,IBDA,IBDFN,IBDT,IBNOD,X
- ;
- I '$G(IBYRMO) Q
- K ^TMP($J,"IBTUBAV2")
- ;
- ; - If MONTHLY Average has already been calculated & NOT Overwrite->QUIT
- I '$G(IBOVRW),$P($G(^IBE(356.19,IBYRMO,1)),"^",13)'="" Q
- ;
- S BGDT=IBYRMO+1,ENDT=IBYRMO+32
- ;
- ; - Initialize the IBAVG array (set at line tag INPT)
- F X="I","P" S (IBAVG("$AMNT-"_X),IBAVG("BILLS-"_X),IBAVG("EPISD-"_X))=0
- ;
- ; - Loop through date entered x-ref starting a year prior to the period
- S IBDT=BGDT-10000
- F S IBDT=$O(^DGCR(399,"APD",IBDT)) Q:'IBDT!(IBDT>ENDT) D
- . S IBDA=0 F S IBDA=$O(^DGCR(399,"APD",IBDT,IBDA)) Q:'IBDA D
- . . S IBNOD=$G(^DGCR(399,+IBDA,0))
- . . I $P(IBNOD,U,11)'="i" Q ; Not reimbursable insurance bill
- . . S X=$P(IBNOD,U,13) Q:X<3!(X>6) ; Status not authorized or printed
- . . S X=$P($G(^DGCR(399,+IBDA,"S")),U,10)
- . . I X=""!(X<BGDT)!(X>ENDT) Q ; Date authorized must be in period
- . . I $P(IBNOD,U,5)<3 D INPT
- ;
- ; - Updates file #356.19 with MONTHLY totals (Inpatient)
- S IBAVG("$AMNT-I")=$J(IBAVG("$AMNT-I"),0,2)
- S IBAVG("$AMNT-P")=$J(IBAVG("$AMNT-P"),0,2)
- D LD^IBTUBOU(1,IBYRMO) S ^TMP($J,"IBTUBAV",IBYRMO)=""
- ;
- K ^TMP($J,"IBTUBAV2") Q
- ;
- INPT ; - For inpatient bills (add count of bills/total dollars).
- S IBDFN=$P(IBNOD,U,2,3),IBAMT=+$G(^DGCR(399,IBDA,"U1"))
- I $P(IBNOD,U,27)=1!($P(IBNOD,U,19)=3) D G INP1
- . S IBAVG("BILLS-I")=IBAVG("BILLS-I")+1
- . S IBAVG("$AMNT-I")=IBAVG("$AMNT-I")+IBAMT
- . S IBDFN=IBDFN_"^I"
- ;
- I $P(IBNOD,U,27)=2!($P(IBNOD,U,19)=2) D G INP1
- . S IBAVG("BILLS-P")=IBAVG("BILLS-P")+1
- . S IBAVG("$AMNT-P")=IBAVG("$AMNT-P")+IBAMT
- . S IBDFN=IBDFN_"^P"
- ;
- G INPQ
- ;
- INP1 ; - Add number of inpatient episodes.
- I '$D(^TMP($J,"IBTUBAV2",IBDFN)) D
- . S Y=$P(IBDFN,U,3),IBAVG("EPISD-"_Y)=IBAVG("EPISD-"_Y)+1
- . S ^TMP($J,"IBTUBAV2",IBDFN)=""
- ;
- INPQ Q
- ;
- YEAR(IBYRMO,IBOVRW) ; - Calculate YEARLY totals, and store if necessary
- ; - Input: IBYRMO - YEAR/MONTH (YYYMM00) being calculated/updated
- ; IBOVRW - Overwrite the data currently on file? (1-YES/0-NO)
- ;
- N IBAVG,IBTMON,IBGMON,IBTNMON,DA,DIC,DIE,DR,SUBCNT,I,X
- I IBYRMO>(DT\100*100) G YEARQ ; Don't compile for future months.
- ;
- ; - If YEARLY Average has already been calculated -> QUIT
- I '$G(IBOVRW),$P($G(^IBE(356.19,IBYRMO,1)),"^",14)'="" Q
- ;
- ; - Initialize the array IBAVG for Institutional and Professional
- F X="I","P" D
- . S (IBAVG("$AMNT-"_X),IBAVG("BILLS-"_X),IBAVG("EPISD-"_X))=0
- ;
- ; Sets IBGMON with the 1st day of month 1 year prior to IBYRMO
- S IBGMON=IBYRMO-9999,SUBCNT=0
- F I=1:1:12 S IBTMON=IBGMON\100*100 Q:IBTMON'<IBYRMO D
- . S X=$G(^IBE(356.19,IBTMON,1))
- . S IBAVG("BILLS-I")=IBAVG("BILLS-I")+$P(X,U)
- . S IBAVG("$AMNT-I")=IBAVG("$AMNT-I")+$P(X,U,2)
- . S IBAVG("EPISD-I")=IBAVG("EPISD-I")+$P(X,U,3)
- . S IBAVG("BILLS-P")=IBAVG("BILLS-P")+$P(X,U,4)
- . S IBAVG("$AMNT-P")=IBAVG("$AMNT-P")+$P(X,U,5)
- . S IBAVG("EPISD-P")=IBAVG("EPISD-P")+$P(X,U,6)
- . S IBGMON=$$FMADD^XLFDT(IBGMON,31),SUBCNT=SUBCNT+1
- ;
- I SUBCNT<6 G YEARQ ; If less than 6 months of data don't store.
- S IBAVG("$AMNT-I")=$J(IBAVG("$AMNT-I"),0,2)
- S IBAVG("$AMNT-P")=$J(IBAVG("$AMNT-P"),0,2)
- D LD^IBTUBOU(2,IBYRMO) ; Add to file #356.19 entry.
- S ^TMP($J,"IBTUBAV1",IBYRMO)=""
- ;
- YEARQ Q
- ;
- SEND ; - Send a mail message to the Unbilled Amounts mail group informing
- ; which months had their data (MONTHLY & YEARLY) updated.
- N IBCNT,IBGRP,IBDT,IBT,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,I,X
- S XMSUB="UNBILLED AMOUNTS JOB FOR "_$$DAT2^IBOUTL(IBTIMON)
- S IBT(1)="The background job responsible for calculating and updating MONTHLY and"
- S IBT(2)="YEARLY Average Bill Amounts and Bill numbers for inpatient episodes has"
- S IBT(3)="successfully completed.",IBT(4)=""
- S IBCNT=5,IBDT=0
- F S IBDT=$O(^TMP($J,"IBTUBAV",IBDT)) Q:'IBDT D
- . S IBT(IBCNT)="Monthly totals calculated for "_$$DAT2^IBOUTL(IBDT)
- . S IBCNT=IBCNT+1
- S IBT(IBCNT)="",IBCNT=IBCNT+1,IBDT=0
- F S IBDT=$O(^TMP($J,"IBTUBAV1",IBDT)) Q:'IBDT D
- . S IBT(IBCNT)="Yearly totals calculated for "_$$DAT2^IBOUTL(IBDT)
- . S IBCNT=IBCNT+1
- S IBT(IBCNT)="" D SEND^IBTUBUL
- ;
- Q
- ;
- ADD(IBYRMO) ; - Add entry to file 356.19 (unbilled amounts file).
- ; Input: IBYRMO=date/time in month year format no days allowed
- ; Output: IBADD=1-entry or entry added, 0-not added or error
- N IBADD,DA,DD,DIC,DIE,DO,DR,Y S IBADD=0
- I IBYRMO'?7N!($E(IBYRMO,6,7)'="00") G ADDQ
- I $D(^IBE(356.19,IBYRMO,0)) S IBADD=1 G ADDQ
- S DIC="^IBE(356.19,",DIC(0)="L",DLAYGO=356.19
- L +^IBE(356.19,IBYRMO):0
- I $T S (DINUM,X)=IBYRMO D FILE^DICN I +Y>0 S IBADD=1
- L -^IBE(356.19,IBYRMO)
- ;
- ADDQ Q IBADD
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTUBAV 7228 printed Jan 18, 2025@03:30:14 Page 2
- IBTUBAV ;ALB/AAS - UNBILLED AMOUNTS - AVERAGE BILL AMOUNT LOGIC ; 29-SEP-94
- +1 ;;2.0;INTEGRATED BILLING;**19,123**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- % ; - Entry point for manual option.
- +1 IF '$DATA(DT)
- DO DT^DICRW
- +2 WRITE !
- +3 ;
- DATE ; - Select date.
- +1 WRITE !
- DO DT2^IBTUBOU("Average Bill Amounts")
- if IBTIMON="^"
- GOTO END
- +2 ;
- DEV ; - Select device.
- +1 WRITE !!,"This will automatically be tasked to run and needs no device."
- +2 WRITE !!,"A mail Message will be sent when the process completes."
- +3 WRITE !,"Use the option View Unbilled Amounts to see cumulative totals.",!!
- +4 SET ZTRTN="DQ^IBTUBAV"
- SET ZTSAVE("IB*")=""
- SET ZTIO=""
- +5 SET ZTDESC="IB - Generate Avg. Bill Amounts for a Month"
- +6 DO ^%ZTLOAD
- KILL IO("Q"),ZTSK
- DO HOME^%ZIS
- GOTO END
- +7 ;
- AUTO ; - Entry point for scheduled option (update monthly number of bills
- +1 ; and prior 12 months fields).
- +2 ;
- +3 ; This will cause the mail msg to be sent to all the users
- SET IBCOMP=1
- +4 ; on the Unbilled Amounts mail group (see SEND^IBTUBUL).
- +5 ;
- DQ ; - Entry point for user options when queued.
- +1 KILL ^TMP($JOB,"IBTUBAV"),^TMP($JOB,"IBTUBAV1")
- +2 ;
- +3 ; - If no IBTIMON or in the future, sets it with current Month
- +4 IF '$GET(IBTIMON)!($GET(IBTIMON)>(DT\100*100))
- SET IBTIMON=DT\100*100
- +5 ;
- +6 ; - Sets IBGMON with the 1st month 1 year prior to IBTIMON
- +7 SET IBGMON=IBTIMON-10000
- +8 ;
- +9 ; AUG/1993 should be the first month in the Unbilled Amounts File
- +10 IF IBGMON>2930800
- IF '$DATA(^IBE(356.19,2930800,0))
- Begin DoDot:1
- +11 SET IBGMON=2930800
- End DoDot:1
- +12 ;
- +13 ; - Calculate/Store the Unbilled Amounts Data for the past 12 months
- +14 ; (Prior to IBTIMON, does NOT include IBTIMON)
- +15 FOR
- if IBGMON'<IBTIMON
- QUIT
- Begin DoDot:1
- +16 ; - If there is no entry for the month, try to create an entry
- +17 IF '$DATA(^IBE(356.19,IBGMON,0))
- IF '$$ADD(IBGMON)
- Begin DoDot:2
- +18 SET IBGMON=$$FMADD^XLFDT(IBGMON,32)\100*100
- End DoDot:2
- QUIT
- +19 ;
- +20 ; - Calculate MONTHLY totals and store if necessary
- DO MONTH(IBGMON)
- +21 ; - Calculate YEARLY totals and store if necessary
- DO YEAR(IBGMON)
- +22 ;
- +23 SET IBGMON=$$FMADD^XLFDT(IBGMON,32)\100*100
- End DoDot:1
- +24 ;
- +25 ; - Calculate/Store MONTHLY & YEARLY totals for IBTIMON, if not the
- +26 ; current month
- +27 IF $$ADD(IBTIMON)
- IF IBTIMON<(DT\100*100)
- DO MONTH(IBTIMON,1)
- +28 DO YEAR(IBTIMON,1)
- +29 ;
- +30 IF $DATA(^TMP($JOB,"IBTUBAV"))!($DATA(^TMP($JOB,"IBTUBAV1")))
- DO SEND
- +31 ;
- END KILL ^TMP($JOB,"IBTUBAV"),^TMP($JOB,"IBTUBAV1")
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +2 KILL IBTIMON,IBCOMP,D,DIRUT,D0,%DT
- +3 QUIT
- +4 ;
- MONTH(IBYRMO,IBOVRW) ; - Calculate/update Inpatient Unbilled Amounts
- +1 ; Input: IBYRMO - YEAR/MONTH (YYYMM00) being calculated/updated
- +2 ; IBOVRW - Overwrite the data currently on file? (1-YES/0-NO)
- +3 ;
- +4 NEW BGDT,ENDT,IBAVG,IBAMT,IBDA,IBDFN,IBDT,IBNOD,X
- +5 ;
- +6 IF '$GET(IBYRMO)
- QUIT
- +7 KILL ^TMP($JOB,"IBTUBAV2")
- +8 ;
- +9 ; - If MONTHLY Average has already been calculated & NOT Overwrite->QUIT
- +10 IF '$GET(IBOVRW)
- IF $PIECE($GET(^IBE(356.19,IBYRMO,1)),"^",13)'=""
- QUIT
- +11 ;
- +12 SET BGDT=IBYRMO+1
- SET ENDT=IBYRMO+32
- +13 ;
- +14 ; - Initialize the IBAVG array (set at line tag INPT)
- +15 FOR X="I","P"
- SET (IBAVG("$AMNT-"_X),IBAVG("BILLS-"_X),IBAVG("EPISD-"_X))=0
- +16 ;
- +17 ; - Loop through date entered x-ref starting a year prior to the period
- +18 SET IBDT=BGDT-10000
- +19 FOR
- SET IBDT=$ORDER(^DGCR(399,"APD",IBDT))
- if 'IBDT!(IBDT>ENDT)
- QUIT
- Begin DoDot:1
- +20 SET IBDA=0
- FOR
- SET IBDA=$ORDER(^DGCR(399,"APD",IBDT,IBDA))
- if 'IBDA
- QUIT
- Begin DoDot:2
- +21 SET IBNOD=$GET(^DGCR(399,+IBDA,0))
- +22 ; Not reimbursable insurance bill
- IF $PIECE(IBNOD,U,11)'="i"
- QUIT
- +23 ; Status not authorized or printed
- SET X=$PIECE(IBNOD,U,13)
- if X<3!(X>6)
- QUIT
- +24 SET X=$PIECE($GET(^DGCR(399,+IBDA,"S")),U,10)
- +25 ; Date authorized must be in period
- IF X=""!(X<BGDT)!(X>ENDT)
- QUIT
- +26 IF $PIECE(IBNOD,U,5)<3
- DO INPT
- End DoDot:2
- End DoDot:1
- +27 ;
- +28 ; - Updates file #356.19 with MONTHLY totals (Inpatient)
- +29 SET IBAVG("$AMNT-I")=$JUSTIFY(IBAVG("$AMNT-I"),0,2)
- +30 SET IBAVG("$AMNT-P")=$JUSTIFY(IBAVG("$AMNT-P"),0,2)
- +31 DO LD^IBTUBOU(1,IBYRMO)
- SET ^TMP($JOB,"IBTUBAV",IBYRMO)=""
- +32 ;
- +33 KILL ^TMP($JOB,"IBTUBAV2")
- QUIT
- +34 ;
- INPT ; - For inpatient bills (add count of bills/total dollars).
- +1 SET IBDFN=$PIECE(IBNOD,U,2,3)
- SET IBAMT=+$GET(^DGCR(399,IBDA,"U1"))
- +2 IF $PIECE(IBNOD,U,27)=1!($PIECE(IBNOD,U,19)=3)
- Begin DoDot:1
- +3 SET IBAVG("BILLS-I")=IBAVG("BILLS-I")+1
- +4 SET IBAVG("$AMNT-I")=IBAVG("$AMNT-I")+IBAMT
- +5 SET IBDFN=IBDFN_"^I"
- End DoDot:1
- GOTO INP1
- +6 ;
- +7 IF $PIECE(IBNOD,U,27)=2!($PIECE(IBNOD,U,19)=2)
- Begin DoDot:1
- +8 SET IBAVG("BILLS-P")=IBAVG("BILLS-P")+1
- +9 SET IBAVG("$AMNT-P")=IBAVG("$AMNT-P")+IBAMT
- +10 SET IBDFN=IBDFN_"^P"
- End DoDot:1
- GOTO INP1
- +11 ;
- +12 GOTO INPQ
- +13 ;
- INP1 ; - Add number of inpatient episodes.
- +1 IF '$DATA(^TMP($JOB,"IBTUBAV2",IBDFN))
- Begin DoDot:1
- +2 SET Y=$PIECE(IBDFN,U,3)
- SET IBAVG("EPISD-"_Y)=IBAVG("EPISD-"_Y)+1
- +3 SET ^TMP($JOB,"IBTUBAV2",IBDFN)=""
- End DoDot:1
- +4 ;
- INPQ QUIT
- +1 ;
- YEAR(IBYRMO,IBOVRW) ; - Calculate YEARLY totals, and store if necessary
- +1 ; - Input: IBYRMO - YEAR/MONTH (YYYMM00) being calculated/updated
- +2 ; IBOVRW - Overwrite the data currently on file? (1-YES/0-NO)
- +3 ;
- +4 NEW IBAVG,IBTMON,IBGMON,IBTNMON,DA,DIC,DIE,DR,SUBCNT,I,X
- +5 ; Don't compile for future months.
- IF IBYRMO>(DT\100*100)
- GOTO YEARQ
- +6 ;
- +7 ; - If YEARLY Average has already been calculated -> QUIT
- +8 IF '$GET(IBOVRW)
- IF $PIECE($GET(^IBE(356.19,IBYRMO,1)),"^",14)'=""
- QUIT
- +9 ;
- +10 ; - Initialize the array IBAVG for Institutional and Professional
- +11 FOR X="I","P"
- Begin DoDot:1
- +12 SET (IBAVG("$AMNT-"_X),IBAVG("BILLS-"_X),IBAVG("EPISD-"_X))=0
- End DoDot:1
- +13 ;
- +14 ; Sets IBGMON with the 1st day of month 1 year prior to IBYRMO
- +15 SET IBGMON=IBYRMO-9999
- SET SUBCNT=0
- +16 FOR I=1:1:12
- SET IBTMON=IBGMON\100*100
- if IBTMON'<IBYRMO
- QUIT
- Begin DoDot:1
- +17 SET X=$GET(^IBE(356.19,IBTMON,1))
- +18 SET IBAVG("BILLS-I")=IBAVG("BILLS-I")+$PIECE(X,U)
- +19 SET IBAVG("$AMNT-I")=IBAVG("$AMNT-I")+$PIECE(X,U,2)
- +20 SET IBAVG("EPISD-I")=IBAVG("EPISD-I")+$PIECE(X,U,3)
- +21 SET IBAVG("BILLS-P")=IBAVG("BILLS-P")+$PIECE(X,U,4)
- +22 SET IBAVG("$AMNT-P")=IBAVG("$AMNT-P")+$PIECE(X,U,5)
- +23 SET IBAVG("EPISD-P")=IBAVG("EPISD-P")+$PIECE(X,U,6)
- +24 SET IBGMON=$$FMADD^XLFDT(IBGMON,31)
- SET SUBCNT=SUBCNT+1
- End DoDot:1
- +25 ;
- +26 ; If less than 6 months of data don't store.
- IF SUBCNT<6
- GOTO YEARQ
- +27 SET IBAVG("$AMNT-I")=$JUSTIFY(IBAVG("$AMNT-I"),0,2)
- +28 SET IBAVG("$AMNT-P")=$JUSTIFY(IBAVG("$AMNT-P"),0,2)
- +29 ; Add to file #356.19 entry.
- DO LD^IBTUBOU(2,IBYRMO)
- +30 SET ^TMP($JOB,"IBTUBAV1",IBYRMO)=""
- +31 ;
- YEARQ QUIT
- +1 ;
- SEND ; - Send a mail message to the Unbilled Amounts mail group informing
- +1 ; which months had their data (MONTHLY & YEARLY) updated.
- +2 NEW IBCNT,IBGRP,IBDT,IBT,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,I,X
- +3 SET XMSUB="UNBILLED AMOUNTS JOB FOR "_$$DAT2^IBOUTL(IBTIMON)
- +4 SET IBT(1)="The background job responsible for calculating and updating MONTHLY and"
- +5 SET IBT(2)="YEARLY Average Bill Amounts and Bill numbers for inpatient episodes has"
- +6 SET IBT(3)="successfully completed."
- SET IBT(4)=""
- +7 SET IBCNT=5
- SET IBDT=0
- +8 FOR
- SET IBDT=$ORDER(^TMP($JOB,"IBTUBAV",IBDT))
- if 'IBDT
- QUIT
- Begin DoDot:1
- +9 SET IBT(IBCNT)="Monthly totals calculated for "_$$DAT2^IBOUTL(IBDT)
- +10 SET IBCNT=IBCNT+1
- End DoDot:1
- +11 SET IBT(IBCNT)=""
- SET IBCNT=IBCNT+1
- SET IBDT=0
- +12 FOR
- SET IBDT=$ORDER(^TMP($JOB,"IBTUBAV1",IBDT))
- if 'IBDT
- QUIT
- Begin DoDot:1
- +13 SET IBT(IBCNT)="Yearly totals calculated for "_$$DAT2^IBOUTL(IBDT)
- +14 SET IBCNT=IBCNT+1
- End DoDot:1
- +15 SET IBT(IBCNT)=""
- DO SEND^IBTUBUL
- +16 ;
- +17 QUIT
- +18 ;
- ADD(IBYRMO) ; - Add entry to file 356.19 (unbilled amounts file).
- +1 ; Input: IBYRMO=date/time in month year format no days allowed
- +2 ; Output: IBADD=1-entry or entry added, 0-not added or error
- +3 NEW IBADD,DA,DD,DIC,DIE,DO,DR,Y
- SET IBADD=0
- +4 IF IBYRMO'?7N!($EXTRACT(IBYRMO,6,7)'="00")
- GOTO ADDQ
- +5 IF $DATA(^IBE(356.19,IBYRMO,0))
- SET IBADD=1
- GOTO ADDQ
- +6 SET DIC="^IBE(356.19,"
- SET DIC(0)="L"
- SET DLAYGO=356.19
- +7 LOCK +^IBE(356.19,IBYRMO):0
- +8 IF $TEST
- SET (DINUM,X)=IBYRMO
- DO FILE^DICN
- IF +Y>0
- SET IBADD=1
- +9 LOCK -^IBE(356.19,IBYRMO)
- +10 ;
- ADDQ QUIT IBADD