- 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 Jan 18, 2025@03:22:36 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