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

IBMHPMPY2.m

Go to the documentation of this file. 
  1. IBMHPMPY2 ;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#10053 grab field .097 from file 2
  1.  G AWAY
  1.  ;
  1. AWAY Q  ;thought I was being figurative??? Haha, Guess again!
  1.  ;
  1.  ; RPC endpoint
  1.  ; this is where the RPC is actually called at the remote facility.
  1. RETURN(IBR,IBICN,IBOSITEEX,IBVISDT,IBSTAT,IBBILL,IBCOMM,IBUNIQ) ;
  1.  ;
  1.  ; INPUT:
  1.  ;        IBR - Results go here
  1.  ;        IBICN - Patients ICN so that we can find the patient across sites
  1.  ;        IBOSITEEX - external site number
  1.  ;        IBVISDT - Visit date
  1.  ;        IBSTAT - Status
  1.  ;        IBBILL - Bill number or possibly free text description such as 'ONHOLD'
  1.  ;        IBCOMM - Cancel reason
  1.  ;        IBUPDATE - 1 if this is the originating site and data should be pushed out to other treating facilities, otherwise 0
  1.  ;        IBUNIQ - Unique ID consiting of external site number underscor ien of file 351.83 on originating site ex. 442_1234567
  1.  ; OUTPUT:
  1.  ;        results are returned in the results array as described in INPUT section
  1.  ;        "-1^Error message"
  1.  ;        "-2^Error message" if patent eligibility group mismatch IB*2.0*761
  1.  ;        "-3^Error message" if no remaining Free Days. IB*2.0*761
  1.  ;        "0^No action taken (nor needed) message"
  1.  ;        "1^Success message"
  1.  ; 
  1.  ; ADDITIONAL OUTPUT on PULL - all records for a patient in file 351.83 that were created at this facility
  1.  ;
  1.  ; 1) check if the entry is already there based on the unique ID (external originating site and their IEN from file 351.83) passed in.
  1.  ; 2) if it's already there, see if anything changed (might be an update).
  1.  ;   a) if already there and no changes, don't do anything with it but also don't return an error message.  Any cheerful, uplifting response would do and then gracefully exit.
  1.  ;   b) if already there but allowable fields being updated, then do so, let them know, and quitely ride off into the sunset.
  1.  ; 3) If you got this far, add it to the file.
  1.  ; 4) return something to let them know how you did
  1.  ;
  1.  ;D APPERROR^%ZTER("Bill's Intentional Error #1 - AKA got here")
  1.  I '$D(IBR) S IBR=$NA(^TMP("IBMHPMPY1",$J)) ; didn't think I would need, but...
  1.  ;
  1.  N IBDFN,IBSCREEN,IBIEN4,IBDATA,IBIEN351P82,IBADDED,IBUPDATED,IBRETURN,IBMISS,IBFAC,IBSITE
  1.  D SITE^IBAUTL  ; returns IBSITE (external) and IBFAC (internal may not be VAMC)
  1.  ;
  1.  ; see if it's a pull for specific patient.  It will only have the patient's ICN and the site it's pulling to
  1.  I '$D(IBVISDT),'$D(IBSTAT),'$D(IBBILL),'$D(IBCOMM),'$D(IBUNIQ),$G(IBICN),$G(IBOSITEEX) D  Q
  1.  . D PULL(.IBR,IBFAC,IBSITE,IBICN,IBOSITEEX)
  1.  . Q
  1.  ;
  1.  ; Make sure everything needed is here. Better doublecheck on what is needed.
  1.  S IBMISS=$S('$D(IBICN):1,'$D(IBOSITEEX):2,'$D(IBVISDT):3,'$D(IBSTAT):4,'$D(IBBILL):5,'$D(IBCOMM):6,'$D(IBUNIQ):7,1:0)
  1.  I IBMISS S @IBR@(1)="-1^Missing required input parameter: "_$P("IBICN.IBOSITEEX.IBVISDT.IBSTAT.IBBILL.IBCOMM.IBUNIQ",".",IBMISS) Q
  1.  ;
  1.  I IBOSITEEX=IBSITE S @IBR@(1)="0^No action performed.  Current site# "_IBSITE_" equals originating site# "_IBOSITEEX Q
  1.  ;
  1.  S IBIEN4=$$FIND1^DIC(4,,"X",IBOSITEEX,"D")   ; get the internal site number (File 4 IEN) - should be the same across sites but then again shouldn't have to.
  1.  I 'IBIEN4 S @IBR@(1)="-1^Site# "_IBOSITEEX_" not found in INSTITUTION (#4) file lookup" Q
  1.  ;
  1.  ; make sure the patient is identifiable from this ICN
  1.  ; if not, not much I can do
  1.  S IBDFN=+$$DFN^IBARXMU($G(IBICN))
  1.  I 'IBDFN S @IBR@(1)="-1^Patient ICN: "_IBICN_" not found at site# "_IBSITE Q
  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.  ;
  1.  ; this sets the screen for the FIND call.
  1.  ; FIND is by IBUNIQ (the unique ID consisting of the external site # and the the IEN to file 351.83 at that site.
  1.  ; It if finds one, it's a potential edit and we will deal with that.
  1.  ; If it finds more than one, not much I can do except throw my hands in the air.  Since adding the unique ID, that really shouldn't happen.
  1.  ; 
  1.  D FIND^DIC(351.83,"",".01;.02:99;.03I;.04I;.05;.06I;.07I;1.01I","QEPX",IBUNIQ,"","AUID")
  1.  ;
  1.  ; found one - see if anything changed and update if needed
  1.  ; now what can really change - IBSTAT, IBBILL, IBCOMM are only fields allowed to change 
  1.  I +$G(^TMP("DILIST",$J,0))=1 D  Q
  1.  . S IBDATA=$G(^TMP("DILIST",$J,1,0))
  1.  . S IBIEN351P82=+IBDATA
  1.  . I $P(IBDATA,U,6)=IBSTAT,$P(IBDATA,U,7)=IBBILL,$P(IBDATA,U,8)=IBCOMM S @IBR@(1)="0^No changes requested" Q
  1.  . S IBUPDATED=$$UPDATE(IBIEN351P82,IBSTAT,IBBILL,IBCOMM,1,.IBRETURN)
  1.  . I 'IBUPDATED D  Q
  1.  .. S @IBR@(1)="-1^Unable to UPDATE record at site# "_IBSITE_"."
  1.  .. S:IBRETURN["MAX free" @IBR@(2)=-1_U_IBRETURN
  1.  . S @IBR@(1)="1^successfully updated" Q
  1.  . Q
  1.  ;
  1.  ; found "many" (could be two or a jillion).  Should not happen now that we add a unique identifier (KEYWORDS: should + not + unique)
  1.  I +$G(^TMP("DILIST",$J,0))>1 D  Q
  1.  . S @IBR@(1)="-1^Could not uniquely identify entry being updated - more than one match.  Originating site# "_$P(IBUNIQ,"_")_" and IEN:"_$P(IBUNIQ,"_",2) Q
  1.  ;
  1.  ; no matches, feel free to add one
  1.  I '$G(^TMP("DILIST",$J,0)) D  Q
  1.  . S IBADDED=$$ADD(IBDFN,IBOSITEEX,IBVISDT,IBSTAT,IBBILL,IBCOMM,0,IBUNIQ,.IBRETURN)
  1.  . I 'IBADDED D  Q
  1.  . . ;IB*2.0*761 updated return code for no free visits left
  1.  .. S @IBR@(1)="-1^Unable to ADD record at site# "_IBSITE_"."
  1.  .. S:IBRETURN["MAX free" @IBR@(2)=-3_U_IBRETURN ;IB*2.0*761
  1.  . S @IBR@(1)="1^successfully added" Q
  1.  . Q
  1.  Q
  1.  ;
  1. ADD(IBDFN,IBSITE,IBVISDT,IBSTAT,IBBILL,IBCOMM,IBUPDATE,IBUNIQ,RETURN) ; Add an entry to the file
  1.  ; INPUT:
  1.  ;        IBDFN - Pointer to the patient number
  1.  ;        IBSITE - external site number
  1.  ;        IBVISDT - Visit date
  1.  ;        IBSTAT - Status
  1.  ;        IBBILL - Bill number or possibly free text description such as 'ONHOLD'
  1.  ;        IBCOMM - Cancel reason
  1.  ;        IBUPDATE - 1 if this is the originating site and data should be pushed out to other treating facilities, otherwise 0
  1.  ;        IBUNIQ - Unique ID consiting of external site number underscor ien of file 351.83 on originating site ex. 442_1234567
  1.  ; OUTPUT:
  1.  ;        RETURN - This is any information returned by FileMan if update was unsuccessful
  1.  ;  
  1.  ; Function call returns 0 or 1 if successful.
  1.  ; data must be all internal or all external - no mashup of the two allowed
  1.  ; I vote internal and since I am coding...
  1.  ; the incoming parameters were all internal except site #.
  1.  ; NOTE to self: internal data is filed without validation so be sure it's cool
  1.  ;
  1.  N IBCTS
  1.  S IBCTS=$$NUMVSTCK^IBECEAMH(IBDFN,IBVISDT)
  1.  I $G(IBSTAT)=1,'IBCTS D  Q 0
  1.  . N Y
  1.  . S Y=IBVISDT X ^DD("DD")
  1.  . S RETURN="Exceeds MAX free visits in a calendar year.  Can't add "_Y_"."
  1.  ;
  1.  N FDA,IENS
  1.  S IENS="+1,"
  1.  S FDA(351.83,IENS,.01)=IBDFN
  1.  S FDA(351.83,IENS,.02)=$$FIND1^DIC(4,,"X",IBSITE,"D")   ; turn external site # into internal one
  1.  S FDA(351.83,IENS,.03)=IBVISDT
  1.  S FDA(351.83,IENS,.04)=$G(IBSTAT)
  1.  S FDA(351.83,IENS,.05)=$G(IBBILL)
  1.  S FDA(351.83,IENS,.06)=$G(IBCOMM)
  1.  S FDA(351.83,IENS,.07)=$G(IBUNIQ)
  1.  S FDA(351.83,IENS,1.01)=$G(IBUPDATE)  ; While technically being added, this is not the originating site so don't mark as such.  The flag is used to determine which entries to push.
  1.  ;
  1.  ; first parameter is currently "" so internal it is for now
  1.  D UPDATE^DIE("","FDA","","RETURN")
  1.  ;
  1.  ; if RETURN is defined then BAD else GOOD
  1.  Q $S($D(RETURN):0,1:1)
  1.  ;
  1. UPDATE(IBIEN,IBSTAT,IBBILL,IBCOMM,IBUPDATE,RETURN) ; update an entry to the file
  1.  ;  INPUT:
  1.  ;        IBIEN - internal entry number into 351.83 that is being edited
  1.  ;        IBSTAT - Status
  1.  ;        IBBILL - Bill number or possibly free text description such as 'ONHOLD'
  1.  ;        IBCOMM - Cancel reason 
  1.  ;        IBUPDATE  - 1 if this is the originating site and data should be pushed out to other treating facilities, otherwise 0
  1.  ;  OUTPUT:
  1.  ;        RETURN - This is any information returned by FileMan if update was unsuccessful
  1.  ;  
  1.  ; Function call returns 0 or 1 if successful.
  1.  ;    
  1.  ; limiting edits to a few fields
  1.  ; data must be all internal or all external - no mashup of the two allowed
  1.  ; I still vote internal and since I am still coding...
  1.  ; the incoming parameters were all internal
  1.  ; NOTE to self: internal data is filed without validation so be sure it's cool
  1.  ;
  1.  ; returns 1 if added sucessfully
  1.  ; returns 0 otherwise
  1.  ;
  1.  N IBCTS,IBDFN,IBVISDT
  1.  S IBDFN=$$GET1^DIQ(351.83,IBIEN,.01,"I")
  1.  S IBVISDT=$$GET1^DIQ(351.83,IBIEN,.03,"I")
  1.  S IBCTS=$$NUMVSTCK^IBECEAMH(IBDFN,IBVISDT)
  1.  I $G(IBSTAT)=1,'IBCTS D  Q 0
  1.  . N Y
  1.  . S Y=IBVISDT X ^DD("DD")
  1.  . S RETURN="Exceeds MAX free visits in a calendar year.  Can't update "_Y_"."
  1.  ;
  1.  N FDA,IENS
  1.  S IENS=IBIEN_","
  1.  S FDA(351.83,IENS,.04)=$G(IBSTAT)
  1.  S FDA(351.83,IENS,.05)=$G(IBBILL)
  1.  S FDA(351.83,IENS,.06)=$G(IBCOMM)
  1.  S FDA(351.83,IENS,1.01)=$G(IBUPDATE,0)
  1.  ;
  1.  ; first parameter is currently "" so internal it is for now
  1.  D FILE^DIE("","FDA","RETURN")
  1.  ;
  1.  ; if RETURN is defined then BAD else GOOD
  1.  Q $S($D(RETURN):0,1:1)
  1.  ;
  1. PULL(RETURN,IBFAC,IBSITE,IBICN,IBOSITEEX) ; Pull all records that originated at this site for this patient
  1.  ; RETURN - array
  1.  ; IBFAC - this site internal
  1.  ; IBSITE - this site external
  1.  ; IBICN - Patient being pulled
  1.  ; IBOSITEEX - Requesting site
  1.  ;
  1.  N IBIEN4,IBDFN,IBSCREEN,IBDATA,IBLOOP,IBADD,IBRESULTS
  1.  S IBIEN4=$$FIND1^DIC(4,,"X",IBOSITEEX,"D")   ; get the internal site number (File 4 IEN) - should be the same across sites but then again shouldn't have to.
  1.  I 'IBIEN4 S @RETURN@(1)="-1^Site# "_IBOSITEEX_" not found in INSTITUTION (#4) file lookup at site# "_IBSITE Q
  1.  ;
  1.  ; make sure the patient is identifiable from this ICN
  1.  ; if not, not much I can do
  1.  S IBDFN=+$$DFN^IBARXMU($G(IBICN))
  1.  I 'IBDFN S @RETURN@(1)="-1^Patient ICN: "_IBICN_" not found at site# "_IBSITE Q
  1.  ;
  1.  ; Get all/only the records for the patient which originated at this site.
  1.  ;WCJ;IB696
  1.  ;S IBSCREEN="I $P(^(0),U,2)=IBFAC"
  1.  S IBSCREEN="I $P(^(0),U,2)="_$$IEN^XUAF4(IBSITE)
  1.  ;
  1.  ;WCJ;IB696;add the date patient added to the patient file
  1.  ;DBIA#10053-allows IB to read this field in patient File with FileMan
  1.  ;D FIND^DIC(351.83,"",".01;.02:99;.03I;.04I;.05;.06I;.07I;1.01I;.01:991.1;.08","QEP",IBDFN,"","B",IBSCREEN)
  1.  D FIND^DIC(351.83,"",".01;.02:99;.03I;.04I;.05;.06I;.07I;1.01I;.01:991.1;.08;.01:.097","QEP",IBDFN,"","B",IBSCREEN)
  1.  ;
  1.  I '+$G(^TMP("DILIST",$J,0)) D  Q
  1.  . N IBLN,IBL4
  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 @RETURN@(1)="0^No records to pull for patient "_IBLN_" ("_IBL4_") at site# "_IBSITE
  1.  ;
  1.  ; sent all the records for this patient created by this facility
  1.  M @RETURN=^TMP("DILIST",$J)
  1.  Q