Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARPT174

BARPT174.m

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