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

IBECEA38.m

Go to the documentation of this file.
  1. IBECEA38 ;EDE/WCJ-Multi-site maintain UC VISIT TRACKING FILE (#351.82) - RPC RETURN ; 2-DEC-19
  1. ;;2.0;INTEGRATED BILLING;**663,671,669,696**;21-MAR-94;Build 3
  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??? 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,IBELGRP) ;
  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.82 on originating site ex. 442_1234567
  1. ; IBELGRP - Eligibity Group coming in - must match receiving system
  1. ; OUTPUT:
  1. ; results are returned in the results array as described in INPUT section
  1. ; "-1^Error message"
  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.82 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.82) 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. I '$D(IBR) S IBR=$NA(^TMP("IBECEA37",$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,'$D(IBELGRP):8,1:0)
  1. I IBMISS S @IBR@(1)="-1^Missing required input parameter: "_$P("IBICN.IBOSITEEX.IBVISDT.IBSTAT.IBBILL.IBCOMM.IBUNIQ.IBELGRP",".",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. ;WCJ;IB696,if the visit date is before the patient was added to this system don't care about the eligibility group check
  1. ;DBIA#10035-support ICR to read this patient file field
  1. ;I $$GETELGP^IBECEA36(IBDFN,IBVISDT)'=IBELGRP D Q
  1. I $$GETELGP^IBECEA36(IBDFN,IBVISDT)'=IBELGRP,$S('$$GET1^DIQ(2,IBDFN,.097,"I"):1,IBVISDT<$$GET1^DIQ(2,IBDFN,.097,"I"):0,1:1) D Q
  1. . N Y S Y=IBVISDT X ^DD("DD")
  1. . S @IBR@(1)="-1^Patient's eligibility group differs between sites for date of service "_Y_"."
  1. . S @IBR@(2)="-1^Site# "_IBSITE_" = "_$$GETELGP^IBECEA36(IBDFN,IBVISDT)
  1. . S @IBR@(3)="-1^Site# "_IBOSITEEX_" = "_IBELGRP
  1. . 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.82 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.82,"",".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. .. S @IBR@(1)="-1^Unable to ADD record at site# "_IBSITE_"."
  1. .. S:IBRETURN["MAX free" @IBR@(2)=-1_U_IBRETURN
  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.82 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,IBMAXFR
  1. S IBMAXFR=3 ; max free visits in a calendar year
  1. S IBCTS=$$GETVST^IBECEA36(IBDFN,IBVISDT)
  1. I $G(IBSTAT)=1,$P(IBCTS,U,2)'<IBMAXFR 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.82,IENS,.01)=IBDFN
  1. S FDA(351.82,IENS,.02)=$$FIND1^DIC(4,,"X",IBSITE,"D") ; turn external site # into internal one
  1. S FDA(351.82,IENS,.03)=IBVISDT
  1. S FDA(351.82,IENS,.04)=$G(IBSTAT)
  1. S FDA(351.82,IENS,.05)=$G(IBBILL)
  1. S FDA(351.82,IENS,.06)=$G(IBCOMM)
  1. S FDA(351.82,IENS,.07)=$G(IBUNIQ)
  1. S FDA(351.82,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.82 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,IBMAXFR,IBDFN,IBVISDT
  1. S IBDFN=$$GET1^DIQ(351.82,IBIEN,.01,"I")
  1. S IBVISDT=$$GET1^DIQ(351.82,IBIEN,.03,"I")
  1. S IBMAXFR=3 ; max free visits in a calendar year
  1. S IBCTS=$$GETVST^IBECEA36(IBDFN,IBVISDT)
  1. I $G(IBSTAT)=1,$P(IBCTS,U,2)'<IBMAXFR 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.82,IENS,.04)=$G(IBSTAT)
  1. S FDA(351.82,IENS,.05)=$G(IBBILL)
  1. S FDA(351.82,IENS,.06)=$G(IBCOMM)
  1. S FDA(351.82,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.82,"",".01;.02:99;.03I;.04I;.05;.06I;.07I;1.01I;.01:991.1;.08","QEP",IBDFN,"","B",IBSCREEN)
  1. D FIND^DIC(351.82,"",".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