BARPT174 ; IHS/SD/LSL - Post init for V1.7 Patch 4 ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
Q
; *********************************************************************
;
EN ; EP - Driver
D PRVPATCH ; Check to see if previous patches installed
; I BARP4 D ^BARADJR2 Q ; Use this for test 2 to update standard codes
I 'BARP4 D PATCH4 ; Post init for V1.7 Patch 4
D CHNGREA^BARADJR2 ; Change cat of reas to non-pay per TAG
D MODIFY^BARADJR2 ; Change mapping per TAG
D MAILPAT ; Send Patch install MailMan message
Q
; *********************************************************************
;
PRVPATCH ;
; Check previous patch post inits
N BARP1,BARP2,BARP3
S BARP4=$$INSTALLD^BAREV17("BAR*1.7*4")
S BARP3=$$INSTALLD^BAREV17("BAR*1.7*3")
S BARP2=$$INSTALLD^BAREV17("BAR*1.7*2")
S BARP1=$$INSTALLD^BAREV17("BAR*1.7*1")
I BARP4 Q
I BARP3 Q ; All previous patches installed
I BARP2 D PATCH3 Q ; Only missing patch 3
I BARP1 D PATCH2 Q ; Missing patches 2 and 3 (cause 3 corrects 2)
D PATCH1,PATCH2 ; Missing patches 1, 2, and 3
Q
; ********************************************************************
PATCH1 ;
; Patch 1 post init
; Delete A/R Period Summary Data File data
W !!,"You are missing A/R V1.7 Patch 1...performing POST INITS of that patch"
S DIK="^BARPSR("
S DA=0
F S DA=$O(^BARPSR(DA)) Q:'+DA D ^DIK
K DA,DIK
;
; Delete the A/R Period Summary Data File Data Dictionary
S DIU="^BARPSR("
S DIU(0)="DT"
D EN^DIU2
K DIU
W !!,"A/R V1.7 Patch 1 POST INIT complete"
Q
; *********************************************************************
;
PATCH2 ;
; Patch 2 post init
W !!,"You are missing A/R V1.7 Patch 2...performing POST INITS of that patch"
S BARDUZ=DUZ(2)
D CURBAL
D PATACC
D EISS
S DUZ(2)=BARDUZ
W !!,"A/R V1.7 Patch 2 POST INIT complete"
Q
; ********************************************************************
;
CURBAL ;
; Rebuild ABAL and APBAL x-refs on field 15 of file 90050.01
W !!,"Rebuilding ABAL and APBAL x-refs on Current Balance of A/R Bill File..."
S DUZ(2)=0
F S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'+DUZ(2) D
. F BARX="ABAL","APBAL" D
. . K ^BARBL(DUZ(2),BARX)
. . S DIK="^BARBL(DUZ(2),"
. . S DIK(1)="15^"_BARX
. . D ENALL^DIK
W "DONE."
Q
; ********************************************************************
;
PATACC ;
; Create PAS x-ref on field 101 of file 90050.02
W !!,"Creating PAS x-ref on Pat Acct Stmt of A/R Account File..."
S DUZ(2)=0
F S DUZ(2)=$O(^BARAC(DUZ(2))) Q:'+DUZ(2) D
. K ^BARAC(DUZ(2),"PAS")
. S DIK="^BARAC(DUZ(2),"
. S DIK(1)="101^PAS"
. D ENALL^DIK
W "DONE."
Q
; ********************************************************************
;
EISS ;
; Populate EISS fields in file 90052.06
W !!,"Populating EISS System Address, Username, and Password fields"
W !,"in A/R Site Parameter File..."
S DUZ(2)=0
F S DUZ(2)=$O(^BAR(90052.06,DUZ(2))) Q:'+DUZ(2) D
. S DIE="^BAR(90052.06,DUZ(2),"
. S DA=0
. F S DA=$O(^BAR(90052.06,DUZ(2),DA)) Q:'+DA D
. . K DR
. . S DR="201///127.0.0.1"
. . S DR=DR_";202///bardata"
. . S DR=DR_";203///1bardat/"
. . D ^DIE
K DA,DIE,DR
W "DONE."
Q
; ********************************************************************
;
PATCH3 ;
; Post init for V1.7 Patch 3
W !!,"Now performing A/R V1.7 Patch 3 post inits..."
D FINDUP
D MAILDUP
Q
; ********************************************************************
;
FINDUP ;
; Find possible AR Bill Multiples (duplicates)
K ^BARTMP("DUP")
S BARDUZ=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'+DUZ(2) D
. S BARBL=""
. F S BARBL=$O(^BARBL(DUZ(2),"B",BARBL)) Q:BARBL="" D
. . S (BARIEN,BARCNT)=0
. . F S BARIEN=$O(^BARBL(DUZ(2),"B",BARBL,BARIEN)) Q:'+BARIEN D
. . . S BARCNT=BARCNT+1
. . I BARCNT>1 S ^BARTMP("DUP",DUZ(2),BARBL)=BARCNT
S DUZ(2)=BARDUZ
Q
; ********************************************************************
;
PATCH4 ;
; Post init for V1.7 Patch 4
W !!,"Creating A/R EDI Transport for HIPAA 835 v4010..."
D START^BAREDIT ; Create HIPAA transaction for ERA posting
W "...DONE"
W !,"Updating RPMS Adjustment Reason Descriptions..."
D ENTRY^BARADJRA ; Update Standard Adj Reason Description
W "...DONE"
D POINTER ; Correct mapping of Standard code 130
D ^BARADJR2 ; Add updated codes
D ADDCODE ; Add AH to A/R EDI tables for Addenda A
S BARHOLD=DUZ(2)
D CURBAL ; Rebuild ABAL (from P2) again to be safe
S DUZ(2)=BARHOLD
Q
; ********************************************************************
;
POINTER ;
; Correct mapping of standard code 137 from RPMS reason 141 to 730
S X=137
S DIC="^BARADJ("
S DIC(0)="XZ"
D ^DIC
Q:+Y<1
K DIC,X,DA
S DA=+Y
S DIE="^BARADJ("
S DR=".04////730"
D ^DIE
Q
; ********************************************************************
;
ADDCODE ;
; Add AH entry under Adjustment Reason Code. AH added in Addenda A
; to V4010 of the X12 835.
W !,"Updating EDI Tables for HIPAA 835 v4010 Addenda A..."
S DLAYGO=90056
S DA(1)=32
S DIC="^BARETBL("_DA(1)_",1,"
S DIC(0)="LZ"
S X="AH"
S DIC("DR")=".02///Origination Fee"
K DD,DO
D FILE^DICN
W "...DONE"
Q
; ********************************************************************
;
MAILPAT ;
; Send a mail message to all holders of the BARZMENU key that a patch
; has been installed on the system.
;
W !!,"Sending MailMan message to users..."
D MAILSET
D MAILTXT
D MAILMSG
W " DONE"
Q
; *********************************************************************
;
MAILSET ;
; Set Mailman Variables
K XMY
S XMSUB="Accounts Receivable V1.7 Patch 3"
S XMDUZ="Accounts Receivable Software Engineer"
D MAILIST ; Get list of recipients
Q
; *********************************************************************
;
MAILIST ;
; Find users who hold the BARZMENU key
;S XMY("STAR,GLEN R")=""
S J=0
F S J=$O(^XUSEC("BARZMENU",J)) Q:'J D
. S BARNAME=$P($G(^VA(200,J,0)),U)
. S XMY(BARNAME)=""
Q
; *********************************************************************
;
MAILTXT ;
; Determine body of e-mail
S K=0
F D Q:BARTXT="END"
. S K=K+1
. S BARTXT=$P($T(@1+K),";;",2)
. I BARTXT="END" Q
. S BARMSG(K)=BARTXT
Q
; *********************************************************************
;
MAILMSG ;
S XMTEXT="BARMSG("
S %H=$H
D YX^%DTC
N DIFROM
D ^XMD
Q
; *********************************************************************
;
MAILDUP ;
; Send a mail message to all holders of the BARZMGR key listing
; possible duplicates on their system
;
W !!,"Sending MailMan message to AR Managers..."
D MAILSETM
D MAILTXTM
D MAILMSGM
W " DONE"
Q
; *********************************************************************
;
MAILSETM ;
; Set Mailman Variables
K XMY
S XMSUB="Possible AR Bill Duplicates"
S XMDUZ="Accounts Receivable Software Engineer"
D MAILISTM ; Get list of recipients
Q
; *********************************************************************
;
MAILISTM ;
; Find users who hold the BARZ MANAGER key
;S XMY("STAR,GLEN R")=""
S J=0
F S J=$O(^XUSEC("BARZ MANAGER",J)) Q:'+J D
. S BARNAME=$P($G(^VA(200,J,0)),U)
. S XMY(BARNAME)=""
Q
; *********************************************************************
;
MAILTXTM ;
; Determine body of e-mail
K ^BARTMP("173MSG")
S K=0
F D Q:BARTXT="END"
. S K=K+1
. S BARTXT=$P($T(@2+K),";;",2)
. I BARTXT="END" Q
. S ^BARTMP("173MSG",K)=BARTXT
;
; Now get the duplicated bills
;
I '$D(^BARTMP("DUP")) D Q
. S ^BARTMP("173MSG",K+1)="***** NO DUPLICATE BILLS FOUND ****"
;
S $P(BARDASH,"-",51)=""
S $P(BAREQUAL,"=",51)=""
S BARCNT=0
S BARTOT=0
S BARPAR=0
F S BARPAR=$O(^BARTMP("DUP",BARPAR)) Q:'+BARPAR D
. S (BARFCNT,BARFBT)=0
. S K=K+1
. S ^BARTMP("173MSG",K)="Parent Facility: "_$$GET1^DIQ(4,BARPAR,.01)
. S K=K+1
. S ^BARTMP("173MSG",K)=" "
. S BARBL=""
. F S BARBL=$O(^BARTMP("DUP",BARPAR,BARBL)) Q:BARBL="" D
. . S BARFCNT=BARFCNT+1
. . S BARCNT=BARCNT+1
. . S BARBIL=$E(BARBL,1,20)
. . F I=$L(BARBIL):1:25 S BARBIL=BARBIL_" "
. . S BARIEN=0
. . F S BARIEN=$O(^BARBL(BARPAR,"B",BARBL,BARIEN)) Q:'+BARIEN D
. . . S BARIENO="'"_BARIEN
. . . F I=$L(BARIENO):1:10 S BARIENO=BARIENO_" "
. . . S BARPIEN=$P($G(^BARBL(BARPAR,BARIEN,1)),U)
. . . S:BARPIEN]"" BARPAT=$E($$GET1^DIQ(9000001,BARPIEN,.01),1,20)
. . . S:BARPIEN="" BARPAT=""
. . . F I=$L(BARPAT):1:25 S BARPAT=BARPAT_" "
. . . S BARBAMT=$P($G(^BARBL(BARPAR,BARIEN,0)),U,13)
. . . S BARBAMTO=$J($FN(BARBAMT,",",2),15)
. . . S K=K+1
. . . S ^BARTMP("173MSG",K)=BARIENO_BARBIL_BARPAT_BARBAMTO
. . S BARFBT=BARBAMT+BARFBT ; Facility bill total
. . S BARTOT=BARBAMT+BARTOT
. S K=K+1
. S ^BARTMP("173MSG",K)=$J(BARDASH,79)
. S K=K+1
. S ^BARTMP("173MSG",K)=$J("Unique bill count: ",58)_$J(BARFCNT,4)_$J($FN(BARFBT,",",2),16)
. S K=K+1
. S ^BARTMP("173MSG",K)=" "
S ^BARTMP("173MSG",K)=$J(BAREQUAL,79)
S K=K+1
S ^BARTMP("173MSG",K)=$J("Total unique bill count: ",58)_$J(BARCNT,4)_$J($FN(BARTOT,",",2),16)
Q
; *********************************************************************
;
MAILMSGM ;
S XMTEXT="^BARTMP(""173MSG"","
S %H=$H
D YX^%DTC
N DIFROM
D ^XMD
Q
; *********************************************************************
;
1 ;;
;;Accounts Receivable V1.7 Patch 4 has been installed on your
;;computer. You have received this message because you hold the BARZMENU
;;key that allows access to the Accounts Receivable Master Menu.
;;
;;Accounts Receivable V1.7 Patch 4 is inclusive of patches 1 thru 3. It
;;also contains the following:
;;
;; 1. Changes to LOAD NEW IMPORT ERA Posting Menu option to include the
;; following:
;;
;; a. New HIPAA 835 V4010 transaction format for electronic remittance
;; advice (ERA) processing.
;; b. The system verifies the file being uploaded is a HIPAA 835 V4010 file.
;; c. If the bill found on the ERA file is cancelled in RPMS 3P, the bill
;; will not be matched and cannot be posted electronically.
;;
;; 2. To accomodate for files that contain more than one Check/EFT Trace
;; Number, the ERA Review, Post, and Report functions have been modified
;; to perform these functions by Check/EFT Trace number rather than the
;; entire file.
;;
;; 3. Changes to REVIEW POSTABLE CLAIMS ERA Posting Menu option to include
;; the following:
;;
;; a. The system performs a matching of EFT Check/Trace number from the
;; ERA to the Check # of the RPMS Collection Batch/Item.
;; b. Once the bills for a Check/EFT Trace number have been reviewed, the
;; check is removed from the selection list.
;;
;; 4. Changes to POST ERA CLAIMS ERA Posting Menu option to include the
;; following:
;;
;; a. Only Checks/EFT Trace #'s that have been reviewed appear for selection
;; for posting. Therefore, you must review before you post.
;; b. If posting the ERA bill will result in a negative balance on RPMS,
;; the user is notified and asked if the bill should be posted. If the user
;; chooses not to post the bill, the system does not post the bill and the
;; user is asked to continue the posting process.
;; c. If the site parameter is defined for Rollback, immediately after posting
;; of the Check/EFT Trace is complete, the user is asked if rollback
;; should occur at this time. If yes, bills are rolled back to 3P then.
;; If no, the bills are flagged and the user must use ROL to rollback.
;;
;; 5. Changes to REPORT ERA CLAIMS ERA Posting Menu option to include the
;; following:
;;
;; a. This report has been totally rewritten for the HIPAA 835 file format.
;;
;; 6. Transactions created via POST ERA CLAIMS will get flagged with an
;; "e". The "e" is displayed when viewing the bill's history.
;;
;; 7. When selecting "R" for rollback during the manual posting process,
;; (PST,ADJ or PST,PAY), the bill will rollback even if it has been previously
;; rolled back.
;;
;; 8. Updated Standard Claim Adjustment Reason Codes to accomodate reworded,
;; more clear explanations as defined in the AR Standard Claim Adjustment
;; Reason Codes file. Also, updates RPMS files with Standard Codes added
;; between June 2002 and September 2003.
;;
;; 9. Four Support Center calls that have been resolved:
;;
;; a. Resolved an undefined error when running the IG report
;; b. Resolved an undefined error when running Rolling back more than 50
;; bills to 3P during the posting process. This error does not occur if
;; rolling back to 3P from the A/R ROL option.
;; c. Resolved execute error when running A/R FM Sort and Print
;; d. Rebuild the ABAL x-ref on the Current Balance Field of the
;; A/R Bill/IHS file resolving issues of totals on aging reports.
;; e. The Age Summary Report has been modified to group data by Visit
;; Location and the EISS process has been updated to accomodate the
;; format.
;; f. The Patient Account Statement has been modified to accomodate
;; multi-facility sites.
;; g. A time stamp has been added to the date stamp on the Batch
;; Statistical Report.
;;END
;
2 ;;
;;As a part of the installation of Accounts Receivable V1.7 Patch 3, the system
;;looked for possible duplicates on your system. You have received this
;;message because you hold the BARZ MANAGER key that allows access to the
;;Accounts Receivable Manager options. The following is a list of possible
;;duplicates that were found. Please review these bills and write off the
;;first occurrence of the bill if you find it is truly a duplicate.
;;
;; IEN Bill Patient Billed Amount
;;
;;END
BARPT174 ; IHS/SD/LSL - Post init for V1.7 Patch 4 ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 QUIT
+4 ; *********************************************************************
+5 ;
EN ; EP - Driver
+1 ; Check to see if previous patches installed
DO PRVPATCH
+2 ; I BARP4 D ^BARADJR2 Q ; Use this for test 2 to update standard codes
+3 ; Post init for V1.7 Patch 4
IF 'BARP4
DO PATCH4
+4 ; Change cat of reas to non-pay per TAG
DO CHNGREA^BARADJR2
+5 ; Change mapping per TAG
DO MODIFY^BARADJR2
+6 ; Send Patch install MailMan message
DO MAILPAT
+7 QUIT
+8 ; *********************************************************************
+9 ;
PRVPATCH ;
+1 ; Check previous patch post inits
+2 NEW BARP1,BARP2,BARP3
+3 SET BARP4=$$INSTALLD^BAREV17("BAR*1.7*4")
+4 SET BARP3=$$INSTALLD^BAREV17("BAR*1.7*3")
+5 SET BARP2=$$INSTALLD^BAREV17("BAR*1.7*2")
+6 SET BARP1=$$INSTALLD^BAREV17("BAR*1.7*1")
+7 IF BARP4
QUIT
+8 ; All previous patches installed
IF BARP3
QUIT
+9 ; Only missing patch 3
IF BARP2
DO PATCH3
QUIT
+10 ; Missing patches 2 and 3 (cause 3 corrects 2)
IF BARP1
DO PATCH2
QUIT
+11 ; Missing patches 1, 2, and 3
DO PATCH1
DO PATCH2
+12 QUIT
+13 ; ********************************************************************
PATCH1 ;
+1 ; Patch 1 post init
+2 ; Delete A/R Period Summary Data File data
+3 WRITE !!,"You are missing A/R V1.7 Patch 1...performing POST INITS of that patch"
+4 SET DIK="^BARPSR("
+5 SET DA=0
+6 FOR
SET DA=$ORDER(^BARPSR(DA))
IF '+DA
QUIT
DO ^DIK
+7 KILL DA,DIK
+8 ;
+9 ; Delete the A/R Period Summary Data File Data Dictionary
+10 SET DIU="^BARPSR("
+11 SET DIU(0)="DT"
+12 DO EN^DIU2
+13 KILL DIU
+14 WRITE !!,"A/R V1.7 Patch 1 POST INIT complete"
+15 QUIT
+16 ; *********************************************************************
+17 ;
PATCH2 ;
+1 ; Patch 2 post init
+2 WRITE !!,"You are missing A/R V1.7 Patch 2...performing POST INITS of that patch"
+3 SET BARDUZ=DUZ(2)
+4 DO CURBAL
+5 DO PATACC
+6 DO EISS
+7 SET DUZ(2)=BARDUZ
+8 WRITE !!,"A/R V1.7 Patch 2 POST INIT complete"
+9 QUIT
+10 ; ********************************************************************
+11 ;
CURBAL ;
+1 ; Rebuild ABAL and APBAL x-refs on field 15 of file 90050.01
+2 WRITE !!,"Rebuilding ABAL and APBAL x-refs on Current Balance of A/R Bill File..."
+3 SET DUZ(2)=0
+4 FOR
SET DUZ(2)=$ORDER(^BARBL(DUZ(2)))
IF '+DUZ(2)
QUIT
Begin DoDot:1
+5 FOR BARX="ABAL","APBAL"
Begin DoDot:2
+6 KILL ^BARBL(DUZ(2),BARX)
+7 SET DIK="^BARBL(DUZ(2),"
+8 SET DIK(1)="15^"_BARX
+9 DO ENALL^DIK
End DoDot:2
End DoDot:1
+10 WRITE "DONE."
+11 QUIT
+12 ; ********************************************************************
+13 ;
PATACC ;
+1 ; Create PAS x-ref on field 101 of file 90050.02
+2 WRITE !!,"Creating PAS x-ref on Pat Acct Stmt of A/R Account File..."
+3 SET DUZ(2)=0
+4 FOR
SET DUZ(2)=$ORDER(^BARAC(DUZ(2)))
IF '+DUZ(2)
QUIT
Begin DoDot:1
+5 KILL ^BARAC(DUZ(2),"PAS")
+6 SET DIK="^BARAC(DUZ(2),"
+7 SET DIK(1)="101^PAS"
+8 DO ENALL^DIK
End DoDot:1
+9 WRITE "DONE."
+10 QUIT
+11 ; ********************************************************************
+12 ;
EISS ;
+1 ; Populate EISS fields in file 90052.06
+2 WRITE !!,"Populating EISS System Address, Username, and Password fields"
+3 WRITE !,"in A/R Site Parameter File..."
+4 SET DUZ(2)=0
+5 FOR
SET DUZ(2)=$ORDER(^BAR(90052.06,DUZ(2)))
IF '+DUZ(2)
QUIT
Begin DoDot:1
+6 SET DIE="^BAR(90052.06,DUZ(2),"
+7 SET DA=0
+8 FOR
SET DA=$ORDER(^BAR(90052.06,DUZ(2),DA))
IF '+DA
QUIT
Begin DoDot:2
+9 KILL DR
+10 SET DR="201///127.0.0.1"
+11 SET DR=DR_";202///bardata"
+12 SET DR=DR_";203///1bardat/"
+13 DO ^DIE
End DoDot:2
End DoDot:1
+14 KILL DA,DIE,DR
+15 WRITE "DONE."
+16 QUIT
+17 ; ********************************************************************
+18 ;
PATCH3 ;
+1 ; Post init for V1.7 Patch 3
+2 WRITE !!,"Now performing A/R V1.7 Patch 3 post inits..."
+3 DO FINDUP
+4 DO MAILDUP
+5 QUIT
+6 ; ********************************************************************
+7 ;
FINDUP ;
+1 ; Find possible AR Bill Multiples (duplicates)
+2 KILL ^BARTMP("DUP")
+3 SET BARDUZ=DUZ(2)
+4 SET DUZ(2)=0
+5 FOR
SET DUZ(2)=$ORDER(^BARBL(DUZ(2)))
IF '+DUZ(2)
QUIT
Begin DoDot:1
+6 SET BARBL=""
+7 FOR
SET BARBL=$ORDER(^BARBL(DUZ(2),"B",BARBL))
IF BARBL=""
QUIT
Begin DoDot:2
+8 SET (BARIEN,BARCNT)=0
+9 FOR
SET BARIEN=$ORDER(^BARBL(DUZ(2),"B",BARBL,BARIEN))
IF '+BARIEN
QUIT
Begin DoDot:3
+10 SET BARCNT=BARCNT+1
End DoDot:3
+11 IF BARCNT>1
SET ^BARTMP("DUP",DUZ(2),BARBL)=BARCNT
End DoDot:2
End DoDot:1
+12 SET DUZ(2)=BARDUZ
+13 QUIT
+14 ; ********************************************************************
+15 ;
PATCH4 ;
+1 ; Post init for V1.7 Patch 4
+2 WRITE !!,"Creating A/R EDI Transport for HIPAA 835 v4010..."
+3 ; Create HIPAA transaction for ERA posting
DO START^BAREDIT
+4 WRITE "...DONE"
+5 WRITE !,"Updating RPMS Adjustment Reason Descriptions..."
+6 ; Update Standard Adj Reason Description
DO ENTRY^BARADJRA
+7 WRITE "...DONE"
+8 ; Correct mapping of Standard code 130
DO POINTER
+9 ; Add updated codes
DO ^BARADJR2
+10 ; Add AH to A/R EDI tables for Addenda A
DO ADDCODE
+11 SET BARHOLD=DUZ(2)
+12 ; Rebuild ABAL (from P2) again to be safe
DO CURBAL
+13 SET DUZ(2)=BARHOLD
+14 QUIT
+15 ; ********************************************************************
+16 ;
POINTER ;
+1 ; Correct mapping of standard code 137 from RPMS reason 141 to 730
+2 SET X=137
+3 SET DIC="^BARADJ("
+4 SET DIC(0)="XZ"
+5 DO ^DIC
+6 IF +Y<1
QUIT
+7 KILL DIC,X,DA
+8 SET DA=+Y
+9 SET DIE="^BARADJ("
+10 SET DR=".04////730"
+11 DO ^DIE
+12 QUIT
+13 ; ********************************************************************
+14 ;
ADDCODE ;
+1 ; Add AH entry under Adjustment Reason Code. AH added in Addenda A
+2 ; to V4010 of the X12 835.
+3 WRITE !,"Updating EDI Tables for HIPAA 835 v4010 Addenda A..."
+4 SET DLAYGO=90056
+5 SET DA(1)=32
+6 SET DIC="^BARETBL("_DA(1)_",1,"
+7 SET DIC(0)="LZ"
+8 SET X="AH"
+9 SET DIC("DR")=".02///Origination Fee"
+10 KILL DD,DO
+11 DO FILE^DICN
+12 WRITE "...DONE"
+13 QUIT
+14 ; ********************************************************************
+15 ;
MAILPAT ;
+1 ; Send a mail message to all holders of the BARZMENU key that a patch
+2 ; has been installed on the system.
+3 ;
+4 WRITE !!,"Sending MailMan message to users..."
+5 DO MAILSET
+6 DO MAILTXT
+7 DO MAILMSG
+8 WRITE " DONE"
+9 QUIT
+10 ; *********************************************************************
+11 ;
MAILSET ;
+1 ; Set Mailman Variables
+2 KILL XMY
+3 SET XMSUB="Accounts Receivable V1.7 Patch 3"
+4 SET XMDUZ="Accounts Receivable Software Engineer"
+5 ; Get list of recipients
DO MAILIST
+6 QUIT
+7 ; *********************************************************************
+8 ;
MAILIST ;
+1 ; Find users who hold the BARZMENU key
+2 ;S XMY("STAR,GLEN R")=""
+3 SET J=0
+4 FOR
SET J=$ORDER(^XUSEC("BARZMENU",J))
IF 'J
QUIT
Begin DoDot:1
+5 SET BARNAME=$PIECE($GET(^VA(200,J,0)),U)
+6 SET XMY(BARNAME)=""
End DoDot:1
+7 QUIT
+8 ; *********************************************************************
+9 ;
MAILTXT ;
+1 ; Determine body of e-mail
+2 SET K=0
+3 FOR
Begin DoDot:1
+4 SET K=K+1
+5 SET BARTXT=$PIECE($TEXT(@1+K),";;",2)
+6 IF BARTXT="END"
QUIT
+7 SET BARMSG(K)=BARTXT
End DoDot:1
IF BARTXT="END"
QUIT
+8 QUIT
+9 ; *********************************************************************
+10 ;
MAILMSG ;
+1 SET XMTEXT="BARMSG("
+2 SET %H=$HOROLOG
+3 DO YX^%DTC
+4 NEW DIFROM
+5 DO ^XMD
+6 QUIT
+7 ; *********************************************************************
+8 ;
MAILDUP ;
+1 ; Send a mail message to all holders of the BARZMGR key listing
+2 ; possible duplicates on their system
+3 ;
+4 WRITE !!,"Sending MailMan message to AR Managers..."
+5 DO MAILSETM
+6 DO MAILTXTM
+7 DO MAILMSGM
+8 WRITE " DONE"
+9 QUIT
+10 ; *********************************************************************
+11 ;
MAILSETM ;
+1 ; Set Mailman Variables
+2 KILL XMY
+3 SET XMSUB="Possible AR Bill Duplicates"
+4 SET XMDUZ="Accounts Receivable Software Engineer"
+5 ; Get list of recipients
DO MAILISTM
+6 QUIT
+7 ; *********************************************************************
+8 ;
MAILISTM ;
+1 ; Find users who hold the BARZ MANAGER key
+2 ;S XMY("STAR,GLEN R")=""
+3 SET J=0
+4 FOR
SET J=$ORDER(^XUSEC("BARZ MANAGER",J))
IF '+J
QUIT
Begin DoDot:1
+5 SET BARNAME=$PIECE($GET(^VA(200,J,0)),U)
+6 SET XMY(BARNAME)=""
End DoDot:1
+7 QUIT
+8 ; *********************************************************************
+9 ;
MAILTXTM ;
+1 ; Determine body of e-mail
+2 KILL ^BARTMP("173MSG")
+3 SET K=0
+4 FOR
Begin DoDot:1
+5 SET K=K+1
+6 SET BARTXT=$PIECE($TEXT(@2+K),";;",2)
+7 IF BARTXT="END"
QUIT
+8 SET ^BARTMP("173MSG",K)=BARTXT
End DoDot:1
IF BARTXT="END"
QUIT
+9 ;
+10 ; Now get the duplicated bills
+11 ;
+12 IF '$DATA(^BARTMP("DUP"))
Begin DoDot:1
+13 SET ^BARTMP("173MSG",K+1)="***** NO DUPLICATE BILLS FOUND ****"
End DoDot:1
QUIT
+14 ;
+15 SET $PIECE(BARDASH,"-",51)=""
+16 SET $PIECE(BAREQUAL,"=",51)=""
+17 SET BARCNT=0
+18 SET BARTOT=0
+19 SET BARPAR=0
+20 FOR
SET BARPAR=$ORDER(^BARTMP("DUP",BARPAR))
IF '+BARPAR
QUIT
Begin DoDot:1
+21 SET (BARFCNT,BARFBT)=0
+22 SET K=K+1
+23 SET ^BARTMP("173MSG",K)="Parent Facility: "_$$GET1^DIQ(4,BARPAR,.01)
+24 SET K=K+1
+25 SET ^BARTMP("173MSG",K)=" "
+26 SET BARBL=""
+27 FOR
SET BARBL=$ORDER(^BARTMP("DUP",BARPAR,BARBL))
IF BARBL=""
QUIT
Begin DoDot:2
+28 SET BARFCNT=BARFCNT+1
+29 SET BARCNT=BARCNT+1
+30 SET BARBIL=$EXTRACT(BARBL,1,20)
+31 FOR I=$LENGTH(BARBIL):1:25
SET BARBIL=BARBIL_" "
+32 SET BARIEN=0
+33 FOR
SET BARIEN=$ORDER(^BARBL(BARPAR,"B",BARBL,BARIEN))
IF '+BARIEN
QUIT
Begin DoDot:3
+34 SET BARIENO="'"_BARIEN
+35 FOR I=$LENGTH(BARIENO):1:10
SET BARIENO=BARIENO_" "
+36 SET BARPIEN=$PIECE($GET(^BARBL(BARPAR,BARIEN,1)),U)
+37 IF BARPIEN]""
SET BARPAT=$EXTRACT($$GET1^DIQ(9000001,BARPIEN,.01),1,20)
+38 IF BARPIEN=""
SET BARPAT=""
+39 FOR I=$LENGTH(BARPAT):1:25
SET BARPAT=BARPAT_" "
+40 SET BARBAMT=$PIECE($GET(^BARBL(BARPAR,BARIEN,0)),U,13)
+41 SET BARBAMTO=$JUSTIFY($FNUMBER(BARBAMT,",",2),15)
+42 SET K=K+1
+43 SET ^BARTMP("173MSG",K)=BARIENO_BARBIL_BARPAT_BARBAMTO
End DoDot:3
+44 ; Facility bill total
SET BARFBT=BARBAMT+BARFBT
+45 SET BARTOT=BARBAMT+BARTOT
End DoDot:2
+46 SET K=K+1
+47 SET ^BARTMP("173MSG",K)=$JUSTIFY(BARDASH,79)
+48 SET K=K+1
+49 SET ^BARTMP("173MSG",K)=$JUSTIFY("Unique bill count: ",58)_$JUSTIFY(BARFCNT,4)_$JUSTIFY($FNUMBER(BARFBT,",",2),16)
+50 SET K=K+1
+51 SET ^BARTMP("173MSG",K)=" "
End DoDot:1
+52 SET ^BARTMP("173MSG",K)=$JUSTIFY(BAREQUAL,79)
+53 SET K=K+1
+54 SET ^BARTMP("173MSG",K)=$JUSTIFY("Total unique bill count: ",58)_$JUSTIFY(BARCNT,4)_$JUSTIFY($FNUMBER(BARTOT,",",2),16)
+55 QUIT
+56 ; *********************************************************************
+57 ;
MAILMSGM ;
+1 SET XMTEXT="^BARTMP(""173MSG"","
+2 SET %H=$HOROLOG
+3 DO YX^%DTC
+4 NEW DIFROM
+5 DO ^XMD
+6 QUIT
+7 ; *********************************************************************
+8 ;
1 ;;
+1 ;;Accounts Receivable V1.7 Patch 4 has been installed on your
+2 ;;computer. You have received this message because you hold the BARZMENU
+3 ;;key that allows access to the Accounts Receivable Master Menu.
+4 ;;
+5 ;;Accounts Receivable V1.7 Patch 4 is inclusive of patches 1 thru 3. It
+6 ;;also contains the following:
+7 ;;
+8 ;; 1. Changes to LOAD NEW IMPORT ERA Posting Menu option to include the
+9 ;; following:
+10 ;;
+11 ;; a. New HIPAA 835 V4010 transaction format for electronic remittance
+12 ;; advice (ERA) processing.
+13 ;; b. The system verifies the file being uploaded is a HIPAA 835 V4010 file.
+14 ;; c. If the bill found on the ERA file is cancelled in RPMS 3P, the bill
+15 ;; will not be matched and cannot be posted electronically.
+16 ;;
+17 ;; 2. To accomodate for files that contain more than one Check/EFT Trace
+18 ;; Number, the ERA Review, Post, and Report functions have been modified
+19 ;; to perform these functions by Check/EFT Trace number rather than the
+20 ;; entire file.
+21 ;;
+22 ;; 3. Changes to REVIEW POSTABLE CLAIMS ERA Posting Menu option to include
+23 ;; the following:
+24 ;;
+25 ;; a. The system performs a matching of EFT Check/Trace number from the
+26 ;; ERA to the Check # of the RPMS Collection Batch/Item.
+27 ;; b. Once the bills for a Check/EFT Trace number have been reviewed, the
+28 ;; check is removed from the selection list.
+29 ;;
+30 ;; 4. Changes to POST ERA CLAIMS ERA Posting Menu option to include the
+31 ;; following:
+32 ;;
+33 ;; a. Only Checks/EFT Trace #'s that have been reviewed appear for selection
+34 ;; for posting. Therefore, you must review before you post.
+35 ;; b. If posting the ERA bill will result in a negative balance on RPMS,
+36 ;; the user is notified and asked if the bill should be posted. If the user
+37 ;; chooses not to post the bill, the system does not post the bill and the
+38 ;; user is asked to continue the posting process.
+39 ;; c. If the site parameter is defined for Rollback, immediately after posting
+40 ;; of the Check/EFT Trace is complete, the user is asked if rollback
+41 ;; should occur at this time. If yes, bills are rolled back to 3P then.
+42 ;; If no, the bills are flagged and the user must use ROL to rollback.
+43 ;;
+44 ;; 5. Changes to REPORT ERA CLAIMS ERA Posting Menu option to include the
+45 ;; following:
+46 ;;
+47 ;; a. This report has been totally rewritten for the HIPAA 835 file format.
+48 ;;
+49 ;; 6. Transactions created via POST ERA CLAIMS will get flagged with an
+50 ;; "e". The "e" is displayed when viewing the bill's history.
+51 ;;
+52 ;; 7. When selecting "R" for rollback during the manual posting process,
+53 ;; (PST,ADJ or PST,PAY), the bill will rollback even if it has been previously
+54 ;; rolled back.
+55 ;;
+56 ;; 8. Updated Standard Claim Adjustment Reason Codes to accomodate reworded,
+57 ;; more clear explanations as defined in the AR Standard Claim Adjustment
+58 ;; Reason Codes file. Also, updates RPMS files with Standard Codes added
+59 ;; between June 2002 and September 2003.
+60 ;;
+61 ;; 9. Four Support Center calls that have been resolved:
+62 ;;
+63 ;; a. Resolved an undefined error when running the IG report
+64 ;; b. Resolved an undefined error when running Rolling back more than 50
+65 ;; bills to 3P during the posting process. This error does not occur if
+66 ;; rolling back to 3P from the A/R ROL option.
+67 ;; c. Resolved execute error when running A/R FM Sort and Print
+68 ;; d. Rebuild the ABAL x-ref on the Current Balance Field of the
+69 ;; A/R Bill/IHS file resolving issues of totals on aging reports.
+70 ;; e. The Age Summary Report has been modified to group data by Visit
+71 ;; Location and the EISS process has been updated to accomodate the
+72 ;; format.
+73 ;; f. The Patient Account Statement has been modified to accomodate
+74 ;; multi-facility sites.
+75 ;; g. A time stamp has been added to the date stamp on the Batch
+76 ;; Statistical Report.
+77 ;;END
+78 ;
2 ;;
+1 ;;As a part of the installation of Accounts Receivable V1.7 Patch 3, the system
+2 ;;looked for possible duplicates on your system. You have received this
+3 ;;message because you hold the BARZ MANAGER key that allows access to the
+4 ;;Accounts Receivable Manager options. The following is a list of possible
+5 ;;duplicates that were found. Please review these bills and write off the
+6 ;;first occurrence of the bill if you find it is truly a duplicate.
+7 ;;
+8 ;; IEN Bill Patient Billed Amount
+9 ;;
+10 ;;END
