IBECEA38 ;EDE/WCJ-Multi-site maintain UC VISIT TRACKING FILE (#351.82) - RPC RETURN ; 2-DEC-19
;;2.0;INTEGRATED BILLING;**663,671,669,696**;21-MAR-94;Build 3
;;Per VA Directive 6402, this routine should not be modified.
;; DBIA#1621 %ZTER (ERROR RECORDING)
;; DBIA#10053 grab field .097 from file 2
G AWAY
;
AWAY Q ;thought I was being figurative??? Guess again!
;
; RPC endpoint
; this is where the RPC is actually called at the remote facility.
RETURN(IBR,IBICN,IBOSITEEX,IBVISDT,IBSTAT,IBBILL,IBCOMM,IBUNIQ,IBELGRP) ;
;
; INPUT:
; IBR - Results go here
; IBICN - Patients ICN so that we can find the patient across sites
; IBOSITEEX - external site number
; IBVISDT - Visit date
; IBSTAT - Status
; IBBILL - Bill number or possibly free text description such as 'ONHOLD'
; IBCOMM - Cancel reason
; IBUPDATE - 1 if this is the originating site and data should be pushed out to other treating facilities, otherwise 0
; IBUNIQ - Unique ID consiting of external site number underscor ien of file 351.82 on originating site ex. 442_1234567
; IBELGRP - Eligibity Group coming in - must match receiving system
; OUTPUT:
; results are returned in the results array as described in INPUT section
; "-1^Error message"
; "0^No action taken (nor needed) message"
; "1^Success message"
;
; ADDITIONAL OUTPUT on PULL - all records for a patient in file 351.82 that were created at this facility
;
; 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.
; 2) if it's already there, see if anything changed (might be an update).
; 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.
; b) if already there but allowable fields being updated, then do so, let them know, and quitely ride off into the sunset.
; 3) If you got this far, add it to the file.
; 4) return something to let them know how you did
;
I '$D(IBR) S IBR=$NA(^TMP("IBECEA37",$J)) ; didn't think I would need, but...
;
N IBDFN,IBSCREEN,IBIEN4,IBDATA,IBIEN351P82,IBADDED,IBUPDATED,IBRETURN,IBMISS,IBFAC,IBSITE
D SITE^IBAUTL ; returns IBSITE (external) and IBFAC (internal may not be VAMC)
;
; see if it's a pull for specific patient. It will only have the patient's ICN and the site it's pulling to
I '$D(IBVISDT),'$D(IBSTAT),'$D(IBBILL),'$D(IBCOMM),'$D(IBUNIQ),$G(IBICN),$G(IBOSITEEX) D Q
. D PULL(.IBR,IBFAC,IBSITE,IBICN,IBOSITEEX)
. Q
;
; Make sure everything needed is here. Better doublecheck on what is needed.
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)
I IBMISS S @IBR@(1)="-1^Missing required input parameter: "_$P("IBICN.IBOSITEEX.IBVISDT.IBSTAT.IBBILL.IBCOMM.IBUNIQ.IBELGRP",".",IBMISS) Q
;
I IBOSITEEX=IBSITE S @IBR@(1)="0^No action performed. Current site# "_IBSITE_" equals originating site# "_IBOSITEEX Q
;
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.
I 'IBIEN4 S @IBR@(1)="-1^Site# "_IBOSITEEX_" not found in INSTITUTION (#4) file lookup" Q
;
; make sure the patient is identifiable from this ICN
; if not, not much I can do
S IBDFN=+$$DFN^IBARXMU($G(IBICN))
I 'IBDFN S @IBR@(1)="-1^Patient ICN: "_IBICN_" not found at site# "_IBSITE Q
;
;WCJ;IB696,if the visit date is before the patient was added to this system don't care about the eligibility group check
;DBIA#10035-support ICR to read this patient file field
;I $$GETELGP^IBECEA36(IBDFN,IBVISDT)'=IBELGRP D Q
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
. N Y S Y=IBVISDT X ^DD("DD")
. S @IBR@(1)="-1^Patient's eligibility group differs between sites for date of service "_Y_"."
. S @IBR@(2)="-1^Site# "_IBSITE_" = "_$$GETELGP^IBECEA36(IBDFN,IBVISDT)
. S @IBR@(3)="-1^Site# "_IBOSITEEX_" = "_IBELGRP
. Q
;
;D FIND^DIC(file[,iens][,fields][,flags],[.]value[,number][,[.]indexes][,[.]screen][,identifier][,target_root][,msg_root]) ; this line is just for reference
;
; this sets the screen for the FIND call.
; FIND is by IBUNIQ (the unique ID consisting of the external site # and the the IEN to file 351.82 at that site.
; It if finds one, it's a potential edit and we will deal with that.
; 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.
;
D FIND^DIC(351.82,"",".01;.02:99;.03I;.04I;.05;.06I;.07I;1.01I","QEPX",IBUNIQ,"","AUID")
;
; found one - see if anything changed and update if needed
; now what can really change - IBSTAT, IBBILL, IBCOMM are only fields allowed to change
I +$G(^TMP("DILIST",$J,0))=1 D Q
. S IBDATA=$G(^TMP("DILIST",$J,1,0))
. S IBIEN351P82=+IBDATA
. I $P(IBDATA,U,6)=IBSTAT,$P(IBDATA,U,7)=IBBILL,$P(IBDATA,U,8)=IBCOMM S @IBR@(1)="0^No changes requested" Q
. S IBUPDATED=$$UPDATE(IBIEN351P82,IBSTAT,IBBILL,IBCOMM,1,.IBRETURN)
. I 'IBUPDATED D Q
.. S @IBR@(1)="-1^Unable to UPDATE record at site# "_IBSITE_"."
.. S:IBRETURN["MAX free" @IBR@(2)=-1_U_IBRETURN
. S @IBR@(1)="1^successfully updated" Q
. Q
;
; found "many" (could be two or a jillion). Should not happen now that we add a unique identifier (KEYWORDS: should + not + unique)
I +$G(^TMP("DILIST",$J,0))>1 D Q
. 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
;
; no matches, feel free to add one
I '$G(^TMP("DILIST",$J,0)) D Q
. S IBADDED=$$ADD(IBDFN,IBOSITEEX,IBVISDT,IBSTAT,IBBILL,IBCOMM,0,IBUNIQ,.IBRETURN)
. I 'IBADDED D Q
.. S @IBR@(1)="-1^Unable to ADD record at site# "_IBSITE_"."
.. S:IBRETURN["MAX free" @IBR@(2)=-1_U_IBRETURN
. S @IBR@(1)="1^successfully added" Q
. Q
Q
;
ADD(IBDFN,IBSITE,IBVISDT,IBSTAT,IBBILL,IBCOMM,IBUPDATE,IBUNIQ,RETURN) ; Add an entry to the file
; INPUT:
; IBDFN - Pointer to the patient number
; IBSITE - external site number
; IBVISDT - Visit date
; IBSTAT - Status
; IBBILL - Bill number or possibly free text description such as 'ONHOLD'
; IBCOMM - Cancel reason
; IBUPDATE - 1 if this is the originating site and data should be pushed out to other treating facilities, otherwise 0
; IBUNIQ - Unique ID consiting of external site number underscor ien of file 351.82 on originating site ex. 442_1234567
; OUTPUT:
; RETURN - This is any information returned by FileMan if update was unsuccessful
;
; Function call returns 0 or 1 if successful.
; data must be all internal or all external - no mashup of the two allowed
; I vote internal and since I am coding...
; the incoming parameters were all internal except site #.
; NOTE to self: internal data is filed without validation so be sure it's cool
;
N IBCTS,IBMAXFR
S IBMAXFR=3 ; max free visits in a calendar year
S IBCTS=$$GETVST^IBECEA36(IBDFN,IBVISDT)
I $G(IBSTAT)=1,$P(IBCTS,U,2)'<IBMAXFR D Q 0
. N Y
. S Y=IBVISDT X ^DD("DD")
. S RETURN="Exceeds MAX free visits in a calendar year. Can't add "_Y_"."
;
N FDA,IENS
S IENS="+1,"
S FDA(351.82,IENS,.01)=IBDFN
S FDA(351.82,IENS,.02)=$$FIND1^DIC(4,,"X",IBSITE,"D") ; turn external site # into internal one
S FDA(351.82,IENS,.03)=IBVISDT
S FDA(351.82,IENS,.04)=$G(IBSTAT)
S FDA(351.82,IENS,.05)=$G(IBBILL)
S FDA(351.82,IENS,.06)=$G(IBCOMM)
S FDA(351.82,IENS,.07)=$G(IBUNIQ)
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.
;
; first parameter is currently "" so internal it is for now
D UPDATE^DIE("","FDA","","RETURN")
;
; if RETURN is defined then BAD else GOOD
Q $S($D(RETURN):0,1:1)
;
UPDATE(IBIEN,IBSTAT,IBBILL,IBCOMM,IBUPDATE,RETURN) ; update an entry to the file
; INPUT:
; IBIEN - internal entry number into 351.82 that is being edited
; IBSTAT - Status
; IBBILL - Bill number or possibly free text description such as 'ONHOLD'
; IBCOMM - Cancel reason
; IBUPDATE - 1 if this is the originating site and data should be pushed out to other treating facilities, otherwise 0
; OUTPUT:
; RETURN - This is any information returned by FileMan if update was unsuccessful
;
; Function call returns 0 or 1 if successful.
;
; limiting edits to a few fields
; data must be all internal or all external - no mashup of the two allowed
; I still vote internal and since I am still coding...
; the incoming parameters were all internal
; NOTE to self: internal data is filed without validation so be sure it's cool
;
; returns 1 if added sucessfully
; returns 0 otherwise
;
N IBCTS,IBMAXFR,IBDFN,IBVISDT
S IBDFN=$$GET1^DIQ(351.82,IBIEN,.01,"I")
S IBVISDT=$$GET1^DIQ(351.82,IBIEN,.03,"I")
S IBMAXFR=3 ; max free visits in a calendar year
S IBCTS=$$GETVST^IBECEA36(IBDFN,IBVISDT)
I $G(IBSTAT)=1,$P(IBCTS,U,2)'<IBMAXFR D Q 0
. N Y
. S Y=IBVISDT X ^DD("DD")
. S RETURN="Exceeds MAX free visits in a calendar year. Can't update "_Y_"."
;
N FDA,IENS
S IENS=IBIEN_","
S FDA(351.82,IENS,.04)=$G(IBSTAT)
S FDA(351.82,IENS,.05)=$G(IBBILL)
S FDA(351.82,IENS,.06)=$G(IBCOMM)
S FDA(351.82,IENS,1.01)=$G(IBUPDATE,0)
;
; first parameter is currently "" so internal it is for now
D FILE^DIE("","FDA","RETURN")
;
; if RETURN is defined then BAD else GOOD
Q $S($D(RETURN):0,1:1)
;
PULL(RETURN,IBFAC,IBSITE,IBICN,IBOSITEEX) ; Pull all records that originated at this site for this patient
; RETURN - array
; IBFAC - this site internal
; IBSITE - this site external
; IBICN - Patient being pulled
; IBOSITEEX - Requesting site
;
N IBIEN4,IBDFN,IBSCREEN,IBDATA,IBLOOP,IBADD,IBRESULTS
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.
I 'IBIEN4 S @RETURN@(1)="-1^Site# "_IBOSITEEX_" not found in INSTITUTION (#4) file lookup at site# "_IBSITE Q
;
; make sure the patient is identifiable from this ICN
; if not, not much I can do
S IBDFN=+$$DFN^IBARXMU($G(IBICN))
I 'IBDFN S @RETURN@(1)="-1^Patient ICN: "_IBICN_" not found at site# "_IBSITE Q
;
; Get all/only the records for the patient which originated at this site.
;WCJ;IB696
;S IBSCREEN="I $P(^(0),U,2)=IBFAC"
S IBSCREEN="I $P(^(0),U,2)="_$$IEN^XUAF4(IBSITE)
;
;WCJ;IB696;add the date patient added to the patient file
;DBIA#10053-allows IB to read this field in patient File with FileMan
;D FIND^DIC(351.82,"",".01;.02:99;.03I;.04I;.05;.06I;.07I;1.01I;.01:991.1;.08","QEP",IBDFN,"","B",IBSCREEN)
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)
;
I '+$G(^TMP("DILIST",$J,0)) D Q
. N IBLN,IBL4
. S IBLN=$P($$GET1^DIQ(2,IBDFN,.01),",",1) ; last name
. S IBL4=$$GET1^DIQ(2,IBDFN,.09),IBL4=$E(IBL4,$L(IBL4)-3,9999) ; last 4
. S @RETURN@(1)="0^No records to pull for patient "_IBLN_" ("_IBL4_") at site# "_IBSITE
;
; sent all the records for this patient created by this facility
M @RETURN=^TMP("DILIST",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEA38 11665 printed Apr 09, 2024@21:08:57 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;; DBIA#1621 %ZTER (ERROR RECORDING)
+4 ;; DBIA#10053 grab field .097 from file 2
+5 GOTO AWAY
+6 ;
AWAY ;thought I was being figurative??? Guess again!
QUIT
+1 ;
+2 ; RPC endpoint
+3 ; this is where the RPC is actually called at the remote facility.
RETURN(IBR,IBICN,IBOSITEEX,IBVISDT,IBSTAT,IBBILL,IBCOMM,IBUNIQ,IBELGRP) ;
+1 ;
+2 ; INPUT:
+3 ; IBR - Results go here
+4 ; IBICN - Patients ICN so that we can find the patient across sites
+5 ; IBOSITEEX - external site number
+6 ; IBVISDT - Visit date
+7 ; IBSTAT - Status
+8 ; IBBILL - Bill number or possibly free text description such as 'ONHOLD'
+9 ; IBCOMM - Cancel reason
+10 ; IBUPDATE - 1 if this is the originating site and data should be pushed out to other treating facilities, otherwise 0
+11 ; IBUNIQ - Unique ID consiting of external site number underscor ien of file 351.82 on originating site ex. 442_1234567
+12 ; IBELGRP - Eligibity Group coming in - must match receiving system
+13 ; OUTPUT:
+14 ; results are returned in the results array as described in INPUT section
+15 ; "-1^Error message"
+16 ; "0^No action taken (nor needed) message"
+17 ; "1^Success message"
+18 ;
+19 ; ADDITIONAL OUTPUT on PULL - all records for a patient in file 351.82 that were created at this facility
+20 ;
+21 ; 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.
+22 ; 2) if it's already there, see if anything changed (might be an update).
+23 ; 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.
+24 ; b) if already there but allowable fields being updated, then do so, let them know, and quitely ride off into the sunset.
+25 ; 3) If you got this far, add it to the file.
+26 ; 4) return something to let them know how you did
+27 ;
+28 ; didn't think I would need, but...
IF '$DATA(IBR)
SET IBR=$NAME(^TMP("IBECEA37",$JOB))
+29 ;
+30 NEW IBDFN,IBSCREEN,IBIEN4,IBDATA,IBIEN351P82,IBADDED,IBUPDATED,IBRETURN,IBMISS,IBFAC,IBSITE
+31 ; returns IBSITE (external) and IBFAC (internal may not be VAMC)
DO SITE^IBAUTL
+32 ;
+33 ; see if it's a pull for specific patient. It will only have the patient's ICN and the site it's pulling to
+34 IF '$DATA(IBVISDT)
IF '$DATA(IBSTAT)
IF '$DATA(IBBILL)
IF '$DATA(IBCOMM)
IF '$DATA(IBUNIQ)
IF $GET(IBICN)
IF $GET(IBOSITEEX)
Begin DoDot:1
+35 DO PULL(.IBR,IBFAC,IBSITE,IBICN,IBOSITEEX)
+36 QUIT
End DoDot:1
QUIT
+37 ;
+38 ; Make sure everything needed is here. Better doublecheck on what is needed.
+39 SET IBMISS=$SELECT('$DATA(IBICN):1,'$DATA(IBOSITEEX):2,'$DATA(IBVISDT):3,'$DATA(IBSTAT):4,'$DATA(IBBILL):5,'$DATA(IBCOMM):6,'$DATA(IBUNIQ):7,'$DATA(IBELGRP):8,1:0)
+40 IF IBMISS
SET @IBR@(1)="-1^Missing required input parameter: "_$PIECE("IBICN.IBOSITEEX.IBVISDT.IBSTAT.IBBILL.IBCOMM.IBUNIQ.IBELGRP",".",IBMISS)
QUIT
+41 ;
+42 IF IBOSITEEX=IBSITE
SET @IBR@(1)="0^No action performed. Current site# "_IBSITE_" equals originating site# "_IBOSITEEX
QUIT
+43 ;
+44 ; get the internal site number (File 4 IEN) - should be the same across sites but then again shouldn't have to.
SET IBIEN4=$$FIND1^DIC(4,,"X",IBOSITEEX,"D")
+45 IF 'IBIEN4
SET @IBR@(1)="-1^Site# "_IBOSITEEX_" not found in INSTITUTION (#4) file lookup"
QUIT
+46 ;
+47 ; make sure the patient is identifiable from this ICN
+48 ; if not, not much I can do
+49 SET IBDFN=+$$DFN^IBARXMU($GET(IBICN))
+50 IF 'IBDFN
SET @IBR@(1)="-1^Patient ICN: "_IBICN_" not found at site# "_IBSITE
QUIT
+51 ;
+52 ;WCJ;IB696,if the visit date is before the patient was added to this system don't care about the eligibility group check
+53 ;DBIA#10035-support ICR to read this patient file field
+54 ;I $$GETELGP^IBECEA36(IBDFN,IBVISDT)'=IBELGRP D Q
+55 IF $$GETELGP^IBECEA36(IBDFN,IBVISDT)'=IBELGRP
IF $SELECT('$$GET1^DIQ(2,IBDFN,.097,"I"):1,IBVISDT<$$GET1^DIQ(2,IBDFN,.097,"I"):0,1:1)
Begin DoDot:1
+56 NEW Y
SET Y=IBVISDT
XECUTE ^DD("DD")
+57 SET @IBR@(1)="-1^Patient's eligibility group differs between sites for date of service "_Y_"."
+58 SET @IBR@(2)="-1^Site# "_IBSITE_" = "_$$GETELGP^IBECEA36(IBDFN,IBVISDT)
+59 SET @IBR@(3)="-1^Site# "_IBOSITEEX_" = "_IBELGRP
+60 QUIT
End DoDot:1
QUIT
+61 ;
+62 ;D FIND^DIC(file[,iens][,fields][,flags],[.]value[,number][,[.]indexes][,[.]screen][,identifier][,target_root][,msg_root]) ; this line is just for reference
+63 ;
+64 ; this sets the screen for the FIND call.
+65 ; FIND is by IBUNIQ (the unique ID consisting of the external site # and the the IEN to file 351.82 at that site.
+66 ; It if finds one, it's a potential edit and we will deal with that.
+67 ; 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.
+68 ;
+69 DO FIND^DIC(351.82,"",".01;.02:99;.03I;.04I;.05;.06I;.07I;1.01I","QEPX",IBUNIQ,"","AUID")
+70 ;
+71 ; found one - see if anything changed and update if needed
+72 ; now what can really change - IBSTAT, IBBILL, IBCOMM are only fields allowed to change
+73 IF +$GET(^TMP("DILIST",$JOB,0))=1
Begin DoDot:1
+74 SET IBDATA=$GET(^TMP("DILIST",$JOB,1,0))
+75 SET IBIEN351P82=+IBDATA
+76 IF $PIECE(IBDATA,U,6)=IBSTAT
IF $PIECE(IBDATA,U,7)=IBBILL
IF $PIECE(IBDATA,U,8)=IBCOMM
SET @IBR@(1)="0^No changes requested"
QUIT
+77 SET IBUPDATED=$$UPDATE(IBIEN351P82,IBSTAT,IBBILL,IBCOMM,1,.IBRETURN)
+78 IF 'IBUPDATED
Begin DoDot:2
+79 SET @IBR@(1)="-1^Unable to UPDATE record at site# "_IBSITE_"."
+80 if IBRETURN["MAX free"
SET @IBR@(2)=-1_U_IBRETURN
End DoDot:2
QUIT
+81 SET @IBR@(1)="1^successfully updated"
QUIT
+82 QUIT
End DoDot:1
QUIT
+83 ;
+84 ; found "many" (could be two or a jillion). Should not happen now that we add a unique identifier (KEYWORDS: should + not + unique)
+85 IF +$GET(^TMP("DILIST",$JOB,0))>1
Begin DoDot:1
+86 SET @IBR@(1)="-1^Could not uniquely identify entry being updated - more than one match. Originating site# "_$PIECE(IBUNIQ,"_")_" and IEN:"_$PIECE(IBUNIQ,"_",2)
QUIT
End DoDot:1
QUIT
+87 ;
+88 ; no matches, feel free to add one
+89 IF '$GET(^TMP("DILIST",$JOB,0))
Begin DoDot:1
+90 SET IBADDED=$$ADD(IBDFN,IBOSITEEX,IBVISDT,IBSTAT,IBBILL,IBCOMM,0,IBUNIQ,.IBRETURN)
+91 IF 'IBADDED
Begin DoDot:2
+92 SET @IBR@(1)="-1^Unable to ADD record at site# "_IBSITE_"."
+93 if IBRETURN["MAX free"
SET @IBR@(2)=-1_U_IBRETURN
End DoDot:2
QUIT
+94 SET @IBR@(1)="1^successfully added"
QUIT
+95 QUIT
End DoDot:1
QUIT
+96 QUIT
+97 ;
ADD(IBDFN,IBSITE,IBVISDT,IBSTAT,IBBILL,IBCOMM,IBUPDATE,IBUNIQ,RETURN) ; Add an entry to the file
+1 ; INPUT:
+2 ; IBDFN - Pointer to the patient number
+3 ; IBSITE - external site number
+4 ; IBVISDT - Visit date
+5 ; IBSTAT - Status
+6 ; IBBILL - Bill number or possibly free text description such as 'ONHOLD'
+7 ; IBCOMM - Cancel reason
+8 ; IBUPDATE - 1 if this is the originating site and data should be pushed out to other treating facilities, otherwise 0
+9 ; IBUNIQ - Unique ID consiting of external site number underscor ien of file 351.82 on originating site ex. 442_1234567
+10 ; OUTPUT:
+11 ; RETURN - This is any information returned by FileMan if update was unsuccessful
+12 ;
+13 ; Function call returns 0 or 1 if successful.
+14 ; data must be all internal or all external - no mashup of the two allowed
+15 ; I vote internal and since I am coding...
+16 ; the incoming parameters were all internal except site #.
+17 ; NOTE to self: internal data is filed without validation so be sure it's cool
+18 ;
+19 NEW IBCTS,IBMAXFR
+20 ; max free visits in a calendar year
SET IBMAXFR=3
+21 SET IBCTS=$$GETVST^IBECEA36(IBDFN,IBVISDT)
+22 IF $GET(IBSTAT)=1
IF $PIECE(IBCTS,U,2)'<IBMAXFR
Begin DoDot:1
+23 NEW Y
+24 SET Y=IBVISDT
XECUTE ^DD("DD")
+25 SET RETURN="Exceeds MAX free visits in a calendar year. Can't add "_Y_"."
End DoDot:1
QUIT 0
+26 ;
+27 NEW FDA,IENS
+28 SET IENS="+1,"
+29 SET FDA(351.82,IENS,.01)=IBDFN
+30 ; turn external site # into internal one
SET FDA(351.82,IENS,.02)=$$FIND1^DIC(4,,"X",IBSITE,"D")
+31 SET FDA(351.82,IENS,.03)=IBVISDT
+32 SET FDA(351.82,IENS,.04)=$GET(IBSTAT)
+33 SET FDA(351.82,IENS,.05)=$GET(IBBILL)
+34 SET FDA(351.82,IENS,.06)=$GET(IBCOMM)
+35 SET FDA(351.82,IENS,.07)=$GET(IBUNIQ)
+36 ; 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.
SET FDA(351.82,IENS,1.01)=$GET(IBUPDATE)
+37 ;
+38 ; first parameter is currently "" so internal it is for now
+39 DO UPDATE^DIE("","FDA","","RETURN")
+40 ;
+41 ; if RETURN is defined then BAD else GOOD
+42 QUIT $SELECT($DATA(RETURN):0,1:1)
+43 ;
UPDATE(IBIEN,IBSTAT,IBBILL,IBCOMM,IBUPDATE,RETURN) ; update an entry to the file
+1 ; INPUT:
+2 ; IBIEN - internal entry number into 351.82 that is being edited
+3 ; IBSTAT - Status
+4 ; IBBILL - Bill number or possibly free text description such as 'ONHOLD'
+5 ; IBCOMM - Cancel reason
+6 ; IBUPDATE - 1 if this is the originating site and data should be pushed out to other treating facilities, otherwise 0
+7 ; OUTPUT:
+8 ; RETURN - This is any information returned by FileMan if update was unsuccessful
+9 ;
+10 ; Function call returns 0 or 1 if successful.
+11 ;
+12 ; limiting edits to a few fields
+13 ; data must be all internal or all external - no mashup of the two allowed
+14 ; I still vote internal and since I am still coding...
+15 ; the incoming parameters were all internal
+16 ; NOTE to self: internal data is filed without validation so be sure it's cool
+17 ;
+18 ; returns 1 if added sucessfully
+19 ; returns 0 otherwise
+20 ;
+21 NEW IBCTS,IBMAXFR,IBDFN,IBVISDT
+22 SET IBDFN=$$GET1^DIQ(351.82,IBIEN,.01,"I")
+23 SET IBVISDT=$$GET1^DIQ(351.82,IBIEN,.03,"I")
+24 ; max free visits in a calendar year
SET IBMAXFR=3
+25 SET IBCTS=$$GETVST^IBECEA36(IBDFN,IBVISDT)
+26 IF $GET(IBSTAT)=1
IF $PIECE(IBCTS,U,2)'<IBMAXFR
Begin DoDot:1
+27 NEW Y
+28 SET Y=IBVISDT
XECUTE ^DD("DD")
+29 SET RETURN="Exceeds MAX free visits in a calendar year. Can't update "_Y_"."
End DoDot:1
QUIT 0
+30 ;
+31 NEW FDA,IENS
+32 SET IENS=IBIEN_","
+33 SET FDA(351.82,IENS,.04)=$GET(IBSTAT)
+34 SET FDA(351.82,IENS,.05)=$GET(IBBILL)
+35 SET FDA(351.82,IENS,.06)=$GET(IBCOMM)
+36 SET FDA(351.82,IENS,1.01)=$GET(IBUPDATE,0)
+37 ;
+38 ; first parameter is currently "" so internal it is for now
+39 DO FILE^DIE("","FDA","RETURN")
+40 ;
+41 ; if RETURN is defined then BAD else GOOD
+42 QUIT $SELECT($DATA(RETURN):0,1:1)
+43 ;
PULL(RETURN,IBFAC,IBSITE,IBICN,IBOSITEEX) ; Pull all records that originated at this site for this patient
+1 ; RETURN - array
+2 ; IBFAC - this site internal
+3 ; IBSITE - this site external
+4 ; IBICN - Patient being pulled
+5 ; IBOSITEEX - Requesting site
+6 ;
+7 NEW IBIEN4,IBDFN,IBSCREEN,IBDATA,IBLOOP,IBADD,IBRESULTS
+8 ; get the internal site number (File 4 IEN) - should be the same across sites but then again shouldn't have to.
SET IBIEN4=$$FIND1^DIC(4,,"X",IBOSITEEX,"D")
+9 IF 'IBIEN4
SET @RETURN@(1)="-1^Site# "_IBOSITEEX_" not found in INSTITUTION (#4) file lookup at site# "_IBSITE
QUIT
+10 ;
+11 ; make sure the patient is identifiable from this ICN
+12 ; if not, not much I can do
+13 SET IBDFN=+$$DFN^IBARXMU($GET(IBICN))
+14 IF 'IBDFN
SET @RETURN@(1)="-1^Patient ICN: "_IBICN_" not found at site# "_IBSITE
QUIT
+15 ;
+16 ; Get all/only the records for the patient which originated at this site.
+17 ;WCJ;IB696
+18 ;S IBSCREEN="I $P(^(0),U,2)=IBFAC"
+19 SET IBSCREEN="I $P(^(0),U,2)="_$$IEN^XUAF4(IBSITE)
+20 ;
+21 ;WCJ;IB696;add the date patient added to the patient file
+22 ;DBIA#10053-allows IB to read this field in patient File with FileMan
+23 ;D FIND^DIC(351.82,"",".01;.02:99;.03I;.04I;.05;.06I;.07I;1.01I;.01:991.1;.08","QEP",IBDFN,"","B",IBSCREEN)
+24 DO FIND^DIC(351.82,"",".01;.02:99;.03I;.04I;.05;.06I;.07I;1.01I;.01:991.1;.08;.01:.097","QEP",IBDFN,"","B",IBSCREEN)
+25 ;
+26 IF '+$GET(^TMP("DILIST",$JOB,0))
Begin DoDot:1
+27 NEW IBLN,IBL4
+28 ; last name
SET IBLN=$PIECE($$GET1^DIQ(2,IBDFN,.01),",",1)
+29 ; last 4
SET IBL4=$$GET1^DIQ(2,IBDFN,.09)
SET IBL4=$EXTRACT(IBL4,$LENGTH(IBL4)-3,9999)
+30 SET @RETURN@(1)="0^No records to pull for patient "_IBLN_" ("_IBL4_") at site# "_IBSITE
End DoDot:1
QUIT
+31 ;
+32 ; sent all the records for this patient created by this facility
+33 MERGE @RETURN=^TMP("DILIST",$JOB)
+34 QUIT
