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

BPS10PST.m

Go to the documentation of this file. 
  1. BPS10PST ;ALB/DMB - Post-install for BPS*1.0*10 ;09/20/2010
  1.  ;;1.0;E CLAIMS MGMT ENGINE;**10**;JUN 2004;Build 27
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; Reference to ^DIK supported by IA 10013
  1.  ; Reference to VFIELD^DILFD supported by IA 2205
  1.  ; Reference to FILESEC^DDMOD supported by IA 2916
  1.  Q
  1.  ;
  1. POST ; Entry Point for post-install
  1.  D MES^XPDUTL("  Starting post-install of BPS*1*10")
  1.  ;
  1.  ; Update BPS Requests, BPS Claims, BPS Responses, and BPS NCPDP Formats
  1.  ; Update Vitria Interface Version and do registration
  1.  D REQUESTS,INSURER,CLAIMS,RESPONSE,TRANLOG,FORMATS,VERSION,DDSCRTY,CERTSUB,ASLEEP
  1.  ;
  1.  D MES^XPDUTL("  Finished post-install of BPS*1*10")
  1.  Q
  1.  ;
  1. REQUESTS ; Update BPS Requests
  1.  D MES^XPDUTL("    - Updating BPS REQUESTS")
  1.  N IEN,CNT,RXI,FILL,TYPE,SCC
  1.  S CNT=0
  1.  S IEN=0 F  S IEN=$O(^BPS(9002313.77,IEN)) Q:'IEN  D
  1.  . S RXI=$P($G(^BPS(9002313.77,IEN,0)),U,1)
  1.  . S FILL=$P($G(^BPS(9002313.77,IEN,0)),U,2)
  1.  . S TYPE=$P($G(^BPS(9002313.77,IEN,1)),U,4)
  1.  . S SCC=$P($G(^BPS(9002313.77,IEN,2)),U,5)
  1.  . I TYPE'="E" D
  1.  .. S CNT=CNT+1
  1.  .. I SCC]"",$P($G(^BPS(9002313.77,IEN,1)),U,13)="" S $P(^BPS(9002313.77,IEN,2),U,5)=$P($G(^BPS(9002313.25,SCC,0)),U,1)
  1.  .. S $P(^BPS(9002313.77,IEN,1),U,13,14)=RXI_U_FILL
  1.  .. I $P(^BPS(9002313.77,IEN,1),U,15)="",RXI S $P(^BPS(9002313.77,IEN,1),U,15)=$$RXAPI1^BPSUTIL1(RXI,2,"I")
  1.  .. I $P(^BPS(9002313.77,IEN,1),U,2)="",RXI,FILL'="" S $P(^BPS(9002313.77,IEN,1),U,2)=$$GETSITE^BPSOSRX8(RXI,FILL)
  1.  D MES^XPDUTL("      ..."_CNT_" entries updated")
  1.  D MES^XPDUTL("    - Done with BPS REQUESTS")
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. INSURER ; Update BPS Insurer Data
  1.  D MES^XPDUTL("    - Updating BPS INSURER DATA")
  1.  N IEN,CNT
  1.  S CNT=0
  1.  S IEN=0 F  S IEN=$O(^BPS(9002313.78,IEN)) Q:'IEN  D
  1.  . S CNT=CNT+1
  1.  . S $P(^BPS(9002313.78,IEN,0),U,2)=$$PAYIEN($P($G(^BPS(9002313.78,IEN,4)),U,1))
  1.  . S $P(^BPS(9002313.78,IEN,0),U,3)=$$PAYIEN($P($G(^BPS(9002313.78,IEN,4)),U,2))
  1.  . S $P(^BPS(9002313.78,IEN,0),U,4)=$$PAYIEN($P($G(^BPS(9002313.78,IEN,4)),U,3))
  1.  . S $P(^BPS(9002313.78,IEN,0),U,10)=$$PAYIEN($P($G(^BPS(9002313.78,IEN,4)),U,4))
  1.  D MES^XPDUTL("      ..."_CNT_" entries updated")
  1.  D MES^XPDUTL("    - Done with BPS INSURER DATA")
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. PAYIEN(X) ; Get Payer Sheet IEN from the "B" X-ref
  1.  ; Use reverse $O in case there is more than one (which should not happen) so
  1.  ;   we will get the one with the highest IEN
  1.  I $G(X)="" Q ""
  1.  Q $O(^BPSF(9002313.92,"B",X,""),-1)
  1.  ;
  1. CLAIMS ; convert BPS CLAIMS (#9002313.02)
  1.  ;
  1.  D MES^XPDUTL("    - Converting data in BPS CLAIMS   "_$$HTE^XLFDT($H))
  1.  N BPSCONV,BPSD0,BPSD1,BPSFDBCK,BPSTOTAL,C,DA,DIK,X
  1.  S BPSD0=0,BPSCONV=0,BPSTOTAL=0,BPSFDBCK=0
  1.  F  S BPSD0=$O(^BPSC(BPSD0)) Q:'BPSD0  D
  1.  .S BPSTOTAL=BPSTOTAL+1,BPSD1=0,BPSFDBCK=BPSFDBCK+1
  1.  .F  S BPSD1=$O(^BPSC(BPSD0,400,BPSD1)) Q:'BPSD1  S X=$P($G(^(BPSD1,400)),U,20) D:X]""
  1.  ..Q:$D(^BPSC(BPSD0,400,BPSD1,354.01,0))  ; already converted
  1.  ..S $P(^BPSC(BPSD0,400,BPSD1,350),U,4)=1  ; (#354) SUBM CLARIFICATION CODE COUNT
  1.  ..S ^BPSC(BPSD0,400,BPSD1,354.01,0)="^9002313.02354^1^1"  ; (#354.01) SUBMISSION CLARIFICATION MLTPL
  1.  ..S ^BPSC(BPSD0,400,BPSD1,354.01,1,0)=1,^(1)=X
  1.  ..K DA S DIK="^BPSC("_BPSD0_",400,"_BPSD1_",354.01,",DA=1,DA(1)=BPSD1,DA(2)=BPSD0 D IX1^DIK
  1.  ..S BPSCONV=BPSCONV+1
  1.  .;
  1.  .I BPSFDBCK>4999 S BPSFDBCK=0 D MES^XPDUTL("    - Claim Entries Checked: "_$FN(BPSTOTAL,",")_"    "_$$HTE^XLFDT($H))
  1.  ;
  1.  S X=$FN(BPSTOTAL,",")_" Claim"_$E("s",BPSTOTAL'=1)_" checked and "_$FN(BPSCONV,",")_" converted."
  1.  D MES^XPDUTL("    - "_$$HTE^XLFDT($H)),MES^XPDUTL("    - "_X)
  1.  D MES^XPDUTL("    - done with BPS CLAIMS")
  1.  D MES^XPDUTL(" ")
  1.  ;
  1.  Q
  1.  ;
  1. RESPONSE ; convert BPS RESPONSES (#9002313.03)
  1.  ;
  1.  ; ^BPSR(D0,1000,D1,130.01,0)=^9002313.13001A^^  (#130.01) ADDITIONAL MESSAGE MLTPL
  1.  ; ^BPSR(D0,1000,D1,130.01,D2,0)= (#.01) ADDITIONAL MESSAGE COUNTER [1N] ^ (#131) ADDITIONAL MSG INFO CONTINUITY [2F] ^ (#132) ADDITIONAL MSG INFO QUALIFIER [3F] ^
  1.  ;
  1.  D MES^XPDUTL("    - Converting data in BPS RESPONSES   "_$$HTE^XLFDT($H))
  1.  N BPSD0,BPSD1,BPSFDBCK,BPSRESP,BPSTOTAL,BPSX,DA,DIK,X,Y
  1.  ;
  1.  S BPSD0=0,BPSRESP=0,BPSTOTAL=0,BPSFDBCK=0
  1.  ;
  1.  F  S BPSD0=$O(^BPSR(BPSD0)) Q:'BPSD0  D
  1.  .S BPSTOTAL=BPSTOTAL+1,BPSD1=0,BPSFDBCK=BPSFDBCK+1
  1.  .F  S BPSD1=$O(^BPSR(BPSD0,1000,BPSD1)) Q:'BPSD1  S X=$P($G(^(BPSD1,526)),U) D:X]""  ; ADDITIONAL MESSAGE INFORMATION
  1.  ..Q:$D(^BPSR(BPSD0,1000,BPSD1,130.01,0))  ; already converted
  1.  ..; (#130.01) ADDITIONAL MESSAGE MLTPL
  1.  ..S ^BPSR(BPSD0,1000,BPSD1,130.01,0)="^9002313.13001A^1^1"
  1.  ..S ^BPSR(BPSD0,1000,BPSD1,130.01,1,0)="1^^01"  ; NCPDP field 132-UH Additional Message Information Qualifier
  1.  ..S ^BPSR(BPSD0,1000,BPSD1,130.01,1,1)=X  ; ^BPSR(D0,1000,D1,130.01,D2,1)= (#526) ADDITIONAL MESSAGE INFO [1F] ^
  1.  ..K DA  ; rebuild DA every time
  1.  ..S DIK="^BPSR("_BPSD0_",1000,"_BPSD1_",130.01,",DA=1,DA(1)=BPSD1,DA(2)=BPSD0
  1.  ..D IX1^DIK
  1.  ..; field #130 ADDITIONAL MESSAGE INFO COUNT
  1.  ..;   NCPDP field 130-UF Additional Message Information Count
  1.  ..S $P(^BPSR(BPSD0,1000,BPSD1,120),U,10)=1
  1.  ..S BPSRESP=BPSRESP+1  ; total converted
  1.  .;
  1.  .I BPSFDBCK>4999 S BPSFDBCK=0 D MES^XPDUTL("    - Response Entries Checked: "_$FN(BPSTOTAL,",")_"    "_$$HTE^XLFDT($H))
  1.  ;
  1.  D MES^XPDUTL("    - "_$$HTE^XLFDT($H))
  1.  D MES^XPDUTL("    -  "_$FN(BPSTOTAL,",")_" Response"_$E("s",BPSTOTAL'=1)_" checked")
  1.  D MES^XPDUTL("    -     Additional Message Info fields converted: "_$FN(BPSRESP,","))
  1.  D MES^XPDUTL("    - done with BPS RESPONSES")
  1.  D MES^XPDUTL(" ")
  1.  ;
  1.  Q
  1.  ;
  1. TRANLOG ;
  1.  D MES^XPDUTL("    - Updating BPS LOG OF TRANSACTIONS")
  1.  K ^BPSTL("NON-FILEMAN","RXIRXR")
  1.  D MES^XPDUTL("    - Done with BPS LOG OF TRANSACTIONS")
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. FORMATS ; Remove data from deleted fields
  1.  ; Removing the following fields and deleting the data associated with the fields:
  1.  ;   1.03 - MAXIMUM RX PER CLAIM 
  1.  ;   1.07 - FORMAT IS FOR REVERSAL
  1.  ;   1.13 - SOFTWARE VENDOR CERT ID
  1.  ;   1001 - REVERSAL FORMAT
  1.  ;
  1.  D MES^XPDUTL("    - Updating BPS NCPDP FORMATS")
  1.  ;
  1.  ; Check if the fields have already been removed
  1.  ; IA 2205
  1.  I '$$VFIELD^DILFD(9002313.92,1.03),'$$VFIELD^DILFD(9002313.92,1.07),'$$VFIELD^DILFD(9002313.92,1.13),'$$VFIELD^DILFD(9002313.92,1001) D MES^XPDUTL("      ... Data and Fields already removed.  No further action.") G FEND
  1.  ; 
  1.  ; Delete the data first
  1.  N IEN,PIECE,DIK,DA
  1.  S IEN=0
  1.  F  S IEN=$O(^BPSF(9002313.92,IEN)) Q:'IEN  D
  1.  . ; Remove Max Transactions, Reversal Format, and Certification ID
  1.  . F PIECE=3,7,13 S $P(^BPSF(9002313.92,IEN,1),U,PIECE)=""
  1.  . ; Remove Reversal Format Field.  Kill entire node as this is the only field
  1.  . ;   on the node
  1.  . K ^BPSF(9002313.92,IEN,"REVERSAL")
  1.  ;
  1.  ; Delete the fields from the data defintion
  1.  ; IA 10013
  1.  S DIK="^DD(9002313.92,"
  1.  S DA(1)=9002313.92
  1.  F DA=1.03,1.07,1.13,1001 D ^DIK
  1.  ;
  1.  D MES^XPDUTL("    - Done with BPS NCPDP FORMATS")
  1. FEND ;
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. VERSION ; Update Vitria Interface Version and do automatic registration
  1.  D MES^XPDUTL("  Updating Interface Version and running registration")
  1.  S $P(^BPS(9002313.99,1,"VITRIA"),U,3)=4
  1.  D TASKMAN^BPSJAREG
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. DDSCRTY ; update the Data Dictionary Security
  1.  ;
  1.  D MES^XPDUTL("    - updating file security for BPS* files")
  1.  N BPSCRTY,BPSERR,BPSFILE,BPSL,V,X
  1.  S BPSFILE=9002313.77  ; BPS REQUESTS, update all security
  1.  S BPSCRTY("DD")="@"
  1.  S BPSCRTY("RD")="Pp"
  1.  S BPSCRTY("WR")="@"
  1.  S BPSCRTY("DEL")="@"
  1.  S BPSCRTY("LAYGO")="@"
  1.  S BPSCRTY("AUDIT")="@"
  1.  D FILESEC^DDMOD(BPSFILE,.BPSCRTY,"BPSERR")
  1.  I $D(BPSERR) D
  1.  .D MES^XPDUTL("    - error returned while updating File Security, file #"_BPSFILE)
  1.  .S V="BPSERR" F  S V=$Q(@V) Q:V=""  D MES^XPDUTL(" - error message: "_@V)
  1.  ;
  1.  ; update Read access for existing BPS files
  1.  F BPSL=1:1 S X=$P($T(DDSECFL+BPSL),";;",2) Q:X=""  D
  1.  .K BPSERR,BPSCRTY
  1.  .S BPSFILE=$P(X,";"),BPSCRTY("RD")="Pp"
  1.  .D FILESEC^DDMOD(BPSFILE,.BPSCRTY,"BPSERR")  Q:'$D(BPSERR)
  1.  .D MES^XPDUTL("    - error returned while updating File Security, file #"_BPSFILE)
  1.  .S V="BPSERR" F  S V=$Q(@V) Q:V=""  D MES^XPDUTL(" - error message: "_@V)
  1.  ;
  1.  D MES^XPDUTL("    - done updating file security")
  1.  ;
  1.  Q
  1.  ;
  1. DDSECFL ; files to update security
  1.  ;;9002313.21;BPS NCPDP PROFESSIONAL SERVICE CODE
  1.  ;;9002313.22;BPS NCPDP RESULT OF SERVICE CODE
  1.  ;;9002313.23;BPS NCPDP REASON FOR SERVICE CODE
  1.  ;;9002313.24;BPS NCPDP DAW CODE
  1.  ;;9002313.32;BPS PAYER RESPONSE OVERRIDES
  1.  ;;9002313.78;BPS INSURER DATA
  1.  ;
  1. CERTSUB ; remove a subfile DD from the BPS CERTIFICATION FILE - esg 1/4/11
  1.  D MES^XPDUTL("    - Updating BPS CERTIFICATION FILE")
  1.  N DIU
  1.  S DIU=9002313.31902   ; subfile# for (#902) VA PINS MULTIPLE
  1.  S DIU(0)="DS"         ; delete subfile data dictionary and any data that might exist
  1.  D EN^DIU2
  1.  D MES^XPDUTL("    - Done with BPS CERTIFICATION FILE")
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. ASLEEP ; Convert pointer to BPS Requests to BPS Transactions
  1.  D MES^XPDUTL("    - Updating BPS ASLEEP PAYERS file")
  1.  N IEN,CNT,PTR,X0,KEY1,KEY2,COB
  1.  S CNT=0
  1.  S IEN=0 F  S IEN=$O(^BPS(9002313.15,IEN)) Q:'IEN  D
  1.  . S PTR=$P($G(^BPS(9002313.15,IEN,0)),U,4)
  1.  . I PTR["." Q  ; Already converted
  1.  . I 'PTR Q
  1.  . S X0=$G(^BPS(9002313.77,PTR,0)) ; Get BPS Request data
  1.  . I X0="" Q
  1.  . S KEY1=$P(X0,U,1),KEY2=$P(X0,U,2),COB=$P(X0,U,3)
  1.  . I 'KEY1!(KEY2="")!'COB Q
  1.  . S $P(^BPS(9002313.15,IEN,0),U,4)=$$IEN59^BPSOSRX(KEY1,KEY2,COB)
  1.  . S CNT=CNT+1
  1.  D MES^XPDUTL("      ..."_CNT_" entries updated")
  1.  D MES^XPDUTL("    - Done with BPS ASLEEP PAYERS file")
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;