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

IBMHPMPY1.m

Go to the documentation of this file. 
  1. IBMHPMPY1 ;EDE/WCJ-Multi-site maintain IB MH VISIT TRACKING FILE (#351.83) - (aka PushMi-PullYu); 22-OCT-23
  1.  ;;2.0;INTEGRATED BILLING;**779**;21-MAR-94;Build 7
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;; DBIA#1621 %ZTER (ERROR RECORDING)
  1.  ;; DBIA#2729 MESSAGE ACTION API
  1.  ;; DBIA#4678 VAFCTFU GET TREATING LIST
  1.  ;; DBIA#3144 DIRECT RPC CALLS
  1.  ;; DBIA#3149 XWBDRPC
  1.  ; 
  1.  G AWAY
  1.  ;
  1. AWAY Q  ;thought I was being figurative??? Haha, Guess again!
  1.  ;
  1.  ; This routine is for maintaining file entries in the IB MH VISIT TRACKING (#351.83) file across all treating facilites that a veteran has been seen at.
  1.  ; So, while the file will not be the same at each facility, entries for a single veteran should match at each of his/her treating facilities.  
  1.  ;
  1.  ; Every time a record is added/updated in this file by a user, the UPDATED (#1.01) field is set.
  1.  ; Nightly, this process will look for all the records in the file that have been updated.
  1.  ; For each record that has been updated, this process will look for all the facilities a veteran has been treated at and execute a stored procedure (RPC) at each of those facilities
  1.  ; to update their file.  If successful at all of the veteran's treating facilities, the UPDATED field will be removed.
  1.  ; If not successful, the record will remain flagged to indicate that it needs to be tried again at a later time. 
  1.  ;
  1.  ; There are multiple calling entry points
  1.  ; UPDATED - pretty much the process described above.
  1.  ; DFN - synch the entries for one veteran across her/his treating facilities.  This one is used when a veteran gets treated at a new facility and the new facility need to get
  1.  ;       caught up
  1.  ; PULLTHEM - This is used when a veteran is seen at a new treatiing facility.  It reaches out to each of the treating facilities and requests that all the veterans file entries that
  1.  ;       were created at a facility to be sent to the new one.
  1.  ;
  1.  ;  High level process flow
  1.  ; 1) get all the records that you want to update (either by UPDATED flag or DFN)
  1.  ; 2) loop through those and for each, get the veteran and his/her treating facilities
  1.  ; 3) loop through treating facilities and executing remote RPC passing in the information about the specific entry
  1.  ; 4) wait a reasonable amount on time for results from the remote treating facilities
  1.  ; 5) remove from index if successful
  1.  ; 6) rinse, repeat
  1.  ;
  1. UPDATED ; Get all in File that were UPDATED and not yet pushed out. They may have gotten to some sites but not all sites
  1.  ; 
  1.  D MULTI("AC",1)   ; "AC" index for updated (1's) records
  1.  ; Need IB 761 released as a proof of concept before this is uncommented
  1.  ;D EXTEMAIL ; Send email to mail group notifying of any exceptions
  1.  Q
  1.  ;
  1.  ; This was set up to pass in 1 regular index and an internal lookup value which it does an exact match on.
  1.  ; This leads to the most efficient database call acording to the FileMan manual (didn't actually run performance tests)
  1.  ; Any changes to this behavior would need to be tested/verified and potentially recoded.
  1. MULTI(IBINDEX,IBLOOKUP) ;
  1.  ; IBINDEX = a single regular fileman index
  1.  ; IBLOOKUP = internal value for that index
  1.  ;
  1.  K ^TMP("IBMHPMPY",$J)  ; start fresh
  1.  ;
  1.  ;D FIND^DIC(file[,iens][,fields][,flags],[.]value[,number][,[.]indexes][,[.]screen][,identifier][,target_root][,msg_root])  ; this line is just for reference
  1.  ; get all the requested entries
  1.  D FIND^DIC(351.83,"",".01;.02:99;.03I;.04I;.05;.06I;.07I;1.01I","QEP",IBLOOKUP,"",IBINDEX)
  1.  ;
  1.  ; this is what the file looks like so you know what is being grabbed above.
  1.  ;^IBMH(351.83,D0,0)= (#.01) PATIENT [1P:2] ^ (#.02) SITE [2P:4] ^ (#.03) VISIT DATE [3D] ^ (#.04) STATUS [4S] ^ (#.05) BILL NUMBER 
  1.  ;                ==>[5P:350] ^ (#.06) COMMENT [6S] ^ (#.07) UNIQUE ID 
  1.  ;
  1.  I '+$G(^TMP("DILIST",$J,0)) Q  ; nothing to see here folks - the FIND returned no results (maybe a slow day).
  1.  ;
  1.  ; and this is what the results look like - returned in the TMP global - I am a visual person so bear with me
  1.  ;^TMP("DILIST",1720,0)="50^*^0^"
  1.  ;^TMP("DILIST",1720,0,"MAP")="IEN^.01I^.01^C2^.03I^.04I^.05^.06I^.07I^1.01I"
  1.  ;^TMP("DILIST",1720,1,0)="1^1234567^PATIENT,TEST A^999^3190801^2^999-K909Z09^^^1"
  1.  ; have at them
  1.  N IBLOOP,IBDATA,IBIEN,IBDFN,IBSITE,IBFAC,IBVISDT,IBSTAT,IBBILL,IBCOMM,IBUNIQ,IBEXSITE,IBTFL,IBT,IBICN,IBH,IBX,IBR,IBERR,IBHERE,IBC,IBZ,IBOSITEEX,IBPATPR,IBELGRP
  1.  ;
  1.  S IBPATPR=IBINDEX="B"  ; Set IBPAT flag since behaviour will be even differenter than the others and we may need to check the flag often
  1.  ;
  1.  D SITE^IBAUTL   ; returns IBSITE (external#) and IBFAC (internal#) based on IB SITE PARAMETERS for this site
  1.  ;
  1.  S (IBERR,IBLOOP)=0
  1.  F IBLOOP=1:1:+$G(^TMP("DILIST",$J,0)) D
  1.  . S IBDATA=$G(^TMP("DILIST",$J,IBLOOP,0))   ; data is packed in format described above
  1.  . Q:IBDATA=""
  1.  . S IBIEN=$P(IBDATA,U)
  1.  . S IBDFN=$P(IBDATA,U,2)
  1.  . ;
  1.  . S IBOSITEEX=$P(IBDATA,U,4)  ; IEN file 4 (originating site external)
  1.  . I IBOSITEEX'=IBSITE D REMOVE(IBIEN) Q  ; if treatment is not for the current site, don't push out - it was pushed here.  Only originating sites should push.
  1.  . ;
  1.  . K IBTFL
  1.  . S IBT=$$TFL(IBDFN,IBOSITEEX,.IBTFL)
  1.  . I 'IBT D REMOVE(IBIEN) Q   ; not seen at other treating facilites so no where to send - done with entry
  1.  . ; 
  1.  . S IBICN=$$ICN^IBARXMU(IBDFN)
  1.  . I 'IBICN D LOGRES(IBDFN,.IBERR,"Failed local ICN lookup.") Q  ; no ICN - leave in the index and try again tomorrow since people eventually get ICNs according the MPI documentation
  1.  . ;
  1.  . S IBVISDT=$P(IBDATA,U,5)
  1.  . S IBSTAT=$P(IBDATA,U,6)
  1.  . S IBBILL=$P(IBDATA,U,7)
  1.  . S IBCOMM=$P(IBDATA,U,8)
  1.  . S IBUNIQ=$P(IBDATA,U,9)
  1.  . S:IBUNIQ="" IBUNIQ=IBSITE_"_"_IBIEN  ; The UNIQUE ID = SITE_IEN
  1.  . ;
  1.  . ; send off calls to other treating facilities that this veteran has been seen at
  1.  . ; the calls fire off the RPC (stored procedure) at each site
  1.  . ; DBIA#3144 DIRECT RPC CALLS
  1.  . ; DBIA#3149 XWBDRPC
  1.  . S IBX=0 F  S IBX=$O(IBTFL(IBX)) Q:IBX<1  D
  1.  .. N IBH
  1.  .. D:'IBPATPR EN1^XWB2HL7(.IBH,+IBTFL(IBX),"IBMH COPAY SYNCH","",IBICN,IBOSITEEX,IBVISDT,IBSTAT,IBBILL,IBCOMM,IBUNIQ) ; push one record
  1.  .. D:IBPATPR EN1^XWB2HL7(.IBH,+IBTFL(IBX),"IBMH COPAY SYNCH","",IBICN,IBOSITEEX)  ; push a request for all records for a patient (used when playing catch up - possibly adding a treating facility)
  1.  .. ; check for handle
  1.  .. I $G(IBH(0))="" D  Q
  1.  ... S IBTFL(IBX,"ERR")="No handle returned from RPC"
  1.  ... D LOGRES(,.IBERR,"No handle returned from call to site "_+IBTFL(IBX)_".") Q
  1.  .. S $P(IBTFL(IBX),"^",3)=IBH(0) ; save handle for later.
  1.  . ;
  1.  . ; now lets look for the remote data
  1.  . N IBREMOVE
  1.  . S IBREMOVE=1  ; default this to remove from index
  1.  . S IBX=0 F  S IBX=$O(IBTFL(IBX)) Q:IBX<1  D
  1.  .. I $D(IBTFL(IBX,"ERR")) S IBREMOVE=0 Q
  1.  .. ;
  1.  .. ; try up to 10 times for 2 seconds each (at each site)
  1.  .. N IBR
  1.  .. F IBC=1:1:10 D RPCCHK^XWB2HL7(.IBR,$P(IBTFL(IBX),U,3)) Q:$G(IBR(0))["Done"  H 2
  1.  .. ;
  1.  .. ; If not done at one (or more) facility set a flag so it does not get removed from the index 
  1.  .. I $G(IBR(0))'["Done" D LOGRES(IBDFN,.IBERR,"No reply from site "_+IBTFL(IBX)_".") S IBREMOVE=0
  1.  .. ; if done get data.
  1.  .. I $G(IBR(0))["Done" D
  1.  ... K IBR,IBHERE
  1.  ... D RTNDATA^XWBDRPC(.IBHERE,$P(IBTFL(IBX),"^",3))
  1.  ... I $D(IBHERE)>10 D   ; not sure if was success or failure so save for now
  1.  .... S IBERR=IBERR+1
  1.  .... M ^TMP("IBMHPMPY",$J,IBDFN,IBERR,+IBTFL(IBX))=IBHERE
  1.  .... ;WCJ;IB761; If the site that was just successful had previously logged a user correctable error then remove the error
  1.  .... I $P(IBTFL(IBX),U)=$$GET1^DIQ(351.83,IBIEN_",","3.03:99"),+$G(IBHERE(0))'<0 D CLEARERR(IBIEN)   ;WCJ;IB761
  1.  .... I +$G(IBHERE(0))<0 D CHKERR ;IB*2.0*761
  1.  .... I +$G(IBHERE(0))<0 S IBREMOVE=0   ; it failed to leave it
  1.  ... E  D
  1.  .... S IBERR=IBERR+1
  1.  .... M ^TMP("IBMHPMPY",$J,IBDFN,IBERR,+IBTFL(IBX))=^TMP($J,"XWB")
  1.  .... K ^TMP($J,"XWB")
  1.  .... S IBREMOVE=0   ; if any failed then leave it in to retry
  1.  ... D CLEAR^XWBDRPC(.IBZ,$P(IBTFL(IBX),"^",3))
  1.  .. E  D LOGRES(IBDFN,.IBERR,"Unable to get remote information from this site.") S IBREMOVE=0  ; IBR(0) did not contain 'Done'
  1.  . I IBREMOVE D REMOVE(IBIEN) Q
  1.  . Q
  1.  ;
  1.  ; It was nice that we flagged the errors and stored in a TMP global but we should probably alert somebody
  1.  D ALERTSO
  1.  ;
  1.  ; clean up
  1.  K ^TMP("IBMHPMPY",$J)
  1.  Q
  1.  ;
  1. LOGRES(IBDFN,ERR,RESMESS) ; log results
  1.  S ERR=ERR+1
  1.  I $G(IBDFN)="" N IBDFN S IBDFN=0   ; if no DFN then it's a generic type error not really specific to a patient
  1.  S ^TMP("IBMHPMPY",$J,IBDFN,ERR)=RESMESS
  1.  Q
  1.  ;
  1.  ; I stole (and modified) from another routine because I wanted to parameterize site.
  1.  ; they were using $$VASITE while we are using SITE^IBAUTL which grabs from different places. 
  1. TFL(DFN,IBS,IBT) ; returns treating facility list (pass IBT by reference)
  1.  ; supported references ia #2990, value returned is count
  1.  ; needed to N Y because VAFCTFU1 will kill it
  1.  ; DFN - Patient IEN
  1.  ; IBS - External site
  1.  ; IBT - By reference for results
  1.  ;
  1.  N IBC,IBZ,IBFT,Y
  1.  D TFL^VAFCTFU1(.IBZ,DFN)
  1.  Q:+$G(IBZ(1))=1 0
  1.  S (IBZ,IBC)=0
  1.  ; Return only remote facilities of certain types:
  1.  S IBFT="^VAMC^M&ROC^RO-OC^"
  1.  ; skip CERNER for now 200CRNR
  1.  F  S IBZ=$O(IBZ(IBZ)) Q:IBZ<1  I +IBZ(IBZ)>0,+IBZ(IBZ)'=IBS,IBFT[("^"_$P(IBZ(IBZ),U,5)_"^"),$P(IBZ(IBZ),U,1)'="200CRNR" S IBT(+IBZ(IBZ))=IBZ(IBZ),IBC=IBC+1
  1.  Q IBC
  1.  ;
  1. ALERTSO ; alert someone
  1.  ; what is needed to actually be informative - maybe PATIENT NAME, FULL ICN (if available), RECEIVING SITE, ERROR MESSAGE
  1.  ; screen out all but errors (get rid of 0's (info only) and 1's (successes))
  1.  ;
  1.  Q:'$D(^TMP("IBMHPMPY",$J))
  1.  N SUBJ,MSG,XMTO,LN,IBDFN,IBRES,IBDATA,IBFAC,IBLN,IBL4,IBAD,IBLP
  1.  S SUBJ="IBMH COPAY exceptions"
  1.  S LN=0,IBDFN=""
  1.  F  S IBDFN=$O(^TMP("IBMHPMPY",$J,IBDFN)) Q:+IBDFN'=IBDFN  D
  1.  . S IBAD=0
  1.  . S IBRES=0 F  S IBRES=$O(^TMP("IBMHPMPY",$J,IBDFN,IBRES))  Q:'IBRES  D
  1.  .. I IBDFN D   ; only for patient errors and not generic ones
  1.  ... S IBLN=$P($$GET1^DIQ(2,IBDFN,.01),",",1)   ; last name
  1.  ... S IBL4=$$GET1^DIQ(2,IBDFN,.09),IBL4=$E(IBL4,$L(IBL4)-3,9999)  ; last 4
  1.  .. S IBDATA=$G(^TMP("IBMHPMPY",$J,IBDFN,IBRES))
  1.  .. I IBDATA]"" D
  1.  ... I $D(^TMP("IBMHPMPY",$J,"INDX",IBDFN,IBDATA)) S ^TMP("IBMHPMPY",$J,"INDX",IBDFN,IBDATA)=^TMP("IBMHPMPY",$J,"INDX",IBDFN,IBDATA)+1 Q
  1.  ... I IBDFN=0,'IBAD S LN=LN+1,MSG(LN)="Generic Errors (not patient specific):",IBAD=1
  1.  ... I IBDFN,'IBAD S LN=LN+1,MSG(LN)=IBLN_" "_IBL4,IBAD=1
  1.  ... S LN=LN+1,MSG(LN)=IBDATA
  1.  ... S ^TMP("IBMHPMPY",$J,"INDX",IBDFN,IBDATA)=1
  1.  .. S IBFAC=0 F  S IBFAC=$O(^TMP("IBMHPMPY",$J,IBDFN,IBRES,IBFAC))  Q:'IBFAC  D
  1.  ... S IBLP="" F  S IBLP=$O(^TMP("IBMHPMPY",$J,IBDFN,IBRES,IBFAC,IBLP)) Q:IBLP=""  D
  1.  .... S IBDATA=$G(^TMP("IBMHPMPY",$J,IBDFN,IBRES,IBFAC,IBLP))
  1.  .... I +IBDATA<0 D
  1.  ..... I $D(^TMP("IBMHPMPY",$J,"INDX",IBDFN,IBFAC,IBDATA)) S ^TMP("IBMHPMPY",$J,"INDX",IBDFN,IBFAC,IBDATA)=^TMP("IBMHPMPY",$J,"INDX",IBDFN,IBFAC,IBDATA)+1 Q
  1.  ..... I IBDFN,'IBAD S LN=LN+1,MSG(LN)=IBLN_" "_IBL4,IBAD=1
  1.  ..... S LN=LN+1,MSG(LN)=$P(IBDATA,U,2,999)
  1.  ..... S ^TMP("IBMHPMPY",$J,"INDX",IBDFN,IBFAC,IBDATA)=1
  1.  . I $D(MSG)>1 S LN=LN+1,MSG(LN)=" "
  1.  Q:'LN
  1.  S XMTO("G.IBMH EXCEPTIONS")=""
  1.  D SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO)
  1.  D CLEAN^DILF
  1.  Q
  1.  ;
  1. REMOVE(IBIEN) ; remove from UPDATED index - only called if sent to ALL other treating facilities successfully.
  1.  N FDA,IENS,RETURN
  1.  S IENS=IBIEN_","
  1.  S FDA(351.83,IENS,1.01)=0
  1.  D FILE^DIE("","FDA","RETURN")
  1.  D CLEARERR(IBIEN)  ;WCJ;IB761;just in case
  1.  Q
  1.  ;
  1.  ;WCJ;IB761; Added CLEARERR tag
  1. CLEARERR(IBIEN) ; remove from UPDATED index - only called if sent to ALL other treating facilities successfully.
  1.  N FDA,IENS,RETURN
  1.  S IENS=IBIEN_","
  1.  S FDA(351.83,IENS,3.01)="@"
  1.  S FDA(351.83,IENS,3.02)="@"
  1.  S FDA(351.83,IENS,3.03)="@"
  1.  D FILE^DIE("","FDA","RETURN")
  1.  Q
  1.  ;
  1. CHKERR ; Check error code and set file 351.83 fields 3.01, 3.02.&3.03 IB*2.0*761
  1.  N IBERR,IBERRCD
  1.  S IBERR="" F  S IBERR=$O(IBHERE(IBERR)) Q:IBERR=""  D
  1.  . S IBERRCD=+$G(IBHERE(IBERR))
  1.  . I IBERRCD'<0 Q
  1.  . ;SET FIELDS 3.01,3.02,3.03 IN File #351.83
  1.  . S DIE=351.83 S DA=IBIEN
  1.  . S DR="3.01///1;3.03///"_$P(IBTFL(IBX),U)_";"
  1.  . I IBERRCD=-2 S DR=DR_"3.02///E" ;Exception Reason
  1.  . I IBERRCD=-3 S DR=DR_"3.02///N" ;Exception Reason
  1.  . I IBERRCD'=-2&(IBERRCD'=-3) K DIE,DR,DA Q  ;Don't set field if error code is not -2 or -3
  1.  . D ^DIE
  1.  Q
  1. EXTEMAIL ; IB*2.0*761
  1.  N IBMHIEN,CNT,LINE,XMDUZ,XMTEXT,XMY,XMSUB
  1.  S (IBMHIEN,CNT)=0
  1.  K ^TMP($J,"IBMHEXCP")
  1.  F  S IBMHIEN=$O(^IBMH(351.83,"AT",1,IBMHIEN)) Q:IBMHIEN=""  S CNT=CNT+1
  1.  I CNT=0 Q
  1.  S XMSUB="MENTAL HEALTH VISIT EXEPTIONS PRESENT"
  1.  S ^TMP($J,"IBMHEXCP",1)="Exceptions occurred during the transmission of Mental Health visit data to other VAMCs. Please review the VistA Mental Health Copay Transmission Exception Report and/or your VistA MailMan bulletin for further details."
  1.  S XMTEXT="^TMP($J,""IBMHEXCP"","
  1.  S XMDUZ=.5
  1.  S XMY("G.IB MH REMOTE")=""
  1.  D ^XMD
  1.  Q
  1.  ;