- IBAUTL9 ;ALB/MGD - DUPLICATE COPAY TRANSACTION UTILITIES - MESSAGING ; Sep 30, 2020@15:16:44
- ;;2.0;INTEGRATED BILLING;**630**;21-MAR-94;Build 39
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; **************************************************************************
- ; IBAUTL9 handles the storing of associated information related to any *
- ; duplicate copays found by IBAUTL8. *
- ; These updates are part being released in IB*2.0*630. *
- ; **************************************************************************
- ;
- STORE1(IBN,IBIEN,IBRSN) ;
- ; Input: IBN = IEN of charge in the INTEGRATED BILLING ACTION (#350) file
- ; that will be cancelled and NOT sent over to AR
- ; IBIEN = IEN of the existing charge which has a higher precedence
- ; IBRSN = Text describing why the charge was not passed from IB to AR
- ; Output: 7 lines of data will be added to ^XTMP("IB TRANS")
- ; The data will have the following format:
- ; PATIENT EVENT DATE
- ; CANCELLED CHARGE IN IB:
- ; BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE
- ; EXISTING CHARGE IN AR:
- ; BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE
- ; REASON - REASON WHY CHARGE WAS CANCELLED
- ; <blank line>
- ;
- ; At the end of the nightly scheduled IB MT NIGHT COMP process a check will
- ; be made for the existence of ^XTMP("IB TRANS"). If ^XTMP("IB TRANS") exists,
- ; a MailMan message, which can't be forwarded, will be sent to the
- ; IB DUPLICATE TRANSACTIONS mail group with the info stored in this temp file.
- ;
- ; Quit if either IBN or IBIEN not defined
- Q:IBN=""!(IBIEN="")
- ; If IBRSN not passed in set it to null
- S IBRSN=$S(IBRSN'="":IBRSN,1:"")
- N IBCNT,IBPAT,IBATYP1,IBTCH1,IBBIL1,IBTRN1,IBATYP2,IBTCH2,IBBIL2,IBTRN2,IBTEXT,IBDATE
- ; Determine the index number to use for storing this record & create 0 node
- S IBCNT=$$COUNTER()
- ; If the 1 node of ^XTMP("IB TRANS") does not exist, create it and HEADER1
- I '$D(^XTMP("IB TRANS",1)) D INTRO(IBCNT),HEADER1(IBCNT)
- ; If the HEADER1 does not exist, create it
- I '$D(^XTMP("IB TRANS",10)) D HEADER1(IBCNT)
- ; Get data in External format for charge being cancelled and not passed to AR
- S IBPAT=$$GET1^DIQ(350,IBN_",",".02","E") ; PATIENT
- S IBATYP1=$$GET1^DIQ(350,IBN_",",".03","E") ; ACTION TYPE
- S IBTCH1=$$GET1^DIQ(350,IBN_",",".07","E") ; TOTAL CHARGE
- S IBBIL1=$$GET1^DIQ(350,IBN_",",".11","E") ; AR BILL NUMBER
- S IBTRN1=$$GET1^DIQ(350,IBN_",",".12","E") ; AR TRANSACTION NUMBER
- S IBDATE=$$GET1^DIQ(350,IBN_",",".17","E") ; EVENT DATE
- I IBDATE="" S IBDATE=$$GET1^DIQ(350,IBN_",",".14","E") ; DATE BILLED FROM
- ; Mark any null field as UNKNOWN
- I IBPAT="" S IBPAT="UNKNOWN"
- I IBATYP1="" S IBATYP1="UNKNOWN"
- I IBTCH1="" S IBTCH1="UNKNOWN"
- I IBBIL1="" S IBBIL1="UNKNOWN"
- I IBTRN1="" S IBTRN1="UNKNOWN"
- I IBDATE="" S IBDATE="UNKNOWN"
- ; Get data in External format for existing charge in AR
- S IBATYP2=$$GET1^DIQ(350,IBIEN_",",".03","E") ; ACTION TYPE
- S IBTCH2=$$GET1^DIQ(350,IBIEN_",",".07","E") ; TOTAL CHARGE
- S IBBIL2=$$GET1^DIQ(350,IBIEN_",",".11","E") ; AR BILL NUMBER
- S IBTRN2=$$GET1^DIQ(350,IBIEN_",",".12","E") ; AR TRANSACTION NUMBER
- ; Mark any null field as UNKNOWN
- I IBATYP2="" S IBATYP2="UNKNOWN"
- I IBTCH2="" S IBTCH2="UNKNOWN"
- I IBBIL2="" S IBBIL2="UNKNOWN"
- I IBTRN2="" S IBTRN2="UNKNOWN"
- ; If Reason not passed in, set it to UNKNOWN
- I $G(IBRSN)="" S IBRSN="UNKNOWN"
- ; Parse together the data for each line of the message
- ; Line #1
- S IBTEXT=IBPAT,$E(IBTEXT,35)="",IBTEXT=IBTEXT_"RECORD # "_IBCNT,$E(IBTEXT,63)="",IBTEXT=IBTEXT_$J(IBDATE,12)
- S ^XTMP("IB TRANS",11,IBCNT,1)=IBTEXT
- ; Line #2
- S ^XTMP("IB TRANS",11,IBCNT,2)=" IB CHARGE PASSED TO AR::"
- ; Line #3
- S IBTEXT=" "_IBBIL1,$E(IBTEXT,18)="",IBTEXT=IBTEXT_IBTRN1,$E(IBTEXT,32)=""
- S IBTEXT=IBTEXT_IBATYP1,$E(IBTEXT,68)="",IBTEXT=IBTEXT_$S(+IBTCH1:$J(IBTCH1,7,2),1:IBTCH1)
- S ^XTMP("IB TRANS",11,IBCNT,3)=IBTEXT
- ; Line #4
- S ^XTMP("IB TRANS",11,IBCNT,4)=" EXISTING CHARGE IN AR:"
- ; Line #5
- S IBTEXT=" "_IBBIL2,$E(IBTEXT,18)="",IBTEXT=IBTEXT_IBTRN2,$E(IBTEXT,32)=""
- S IBTEXT=IBTEXT_IBATYP2,$E(IBTEXT,68)="",IBTEXT=IBTEXT_$S(+IBTCH2:$J(IBTCH2,7,2),1:IBTCH2)
- S ^XTMP("IB TRANS",11,IBCNT,5)=IBTEXT
- ; Line #6
- S IBTEXT=" REASON - "_IBRSN
- S ^XTMP("IB TRANS",11,IBCNT,6)=IBTEXT
- ; Line #7 blank line for separation
- S ^XTMP("IB TRANS",11,IBCNT,7)=""
- ; Call STORE3 to log symbol table into ^XTMP("IB TRANS")
- ;D STORE3(IBPAT,IBDATE,IBCNT)
- Q
- ;
- STORE2(IBN,IBIEN,IBRSN) ;
- ; Input: IBN = IEN of charge in the INTEGRATED BILLING ACTION (#350) file
- ; that will be sent over to AR
- ; IBIEN = IEN of the existing charge in AR which will be Cancelled
- ; IBRSN = Text describing why the charge in AR was Cancelled
- ; Output: 7 lines of data will be added to ^XTMP("IB TRANS")
- ; The data will have the following format:
- ; PATIENT EVENT DATE
- ; CANCELLED CHARGE IN AR:
- ; BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE
- ; IB CHARGE PASSED TO AR:
- ; BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE
- ; REASON - REASON WHY CHARGE WAS CANCELLED
- ; <blank line>
- ;
- ; At the end of the nightly scheduled IB MT NIGHT COMP process a check will
- ; be made for the existence of ^XTMP("IB TRANS"). If ^XTMP("IB TRANS") exists,
- ; a MailMan message, which can't be forwarded, will be sent to the
- ; IB DUPLICATE TRANSACTIONS mail group with the info stored in this temp file.
- ;
- ; Quit if either IBN or IBIEN not defined
- Q:IBN=""!(IBIEN="")
- ; If IBRSN not passed in set it to null
- S IBRSN=$S(IBRSN'="":IBRSN,1:"")
- N IBCNT,IBPAT,IBATYP1,IBTCH1,IBBIL1,IBTRN1,IBATYP2,IBTCH2,IBBIL2,IBTRN2,IBTEXT,IBDATE
- ; Determine the index number to use for storing this record & create 0 node
- S IBCNT=$$COUNTER()
- ; If the 1 node of ^XTMP("IB TRANS") does not exist, create it and HEADER1
- I '$D(^XTMP("IB TRANS",1)) D INTRO(IBCNT),HEADER2(IBCNT)
- ; If the HEADER1 does not exist, create it
- I '$D(^XTMP("IB TRANS",5000)) D HEADER2(IBCNT)
- ; Get data in External format for charge being passed to AR
- S IBPAT=$$GET1^DIQ(350,IBIEN_",",".02","E") ; PATIENT
- S IBATYP1=$$GET1^DIQ(350,IBIEN_",",".03","E") ; ACTION TYPE
- S IBTCH1=$$GET1^DIQ(350,IBIEN_",",".07","E") ; TOTAL CHARGE
- S IBBIL1=$$GET1^DIQ(350,IBIEN_",",".11","E") ; AR BILL NUMBER
- S IBTRN1=$$GET1^DIQ(350,IBIEN_",",".12","E") ; AR TRANSACTION NUMBER
- S IBDATE=$$GET1^DIQ(350,IBIEN_",",".17","E") ; EVENT DATE
- I IBDATE="" S IBDATE=$$GET1^DIQ(350,IBN_",",".14","E") ; DATE BILLED FROM
- ; Mark any null field as UNKNOWN
- I IBPAT="" S IBPAT="UNKNOWN"
- I IBATYP1="" S IBATYP1="UNKNOWN"
- I IBTCH1="" S IBTCH1="UNKNOWN"
- I IBBIL1="" S IBBIL1="UNKNOWN"
- I IBTRN1="" S IBTRN1="UNKNOWN"
- I IBDATE="" S IBDATE="UNKNOWN"
- ; Get data in External format for existing charge in AR being cancelled
- S IBATYP2=$$GET1^DIQ(350,IBN_",",".03","E") ; ACTION TYPE
- S IBTCH2=$$GET1^DIQ(350,IBN_",",".07","E") ; TOTAL CHARGE
- S IBBIL2=$$GET1^DIQ(350,IBN_",",".11","E") ; AR BILL NUMBER
- S IBTRN2=$$GET1^DIQ(350,IBN_",",".12","E") ; AR TRANSACTION NUMBER
- ; Mark any null field as UNKNOWN
- I IBATYP2="" S IBATYP2="UNKNOWN"
- I IBTCH2="" S IBTCH2="UNKNOWN"
- I IBBIL2="" S IBBIL2="UNKNOWN"
- I IBTRN2="" S IBTRN2="UNKNOWN"
- ; If Reason not passed in, set it to UNKNOWN
- I $G(IBRSN)="" S IBRSN="UNKNOWN"
- ; Parse together the data for each line of the message
- ; Line #1
- S IBTEXT=IBPAT,$E(IBTEXT,35)="",IBTEXT=IBTEXT_"RECORD # "_IBCNT,$E(IBTEXT,63)="",IBTEXT=IBTEXT_$J(IBDATE,12)
- S ^XTMP("IB TRANS",5001,IBCNT,1)=IBTEXT
- ; Line #2
- S ^XTMP("IB TRANS",5001,IBCNT,2)=" EXISTING CHARGE IN AR:"
- ; Line #3
- S IBTEXT=" "_IBBIL1,$E(IBTEXT,18)="",IBTEXT=IBTEXT_IBTRN1,$E(IBTEXT,32)=""
- S IBTEXT=IBTEXT_IBATYP1,$E(IBTEXT,68)="",IBTEXT=IBTEXT_$J(IBTCH1,7,2)
- S ^XTMP("IB TRANS",5001,IBCNT,3)=IBTEXT
- ; Line #4
- S ^XTMP("IB TRANS",5001,IBCNT,4)=" IB CHARGE PASSED TO AR:"
- ; Line #5
- S IBTEXT=" "_IBBIL2,$E(IBTEXT,18)="",IBTEXT=IBTEXT_IBTRN2,$E(IBTEXT,32)=""
- S IBTEXT=IBTEXT_IBATYP2,$E(IBTEXT,68)="",IBTEXT=IBTEXT_$J(IBTCH2,7,2)
- S ^XTMP("IB TRANS",5001,IBCNT,5)=IBTEXT
- ; Line #6
- S IBTEXT=" REASON - "_IBRSN
- S ^XTMP("IB TRANS",5001,IBCNT,6)=IBTEXT
- ; Line #7 blank line for separation
- S ^XTMP("IB TRANS",5001,IBCNT,7)=""
- ; Call STORE3 to log symbol table into ^XTMP("IB TRANS")
- ;D STORE3(IBPAT,IBDATE,IBCNT)
- Q
- ;
- STORE3(IBPAT,IBDATE,IBCNT) ;
- ; Called from STORE1 or STORE2 so header and transaction data should already
- ; be stored.
- ; Input: IBPAT = Patient's name in external format
- ; IBDAT = Event Date in external format
- ; IBCNT = The IEN to store the data under
- ; Output: The contents of the stack and symbol table when the action was taken
- ; on the transaction(s).
- ;
- ; Validate input variables
- S IBPAT=$S($G(IBPAT)'="":IBPAT,1:"Patient Name Missing")
- I $G(IBDATE)="" D
- .N Y,%,IBBBA,IBCNT1,IBCNT2,IBY,IBX
- .D NOW^%DTC S Y=%
- .D DD^%DT S IBDATE=Y
- S IBCNT=$S(IBCNT>0:IBCNT,1:$$COUNTER())
- I '$D(^XTMP("IB TRANS",10000)) D HEADER3(IBCNT)
- ; Set the 100 node = DFN ^ DATE
- S ^XTMP("IB TRANS",10001,IBCNT,100)=IBCNT_U_$G(DUZ)_U_$G(DT)
- ; Get last entry in the Stack
- S IBBBA=$ST(-1)
- ; Loop to store stack info into ^XTMP("IB TRANS",10001,#,998
- F IBCNT1=0:1:IBBBA S ^XTMP("IB TRANS",10001,IBCNT,998,IBCNT1)=$ST(IBCNT1) F IBCNT2="ECODE","MCODE","PLACE" S ^XTMP("IB TRANS",10001,IBCNT,998,IBCNT1,IBCNT2)=$ST(IBCNT1,IBCNT2)
- ; Set up 999 node for local symbol table variables
- S IBX="^XTMP(""IB TRANS"",10001,"_IBCNT_","_(999)_","
- ; Loop to store local symbol table variables into ^XTMP("IB TRANS",10001,#,999
- S IBY="%" F M:$D(@IBY) @(IBX_"IBY)="_IBY) S IBY=$O(@IBY) Q:IBY=""
- ; Add line of === for separation
- S ^XTMP("IB TRANS",10001,IBCNT,9999)="================================================================================"
- Q
- ;
- INTRO(IBCNT) ;
- ; Input: IBCNT = IEN to store this header record
- ; Output: This API will set the 0 node in ^XTMP("IB TRANS") and will then store
- ; the introductory paragraph into ^XTMP("IB TRANS").
- ;
- S ^XTMP("IB TRANS",1,IBCNT,1)="The following Duplicate Copay related charges in Integrated Billing were"
- S ^XTMP("IB TRANS",1,IBCNT,2)="processed today. These charges should be reviewed to verify that they"
- S ^XTMP("IB TRANS",1,IBCNT,3)="were properly handled and that no additional charges or corrections need"
- S ^XTMP("IB TRANS",1,IBCNT,4)="to be made."
- S ^XTMP("IB TRANS",1,IBCNT,5)=""
- Q
- ;
- ; Input: IBCNT = IEN to store this header record
- ; Output: This API will set the header info for charges in IB that were NOT
- ; passed over to AR.
- ;
- Q:+IBCNT=0
- S ^XTMP("IB TRANS",10,IBCNT,1)="The following charges in IB were passed over to AR even though there were"
- S ^XTMP("IB TRANS",10,IBCNT,2)="existing charges in AR for the same patient and date at the same or higher"
- S ^XTMP("IB TRANS",10,IBCNT,3)="charge rate or precedence. These charges may need to be canceled with a"
- S ^XTMP("IB TRANS",10,IBCNT,4)="Cancellation Reason of: ENTERED IN ERROR."
- S ^XTMP("IB TRANS",10,IBCNT,5)=""
- S ^XTMP("IB TRANS",10,IBCNT,6)="PATIENT RECORD # EVENT DATE"
- S ^XTMP("IB TRANS",10,IBCNT,7)=" IB CHARGE PASSED TO AR:"
- S ^XTMP("IB TRANS",10,IBCNT,8)=" BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE"
- S ^XTMP("IB TRANS",10,IBCNT,9)=" EXISTING CHARGE IN AR:"
- S ^XTMP("IB TRANS",10,IBCNT,10)=" BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE"
- S ^XTMP("IB TRANS",10,IBCNT,11)=" REASON"
- S ^XTMP("IB TRANS",10,IBCNT,12)="=========================================================================="
- Q
- ;
- ; Input: IBCNT = IEN to store this header record
- ; Output: This API will set the header info for charges in IB that were
- ; passed over to AR.
- ;
- S ^XTMP("IB TRANS",5000,IBCNT,1)="The following charges in IB were passed over to AR even though there were"
- S ^XTMP("IB TRANS",5000,IBCNT,2)="existing charges in AR for the same patient and date at the same or lower"
- S ^XTMP("IB TRANS",5000,IBCNT,3)="charge rate or precedence. These existing charges in AR may need to be"
- S ^XTMP("IB TRANS",5000,IBCNT,4)="cancelled with a Cancellation Reason of: BILLED AT HIGHER TIER RATE."
- S ^XTMP("IB TRANS",5000,IBCNT,5)=""
- S ^XTMP("IB TRANS",5000,IBCNT,6)="PATIENT RECORD # EVENT DATE"
- S ^XTMP("IB TRANS",5000,IBCNT,7)=" EXISTING CHARGE IN AR:"
- S ^XTMP("IB TRANS",5000,IBCNT,8)=" BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE"
- S ^XTMP("IB TRANS",5000,IBCNT,9)=" IB CHARGE PASSED TO AR:"
- S ^XTMP("IB TRANS",5000,IBCNT,10)=" BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE"
- S ^XTMP("IB TRANS",5000,IBCNT,11)=" REASON"
- S ^XTMP("IB TRANS",5000,IBCNT,12)="=========================================================================="
- Q
- ;
- ; Input: IBCNT = IEN to store this header record
- ; Output: This API will set the header info for charges in IB that were
- ; passed over to AR.
- ;
- S ^XTMP("IB TRANS",10000,IBCNT,1)="The following data contains the stack and symbol table that was"
- S ^XTMP("IB TRANS",10000,IBCNT,2)="present when the record being processed was identified as a"
- S ^XTMP("IB TRANS",10000,IBCNT,3)="duplicate copay and as needing to have some action taken."
- S ^XTMP("IB TRANS",10000,IBCNT,4)="=========================================================================="
- Q
- ;
- XMIT ; Transmit Duplicate Transaction Info
- ;
- N IBCNT,IBCT,IBDATA,IBREF
- ; Check for data to be sent
- Q:'$D(^XTMP("IB TRANS"))
- ; Move data currently in ^XTMP("IB TRANS" into MailMan compatible format
- S IBREF="^XTMP(""IB TRANS"")",IBCNT=1
- ; Run the initial $Q to load the 0 node info which will NOT be included in the MailMan message
- S IBREF=$Q(@IBREF)
- F IBCT=0:0 S IBREF=$Q(@IBREF) Q:IBREF=""!(IBREF["IB TRANS1") D
- . I (IBREF'["10001") S ^XTMP("IB TRANS1",IBCNT)=@IBREF
- . I (IBREF["10001") D
- . . I $P(IBREF,",",4)["100" S ^XTMP("IB TRANS1",IBCNT)=@IBREF
- . . I $P(IBREF,",",4)["998" D
- . . . S IBDATA=$P(IBREF,",",6),IBDATA=$P(IBDATA,")",1)
- . . . S IBDATA=IBDATA_"="_@IBREF
- . . . S ^XTMP("IB TRANS1",IBCNT)=IBDATA
- . . I $P(IBREF,",",4)["999" D
- . . . S IBDATA=$P(IBREF,",",5),IBDATA=$P(IBDATA,")",1)
- . . . S IBDATA=IBDATA_"="_@IBREF
- . . . S ^XTMP("IB TRANS1",IBCNT)=IBDATA
- . S IBCNT=IBCNT+1
- N IBDATE,IBSTAT,XMTO,XMSUBJ,XMBODY,XMINSTR,XMDUZ,Y
- ; Get Station Number
- S IBSTAT=$$STANUM^IBAUTL9()
- ; Get Today's date in external format
- S Y=DT
- D DD^%DT
- S IBDATE=Y
- ; Set up MailMan with No Forward
- S XMSUBJ="Duplicate Processing for Station "_IBSTAT_" - "_IBDATE
- S XMDUZ=DUZ
- S XMTO("G.IB DUPLICATE TRANSACTIONS")=""
- S XMBODY="^XTMP(""IB TRANS1"")"
- S XMINSTR("FLAGS")="X"
- D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR)
- D HOME^%ZIS
- K ^XTMP("IB TRANS"),^XTMP("IB TRANS1")
- Q
- ;
- STANUM() ; Get Station Number
- ;
- S IBSTAT=$$KSP^XUPARAM("INST")_","
- S IBSTAT=$$GET1^DIQ(4,IBSTAT,99)
- Q IBSTAT
- ;
- COUNTER() ; Determine index to use for storing a record in ^XTMP(""IB TRANS"")
- ; Get current IEN and increment by 1
- N IBCNT
- S IBCNT=$P($G(^XTMP("IB TRANS",0)),U,4)+1
- ; If initial call, set all of 0 node
- I IBCNT=1 D
- . N X,X1,X2
- . ; Determine date 5 days in future in FileMan format
- . S X1=DT,X2=5
- . D C^%DTC
- . S ^XTMP("IB TRANS",0)=X_U_DT_U_"Duplicate Transaction Info"_U_IBCNT
- ; if subsequent call, only update IEN count
- I IBCNT>1 S $P(^XTMP("IB TRANS",0),U,4)=IBCNT
- ; Return current count to calling procedure
- Q IBCNT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAUTL9 16089 printed Jan 18, 2025@03:09:28 Page 2
- IBAUTL9 ;ALB/MGD - DUPLICATE COPAY TRANSACTION UTILITIES - MESSAGING ; Sep 30, 2020@15:16:44
- +1 ;;2.0;INTEGRATED BILLING;**630**;21-MAR-94;Build 39
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; **************************************************************************
- +5 ; IBAUTL9 handles the storing of associated information related to any *
- +6 ; duplicate copays found by IBAUTL8. *
- +7 ; These updates are part being released in IB*2.0*630. *
- +8 ; **************************************************************************
- +9 ;
- STORE1(IBN,IBIEN,IBRSN) ;
- +1 ; Input: IBN = IEN of charge in the INTEGRATED BILLING ACTION (#350) file
- +2 ; that will be cancelled and NOT sent over to AR
- +3 ; IBIEN = IEN of the existing charge which has a higher precedence
- +4 ; IBRSN = Text describing why the charge was not passed from IB to AR
- +5 ; Output: 7 lines of data will be added to ^XTMP("IB TRANS")
- +6 ; The data will have the following format:
- +7 ; PATIENT EVENT DATE
- +8 ; CANCELLED CHARGE IN IB:
- +9 ; BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE
- +10 ; EXISTING CHARGE IN AR:
- +11 ; BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE
- +12 ; REASON - REASON WHY CHARGE WAS CANCELLED
- +13 ; <blank line>
- +14 ;
- +15 ; At the end of the nightly scheduled IB MT NIGHT COMP process a check will
- +16 ; be made for the existence of ^XTMP("IB TRANS"). If ^XTMP("IB TRANS") exists,
- +17 ; a MailMan message, which can't be forwarded, will be sent to the
- +18 ; IB DUPLICATE TRANSACTIONS mail group with the info stored in this temp file.
- +19 ;
- +20 ; Quit if either IBN or IBIEN not defined
- +21 if IBN=""!(IBIEN="")
- QUIT
- +22 ; If IBRSN not passed in set it to null
- +23 SET IBRSN=$SELECT(IBRSN'="":IBRSN,1:"")
- +24 NEW IBCNT,IBPAT,IBATYP1,IBTCH1,IBBIL1,IBTRN1,IBATYP2,IBTCH2,IBBIL2,IBTRN2,IBTEXT,IBDATE
- +25 ; Determine the index number to use for storing this record & create 0 node
- +26 SET IBCNT=$$COUNTER()
- +27 ; If the 1 node of ^XTMP("IB TRANS") does not exist, create it and HEADER1
- +28 IF '$DATA(^XTMP("IB TRANS",1))
- DO INTRO(IBCNT)
- DO HEADER1(IBCNT)
- +29 ; If the HEADER1 does not exist, create it
- +30 IF '$DATA(^XTMP("IB TRANS",10))
- DO HEADER1(IBCNT)
- +31 ; Get data in External format for charge being cancelled and not passed to AR
- +32 ; PATIENT
- SET IBPAT=$$GET1^DIQ(350,IBN_",",".02","E")
- +33 ; ACTION TYPE
- SET IBATYP1=$$GET1^DIQ(350,IBN_",",".03","E")
- +34 ; TOTAL CHARGE
- SET IBTCH1=$$GET1^DIQ(350,IBN_",",".07","E")
- +35 ; AR BILL NUMBER
- SET IBBIL1=$$GET1^DIQ(350,IBN_",",".11","E")
- +36 ; AR TRANSACTION NUMBER
- SET IBTRN1=$$GET1^DIQ(350,IBN_",",".12","E")
- +37 ; EVENT DATE
- SET IBDATE=$$GET1^DIQ(350,IBN_",",".17","E")
- +38 ; DATE BILLED FROM
- IF IBDATE=""
- SET IBDATE=$$GET1^DIQ(350,IBN_",",".14","E")
- +39 ; Mark any null field as UNKNOWN
- +40 IF IBPAT=""
- SET IBPAT="UNKNOWN"
- +41 IF IBATYP1=""
- SET IBATYP1="UNKNOWN"
- +42 IF IBTCH1=""
- SET IBTCH1="UNKNOWN"
- +43 IF IBBIL1=""
- SET IBBIL1="UNKNOWN"
- +44 IF IBTRN1=""
- SET IBTRN1="UNKNOWN"
- +45 IF IBDATE=""
- SET IBDATE="UNKNOWN"
- +46 ; Get data in External format for existing charge in AR
- +47 ; ACTION TYPE
- SET IBATYP2=$$GET1^DIQ(350,IBIEN_",",".03","E")
- +48 ; TOTAL CHARGE
- SET IBTCH2=$$GET1^DIQ(350,IBIEN_",",".07","E")
- +49 ; AR BILL NUMBER
- SET IBBIL2=$$GET1^DIQ(350,IBIEN_",",".11","E")
- +50 ; AR TRANSACTION NUMBER
- SET IBTRN2=$$GET1^DIQ(350,IBIEN_",",".12","E")
- +51 ; Mark any null field as UNKNOWN
- +52 IF IBATYP2=""
- SET IBATYP2="UNKNOWN"
- +53 IF IBTCH2=""
- SET IBTCH2="UNKNOWN"
- +54 IF IBBIL2=""
- SET IBBIL2="UNKNOWN"
- +55 IF IBTRN2=""
- SET IBTRN2="UNKNOWN"
- +56 ; If Reason not passed in, set it to UNKNOWN
- +57 IF $GET(IBRSN)=""
- SET IBRSN="UNKNOWN"
- +58 ; Parse together the data for each line of the message
- +59 ; Line #1
- +60 SET IBTEXT=IBPAT
- SET $EXTRACT(IBTEXT,35)=""
- SET IBTEXT=IBTEXT_"RECORD # "_IBCNT
- SET $EXTRACT(IBTEXT,63)=""
- SET IBTEXT=IBTEXT_$JUSTIFY(IBDATE,12)
- +61 SET ^XTMP("IB TRANS",11,IBCNT,1)=IBTEXT
- +62 ; Line #2
- +63 SET ^XTMP("IB TRANS",11,IBCNT,2)=" IB CHARGE PASSED TO AR::"
- +64 ; Line #3
- +65 SET IBTEXT=" "_IBBIL1
- SET $EXTRACT(IBTEXT,18)=""
- SET IBTEXT=IBTEXT_IBTRN1
- SET $EXTRACT(IBTEXT,32)=""
- +66 SET IBTEXT=IBTEXT_IBATYP1
- SET $EXTRACT(IBTEXT,68)=""
- SET IBTEXT=IBTEXT_$SELECT(+IBTCH1:$JUSTIFY(IBTCH1,7,2),1:IBTCH1)
- +67 SET ^XTMP("IB TRANS",11,IBCNT,3)=IBTEXT
- +68 ; Line #4
- +69 SET ^XTMP("IB TRANS",11,IBCNT,4)=" EXISTING CHARGE IN AR:"
- +70 ; Line #5
- +71 SET IBTEXT=" "_IBBIL2
- SET $EXTRACT(IBTEXT,18)=""
- SET IBTEXT=IBTEXT_IBTRN2
- SET $EXTRACT(IBTEXT,32)=""
- +72 SET IBTEXT=IBTEXT_IBATYP2
- SET $EXTRACT(IBTEXT,68)=""
- SET IBTEXT=IBTEXT_$SELECT(+IBTCH2:$JUSTIFY(IBTCH2,7,2),1:IBTCH2)
- +73 SET ^XTMP("IB TRANS",11,IBCNT,5)=IBTEXT
- +74 ; Line #6
- +75 SET IBTEXT=" REASON - "_IBRSN
- +76 SET ^XTMP("IB TRANS",11,IBCNT,6)=IBTEXT
- +77 ; Line #7 blank line for separation
- +78 SET ^XTMP("IB TRANS",11,IBCNT,7)=""
- +79 ; Call STORE3 to log symbol table into ^XTMP("IB TRANS")
- +80 ;D STORE3(IBPAT,IBDATE,IBCNT)
- +81 QUIT
- +82 ;
- STORE2(IBN,IBIEN,IBRSN) ;
- +1 ; Input: IBN = IEN of charge in the INTEGRATED BILLING ACTION (#350) file
- +2 ; that will be sent over to AR
- +3 ; IBIEN = IEN of the existing charge in AR which will be Cancelled
- +4 ; IBRSN = Text describing why the charge in AR was Cancelled
- +5 ; Output: 7 lines of data will be added to ^XTMP("IB TRANS")
- +6 ; The data will have the following format:
- +7 ; PATIENT EVENT DATE
- +8 ; CANCELLED CHARGE IN AR:
- +9 ; BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE
- +10 ; IB CHARGE PASSED TO AR:
- +11 ; BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE
- +12 ; REASON - REASON WHY CHARGE WAS CANCELLED
- +13 ; <blank line>
- +14 ;
- +15 ; At the end of the nightly scheduled IB MT NIGHT COMP process a check will
- +16 ; be made for the existence of ^XTMP("IB TRANS"). If ^XTMP("IB TRANS") exists,
- +17 ; a MailMan message, which can't be forwarded, will be sent to the
- +18 ; IB DUPLICATE TRANSACTIONS mail group with the info stored in this temp file.
- +19 ;
- +20 ; Quit if either IBN or IBIEN not defined
- +21 if IBN=""!(IBIEN="")
- QUIT
- +22 ; If IBRSN not passed in set it to null
- +23 SET IBRSN=$SELECT(IBRSN'="":IBRSN,1:"")
- +24 NEW IBCNT,IBPAT,IBATYP1,IBTCH1,IBBIL1,IBTRN1,IBATYP2,IBTCH2,IBBIL2,IBTRN2,IBTEXT,IBDATE
- +25 ; Determine the index number to use for storing this record & create 0 node
- +26 SET IBCNT=$$COUNTER()
- +27 ; If the 1 node of ^XTMP("IB TRANS") does not exist, create it and HEADER1
- +28 IF '$DATA(^XTMP("IB TRANS",1))
- DO INTRO(IBCNT)
- DO HEADER2(IBCNT)
- +29 ; If the HEADER1 does not exist, create it
- +30 IF '$DATA(^XTMP("IB TRANS",5000))
- DO HEADER2(IBCNT)
- +31 ; Get data in External format for charge being passed to AR
- +32 ; PATIENT
- SET IBPAT=$$GET1^DIQ(350,IBIEN_",",".02","E")
- +33 ; ACTION TYPE
- SET IBATYP1=$$GET1^DIQ(350,IBIEN_",",".03","E")
- +34 ; TOTAL CHARGE
- SET IBTCH1=$$GET1^DIQ(350,IBIEN_",",".07","E")
- +35 ; AR BILL NUMBER
- SET IBBIL1=$$GET1^DIQ(350,IBIEN_",",".11","E")
- +36 ; AR TRANSACTION NUMBER
- SET IBTRN1=$$GET1^DIQ(350,IBIEN_",",".12","E")
- +37 ; EVENT DATE
- SET IBDATE=$$GET1^DIQ(350,IBIEN_",",".17","E")
- +38 ; DATE BILLED FROM
- IF IBDATE=""
- SET IBDATE=$$GET1^DIQ(350,IBN_",",".14","E")
- +39 ; Mark any null field as UNKNOWN
- +40 IF IBPAT=""
- SET IBPAT="UNKNOWN"
- +41 IF IBATYP1=""
- SET IBATYP1="UNKNOWN"
- +42 IF IBTCH1=""
- SET IBTCH1="UNKNOWN"
- +43 IF IBBIL1=""
- SET IBBIL1="UNKNOWN"
- +44 IF IBTRN1=""
- SET IBTRN1="UNKNOWN"
- +45 IF IBDATE=""
- SET IBDATE="UNKNOWN"
- +46 ; Get data in External format for existing charge in AR being cancelled
- +47 ; ACTION TYPE
- SET IBATYP2=$$GET1^DIQ(350,IBN_",",".03","E")
- +48 ; TOTAL CHARGE
- SET IBTCH2=$$GET1^DIQ(350,IBN_",",".07","E")
- +49 ; AR BILL NUMBER
- SET IBBIL2=$$GET1^DIQ(350,IBN_",",".11","E")
- +50 ; AR TRANSACTION NUMBER
- SET IBTRN2=$$GET1^DIQ(350,IBN_",",".12","E")
- +51 ; Mark any null field as UNKNOWN
- +52 IF IBATYP2=""
- SET IBATYP2="UNKNOWN"
- +53 IF IBTCH2=""
- SET IBTCH2="UNKNOWN"
- +54 IF IBBIL2=""
- SET IBBIL2="UNKNOWN"
- +55 IF IBTRN2=""
- SET IBTRN2="UNKNOWN"
- +56 ; If Reason not passed in, set it to UNKNOWN
- +57 IF $GET(IBRSN)=""
- SET IBRSN="UNKNOWN"
- +58 ; Parse together the data for each line of the message
- +59 ; Line #1
- +60 SET IBTEXT=IBPAT
- SET $EXTRACT(IBTEXT,35)=""
- SET IBTEXT=IBTEXT_"RECORD # "_IBCNT
- SET $EXTRACT(IBTEXT,63)=""
- SET IBTEXT=IBTEXT_$JUSTIFY(IBDATE,12)
- +61 SET ^XTMP("IB TRANS",5001,IBCNT,1)=IBTEXT
- +62 ; Line #2
- +63 SET ^XTMP("IB TRANS",5001,IBCNT,2)=" EXISTING CHARGE IN AR:"
- +64 ; Line #3
- +65 SET IBTEXT=" "_IBBIL1
- SET $EXTRACT(IBTEXT,18)=""
- SET IBTEXT=IBTEXT_IBTRN1
- SET $EXTRACT(IBTEXT,32)=""
- +66 SET IBTEXT=IBTEXT_IBATYP1
- SET $EXTRACT(IBTEXT,68)=""
- SET IBTEXT=IBTEXT_$JUSTIFY(IBTCH1,7,2)
- +67 SET ^XTMP("IB TRANS",5001,IBCNT,3)=IBTEXT
- +68 ; Line #4
- +69 SET ^XTMP("IB TRANS",5001,IBCNT,4)=" IB CHARGE PASSED TO AR:"
- +70 ; Line #5
- +71 SET IBTEXT=" "_IBBIL2
- SET $EXTRACT(IBTEXT,18)=""
- SET IBTEXT=IBTEXT_IBTRN2
- SET $EXTRACT(IBTEXT,32)=""
- +72 SET IBTEXT=IBTEXT_IBATYP2
- SET $EXTRACT(IBTEXT,68)=""
- SET IBTEXT=IBTEXT_$JUSTIFY(IBTCH2,7,2)
- +73 SET ^XTMP("IB TRANS",5001,IBCNT,5)=IBTEXT
- +74 ; Line #6
- +75 SET IBTEXT=" REASON - "_IBRSN
- +76 SET ^XTMP("IB TRANS",5001,IBCNT,6)=IBTEXT
- +77 ; Line #7 blank line for separation
- +78 SET ^XTMP("IB TRANS",5001,IBCNT,7)=""
- +79 ; Call STORE3 to log symbol table into ^XTMP("IB TRANS")
- +80 ;D STORE3(IBPAT,IBDATE,IBCNT)
- +81 QUIT
- +82 ;
- STORE3(IBPAT,IBDATE,IBCNT) ;
- +1 ; Called from STORE1 or STORE2 so header and transaction data should already
- +2 ; be stored.
- +3 ; Input: IBPAT = Patient's name in external format
- +4 ; IBDAT = Event Date in external format
- +5 ; IBCNT = The IEN to store the data under
- +6 ; Output: The contents of the stack and symbol table when the action was taken
- +7 ; on the transaction(s).
- +8 ;
- +9 ; Validate input variables
- +10 SET IBPAT=$SELECT($GET(IBPAT)'="":IBPAT,1:"Patient Name Missing")
- +11 IF $GET(IBDATE)=""
- Begin DoDot:1
- +12 NEW Y,%,IBBBA,IBCNT1,IBCNT2,IBY,IBX
- +13 DO NOW^%DTC
- SET Y=%
- +14 DO DD^%DT
- SET IBDATE=Y
- End DoDot:1
- +15 SET IBCNT=$SELECT(IBCNT>0:IBCNT,1:$$COUNTER())
- +16 IF '$DATA(^XTMP("IB TRANS",10000))
- DO HEADER3(IBCNT)
- +17 ; Set the 100 node = DFN ^ DATE
- +18 SET ^XTMP("IB TRANS",10001,IBCNT,100)=IBCNT_U_$GET(DUZ)_U_$GET(DT)
- +19 ; Get last entry in the Stack
- +20 SET IBBBA=$STACK(-1)
- +21 ; Loop to store stack info into ^XTMP("IB TRANS",10001,#,998
- +22 FOR IBCNT1=0:1:IBBBA
- SET ^XTMP("IB TRANS",10001,IBCNT,998,IBCNT1)=$STACK(IBCNT1)
- FOR IBCNT2="ECODE","MCODE","PLACE"
- SET ^XTMP("IB TRANS",10001,IBCNT,998,IBCNT1,IBCNT2)=$STACK(IBCNT1,IBCNT2)
- +23 ; Set up 999 node for local symbol table variables
- +24 SET IBX="^XTMP(""IB TRANS"",10001,"_IBCNT_","_(999)_","
- +25 ; Loop to store local symbol table variables into ^XTMP("IB TRANS",10001,#,999
- +26 SET IBY="%"
- FOR
- if $DATA(@IBY)
- MERGE @(IBX_"IBY)="_IBY)
- SET IBY=$ORDER(@IBY)
- if IBY=""
- QUIT
- +27 ; Add line of === for separation
- +28 SET ^XTMP("IB TRANS",10001,IBCNT,9999)="================================================================================"
- +29 QUIT
- +30 ;
- INTRO(IBCNT) ;
- +1 ; Input: IBCNT = IEN to store this header record
- +2 ; Output: This API will set the 0 node in ^XTMP("IB TRANS") and will then store
- +3 ; the introductory paragraph into ^XTMP("IB TRANS").
- +4 ;
- +5 SET ^XTMP("IB TRANS",1,IBCNT,1)="The following Duplicate Copay related charges in Integrated Billing were"
- +6 SET ^XTMP("IB TRANS",1,IBCNT,2)="processed today. These charges should be reviewed to verify that they"
- +7 SET ^XTMP("IB TRANS",1,IBCNT,3)="were properly handled and that no additional charges or corrections need"
- +8 SET ^XTMP("IB TRANS",1,IBCNT,4)="to be made."
- +9 SET ^XTMP("IB TRANS",1,IBCNT,5)=""
- +10 QUIT
- +11 ;
- +1 ; Input: IBCNT = IEN to store this header record
- +2 ; Output: This API will set the header info for charges in IB that were NOT
- +3 ; passed over to AR.
- +4 ;
- +5 if +IBCNT=0
- QUIT
- +6 SET ^XTMP("IB TRANS",10,IBCNT,1)="The following charges in IB were passed over to AR even though there were"
- +7 SET ^XTMP("IB TRANS",10,IBCNT,2)="existing charges in AR for the same patient and date at the same or higher"
- +8 SET ^XTMP("IB TRANS",10,IBCNT,3)="charge rate or precedence. These charges may need to be canceled with a"
- +9 SET ^XTMP("IB TRANS",10,IBCNT,4)="Cancellation Reason of: ENTERED IN ERROR."
- +10 SET ^XTMP("IB TRANS",10,IBCNT,5)=""
- +11 SET ^XTMP("IB TRANS",10,IBCNT,6)="PATIENT RECORD # EVENT DATE"
- +12 SET ^XTMP("IB TRANS",10,IBCNT,7)=" IB CHARGE PASSED TO AR:"
- +13 SET ^XTMP("IB TRANS",10,IBCNT,8)=" BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE"
- +14 SET ^XTMP("IB TRANS",10,IBCNT,9)=" EXISTING CHARGE IN AR:"
- +15 SET ^XTMP("IB TRANS",10,IBCNT,10)=" BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE"
- +16 SET ^XTMP("IB TRANS",10,IBCNT,11)=" REASON"
- +17 SET ^XTMP("IB TRANS",10,IBCNT,12)="=========================================================================="
- +18 QUIT
- +19 ;
- +1 ; Input: IBCNT = IEN to store this header record
- +2 ; Output: This API will set the header info for charges in IB that were
- +3 ; passed over to AR.
- +4 ;
- +5 SET ^XTMP("IB TRANS",5000,IBCNT,1)="The following charges in IB were passed over to AR even though there were"
- +6 SET ^XTMP("IB TRANS",5000,IBCNT,2)="existing charges in AR for the same patient and date at the same or lower"
- +7 SET ^XTMP("IB TRANS",5000,IBCNT,3)="charge rate or precedence. These existing charges in AR may need to be"
- +8 SET ^XTMP("IB TRANS",5000,IBCNT,4)="cancelled with a Cancellation Reason of: BILLED AT HIGHER TIER RATE."
- +9 SET ^XTMP("IB TRANS",5000,IBCNT,5)=""
- +10 SET ^XTMP("IB TRANS",5000,IBCNT,6)="PATIENT RECORD # EVENT DATE"
- +11 SET ^XTMP("IB TRANS",5000,IBCNT,7)=" EXISTING CHARGE IN AR:"
- +12 SET ^XTMP("IB TRANS",5000,IBCNT,8)=" BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE"
- +13 SET ^XTMP("IB TRANS",5000,IBCNT,9)=" IB CHARGE PASSED TO AR:"
- +14 SET ^XTMP("IB TRANS",5000,IBCNT,10)=" BILL NO. TRANSACTION CHARGE TYPE TOTAL CHARGE"
- +15 SET ^XTMP("IB TRANS",5000,IBCNT,11)=" REASON"
- +16 SET ^XTMP("IB TRANS",5000,IBCNT,12)="=========================================================================="
- +17 QUIT
- +18 ;
- +1 ; Input: IBCNT = IEN to store this header record
- +2 ; Output: This API will set the header info for charges in IB that were
- +3 ; passed over to AR.
- +4 ;
- +5 SET ^XTMP("IB TRANS",10000,IBCNT,1)="The following data contains the stack and symbol table that was"
- +6 SET ^XTMP("IB TRANS",10000,IBCNT,2)="present when the record being processed was identified as a"
- +7 SET ^XTMP("IB TRANS",10000,IBCNT,3)="duplicate copay and as needing to have some action taken."
- +8 SET ^XTMP("IB TRANS",10000,IBCNT,4)="=========================================================================="
- +9 QUIT
- +10 ;
- XMIT ; Transmit Duplicate Transaction Info
- +1 ;
- +2 NEW IBCNT,IBCT,IBDATA,IBREF
- +3 ; Check for data to be sent
- +4 if '$DATA(^XTMP("IB TRANS"))
- QUIT
- +5 ; Move data currently in ^XTMP("IB TRANS" into MailMan compatible format
- +6 SET IBREF="^XTMP(""IB TRANS"")"
- SET IBCNT=1
- +7 ; Run the initial $Q to load the 0 node info which will NOT be included in the MailMan message
- +8 SET IBREF=$QUERY(@IBREF)
- +9 FOR IBCT=0:0
- SET IBREF=$QUERY(@IBREF)
- if IBREF=""!(IBREF["IB TRANS1")
- QUIT
- Begin DoDot:1
- +10 IF (IBREF'["10001")
- SET ^XTMP("IB TRANS1",IBCNT)=@IBREF
- +11 IF (IBREF["10001")
- Begin DoDot:2
- +12 IF $PIECE(IBREF,",",4)["100"
- SET ^XTMP("IB TRANS1",IBCNT)=@IBREF
- +13 IF $PIECE(IBREF,",",4)["998"
- Begin DoDot:3
- +14 SET IBDATA=$PIECE(IBREF,",",6)
- SET IBDATA=$PIECE(IBDATA,")",1)
- +15 SET IBDATA=IBDATA_"="_@IBREF
- +16 SET ^XTMP("IB TRANS1",IBCNT)=IBDATA
- End DoDot:3
- +17 IF $PIECE(IBREF,",",4)["999"
- Begin DoDot:3
- +18 SET IBDATA=$PIECE(IBREF,",",5)
- SET IBDATA=$PIECE(IBDATA,")",1)
- +19 SET IBDATA=IBDATA_"="_@IBREF
- +20 SET ^XTMP("IB TRANS1",IBCNT)=IBDATA
- End DoDot:3
- End DoDot:2
- +21 SET IBCNT=IBCNT+1
- End DoDot:1
- +22 NEW IBDATE,IBSTAT,XMTO,XMSUBJ,XMBODY,XMINSTR,XMDUZ,Y
- +23 ; Get Station Number
- +24 SET IBSTAT=$$STANUM^IBAUTL9()
- +25 ; Get Today's date in external format
- +26 SET Y=DT
- +27 DO DD^%DT
- +28 SET IBDATE=Y
- +29 ; Set up MailMan with No Forward
- +30 SET XMSUBJ="Duplicate Processing for Station "_IBSTAT_" - "_IBDATE
- +31 SET XMDUZ=DUZ
- +32 SET XMTO("G.IB DUPLICATE TRANSACTIONS")=""
- +33 SET XMBODY="^XTMP(""IB TRANS1"")"
- +34 SET XMINSTR("FLAGS")="X"
- +35 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR)
- +36 DO HOME^%ZIS
- +37 KILL ^XTMP("IB TRANS"),^XTMP("IB TRANS1")
- +38 QUIT
- +39 ;
- STANUM() ; Get Station Number
- +1 ;
- +2 SET IBSTAT=$$KSP^XUPARAM("INST")_","
- +3 SET IBSTAT=$$GET1^DIQ(4,IBSTAT,99)
- +4 QUIT IBSTAT
- +5 ;
- COUNTER() ; Determine index to use for storing a record in ^XTMP(""IB TRANS"")
- +1 ; Get current IEN and increment by 1
- +2 NEW IBCNT
- +3 SET IBCNT=$PIECE($GET(^XTMP("IB TRANS",0)),U,4)+1
- +4 ; If initial call, set all of 0 node
- +5 IF IBCNT=1
- Begin DoDot:1
- +6 NEW X,X1,X2
- +7 ; Determine date 5 days in future in FileMan format
- +8 SET X1=DT
- SET X2=5
- +9 DO C^%DTC
- +10 SET ^XTMP("IB TRANS",0)=X_U_DT_U_"Duplicate Transaction Info"_U_IBCNT
- End DoDot:1
- +11 ; if subsequent call, only update IEN count
- +12 IF IBCNT>1
- SET $PIECE(^XTMP("IB TRANS",0),U,4)=IBCNT
- +13 ; Return current count to calling procedure
- +14 QUIT IBCNT