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

IBECEAMH.m

Go to the documentation of this file.
  1. IBECEAMH ;EDE/SAB - Cancel/Edit/Add... Mental Health Utilities ; 21-APR-23
  1. ;;2.0;INTEGRATED BILLING;**784**;21-MAR-94;Build 8
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference to FILE #27.11 in ICR #5158
  1. ; Reference to FILE #2 in ICR #7182
  1. ;
  1. ISCDELIG(IBDOS) ;Is the Date of Service allow the bill to be Cleland-Dole Eligible
  1. ; INPUT - IBDOS - Date of Service of the Bill in question or the bill attempting to be created
  1. ; Returns - 0 - Not eligible
  1. ; 1 - Eligible for Cleland-Dole Review
  1. ;
  1. N IBCDEFF,IBCDEND
  1. S IBCDEFF=$$GET1^DIQ(350.9,"1,",71.03,"I")
  1. S IBCDEND=$$GET1^DIQ(350.9,"1,",71.04,"I")+1 ; IBDOS may have a time stamp, so add 1 to ensure bills on the end date are considered eligible.
  1. I (IBDOS'<IBCDEFF),(IBDOS<IBCDEND) Q 1
  1. Q 0
  1. ;
  1. ISCDCANC(IBIEN) ; Check to see if bill is cancellable
  1. ;INPUT - IBIEN The Bill Number
  1. ; Returns - 0 - Not eligible
  1. ; 1 - Eligible for Cleland-Dole Review
  1. ;
  1. ;Initializations
  1. N IBDATA,IBENC,IBSCDIEN,IBSTCD,IBRES,Z
  1. ;
  1. ;Extract the Stop Code
  1. S IBDATA=$G(^IB(IBIEN,0))
  1. S IBSCDIEN=$P(IBDATA,U,20) I 'IBSCDIEN Q 0
  1. S IBSTCD=$$GET1^DIQ(352.5,IBSCDIEN_",",.01,"E")
  1. S IBRES=$$STCDCHK(IBSTCD)
  1. I 'IBRES S Z=$P($P(IBDATA,U,4),";") I $P(Z,":")="409.68" S IBRES=$$CHKST44($P(Z,":",2))
  1. Q IBRES
  1. ;
  1. STCDCHK(IBSTCD) ;Check to see if the stop code is eligible for C-D cancellation.
  1. ;INPUT: IBSTCD - Stop Code associated with the bill.
  1. ; Returns - 0 - Not eligible
  1. ; 1 - Eligible for Cleland-Dole Review
  1. ;
  1. N STCDARY
  1. ;
  1. ; Grab all of the Stop Codes that are automatically eligible for the Cleland-Done Benefit check.
  1. S STCDARY=""
  1. D GETSTCD(.STCDARY)
  1. ;
  1. ; If the stop code passed in to be checked is in the array, the return a 1, otherwise, exit with a 0
  1. Q:$D(STCDARY(IBSTCD)) 1
  1. Q 0
  1. ;
  1. GETSTCD(STCDARY) ; Retrieve the list of Stop codes that are Cleland Dole Eligible
  1. ;INPUT - None
  1. ;OUTPUT - STCDARY - Array of Stop Codes that are Cleland Dole eligible
  1. ;
  1. N LOOP,IBDATA
  1. ;
  1. ; Grab all of the Stop Codes that are automatically eligible for the Cleland-Done Benefit check.
  1. F LOOP=1:1 S IBDATA=$T(STOPCODE+LOOP) Q:$P(IBDATA,";",3)="END" D
  1. . Q:IBDATA="" ;go to next entry No data in Call.
  1. . ;store the stop code into a local arrary
  1. . S STCDARY($P(IBDATA,";",3))=""
  1. Q
  1. ;
  1. STOPCODE ; List of stop codes eligible for Cleland Dole tracking and cancellations
  1. ;;156
  1. ;;157
  1. ;;502
  1. ;;509
  1. ;;510
  1. ;;513
  1. ;;514
  1. ;;516
  1. ;;519
  1. ;;523
  1. ;;524
  1. ;;527
  1. ;;528
  1. ;;533
  1. ;;534
  1. ;;535
  1. ;;536
  1. ;;538
  1. ;;539
  1. ;;542
  1. ;;545
  1. ;;546
  1. ;;550
  1. ;;552
  1. ;;560
  1. ;;562
  1. ;;564
  1. ;;565
  1. ;;566
  1. ;;567
  1. ;;568
  1. ;;573
  1. ;;574
  1. ;;575
  1. ;;576
  1. ;;577
  1. ;;579
  1. ;;582
  1. ;;583
  1. ;;584
  1. ;;596
  1. ;;597
  1. ;;598
  1. ;;599
  1. ;;END
  1. Q
  1. PRCLSCHK(IBPRSCLS) ;Check to see if the Person Class associated with an Outpatient Copay is eligible for Cleland-Dole Tracking and cancellations.
  1. ;INPUT: IBPRSCLS - Person Class associated with a doctor associated with the outpatient bill.
  1. ; Returns - 0 - Not eligible
  1. ; 1 - Eligible for Cleland-Dole Review
  1. ;
  1. N PRSCLARY
  1. ;Get the List of Person Classes
  1. D GETPRCL(.PRSCLARY)
  1. ; If the Person class passed in to be checked is in the array, the return the return value, otherwise, exit with a 0
  1. Q $S($D(PRSCLARY(IBPRSCLS)):1,1:0)
  1. ;
  1. GETPRCL(PRSCLARY) ;
  1. ;INPUT - None
  1. ;OUTPUT - PRSCLARY - Array of Person classes that are Cleland Dole eligible
  1. ;
  1. N LOOP,IBDATA
  1. F LOOP=2:1 S IBDATA=$T(PRSCLS+LOOP) Q:$P(IBDATA,";",3)="END" D
  1. .Q:IBDATA=""
  1. .S PRSCLARY($P(IBDATA,";",4))=""
  1. Q
  1. ;
  1. PRSCLS ; List of Person Classes
  1. ;;Person Class;Class Code
  1. ;;PSYCHIATRIST;V182911
  1. ;;LPMHC;V010205
  1. ;;MFT;V010202
  1. ;;PSYCHOLOGY;V010400
  1. ;;SOCIAL WORK;V010100
  1. ;;END
  1. Q
  1. MHCPTCHK(IBCPT) ;Checks to see if the CPT code is Cleland-Dole eligible for tracking and cancellation
  1. ;INPUT: IBCPT - CPT Code
  1. ; Returns - 0 - Not eligible
  1. ; 1 - Eligible for Cleland-Dole Review
  1. ;
  1. N CPTARY
  1. ;
  1. ; Grab all of the Stop Codes that are automatically eligible for the Cleland-Done Benefit check.
  1. S CPTARY=""
  1. D GETCPT(.CPTARY)
  1. ;
  1. ; If the Person class passed in to be checked is in the array, the return the return value, otherwise, exit with a 0
  1. Q:$D(CPTARY(IBCPT)) 1
  1. Q 0
  1. ;
  1. GETCPT(CPTARY) ; Utility to gather the list of CPT Codes eligible for Cleland Dole Tracking and Cancellation
  1. ;INPUT - None
  1. ;OUTPUT - CPTARY - Array of CPT Codes that are Cleland Dole eligible
  1. ;
  1. N LOOP,IBDATA
  1. ;
  1. F LOOP=1:1 S IBDATA=$T(CPTCODE+LOOP) Q:$P(IBDATA,";",3)="END" D
  1. . Q:IBDATA="" ;go to next entry No data in Call.
  1. . ;store the stop code into a local arrary
  1. . S CPTARY($P(IBDATA,";",3))=""
  1. Q
  1. ;
  1. CPTCODE ; List of CPT Codes that are eligble for Cleland Dole Tracking and copay cancellation
  1. ;;99202
  1. ;;99203
  1. ;;99204
  1. ;;99205
  1. ;;99212
  1. ;;99213
  1. ;;99214
  1. ;;99215
  1. ;;90832
  1. ;;90834
  1. ;;90837
  1. ;;90839
  1. ;;90791
  1. ;;90792
  1. ;;END
  1. Q
  1. ;
  1. NUMVSTCK(DFN,IBDOS) ; Check the DB to for the number of visits in a calendar year for a Veteran
  1. ;
  1. ; INPUT: DFN - Patient IEN CPT Code
  1. ; IBDOS - Date of Service
  1. ; Returns - 0 - All Free Visits used
  1. ; 1 - Free Visits Still Remain
  1. ;
  1. N NUMVST,YR,LP,DATA,VD
  1. ;
  1. S NUMVST=0
  1. ;
  1. S YR=$E(IBDOS,1,3)
  1. ;
  1. S LP=0
  1. F S LP=$O(^IBMH(351.83,"B",DFN,LP)) Q:'LP D Q:NUMVST=3
  1. . ;get the visit entry
  1. . S DATA=$G(^IBMH(351.83,LP,0))
  1. . ;get the visit date
  1. . S VD=$P(DATA,U,3)
  1. . ;If visit prior to the DOS being checked, skip
  1. . I $E(VD,1,3)'=YR Q
  1. . ;If the correct year and the visit was free, update the counter
  1. . I $P(DATA,U,4)=1 S NUMVST=NUMVST+1
  1. ;If the Number of Free Visits is <3 return 1
  1. I NUMVST<3 Q 1
  1. ;Else, return 0
  1. Q 0
  1. ;
  1. ADDVST(DFN,IBDT,IBN,IBSTATUS,IBREAS,IBSITE) ; Update the Visit Tracking DB
  1. ;
  1. ;Input:
  1. ; DFN - (Required) Patient IEN (from file #2)
  1. ; IBDT - (Required) Date of Visit
  1. ; IBN - (Required) Copay IEN (from file #350)
  1. ; IBSTATUS - (Required) Mental Helath Visit Billing Status
  1. ; 1 - FREE
  1. ; 2 - BILLED (i.e. copay was created)
  1. ; 3 - Not Counted (i.e. MH visit was cancelled at the site)
  1. ; 4 - Visit Only (Visit counted, but no bill produced)
  1. ; IBREAS - Code # for the comment
  1. ; IBCMT - Add SC/SA/SV (1) comment if adding a visit for a PG6.
  1. ; IBSITE - (Optional) Site where the copay was charged. Defaults to IBFAC if not passed in.
  1. ;
  1. N FDA,FDAIEN,IBSITE,IBBILL,IBERROR,IBBLSTAT
  1. ;
  1. ;check for a defined site in the copay file
  1. I $G(IBSITE)="" S IBSITE=$$STA^XUAF4($$GET1^DIQ(350,$G(IBN)_",",.13,"I")) S:IBSITE]"" IBSITE=+IBSITE
  1. ;
  1. ;Otherwise, default to IBFAC
  1. ;IBFAC can be an IEN for a child and not the actual facility so it may not be the IEN for the actual site. Pretty sure IBSITE will already be defined
  1. ;but if we need to use IBFAC, let's turn it into a site number
  1. S:$G(IBSITE)="" IBSITE=$$STA^XUAF4(IBFAC)
  1. ;
  1. S IBBILL=$$GET1^DIQ(350,$G(IBN)_",",.11,"E")
  1. S IBREAS=$G(IBREAS)
  1. ;
  1. ;If no Bill Number, check to see if on hold. If so, store ON HOLD
  1. I IBBILL="" D
  1. . S IBBLSTAT=$$GET1^DIQ(350,$G(IBN)_",",.05,"I")
  1. . ; If bill status is 8 (On Hold) then store On Hold as the Bill Number
  1. . I IBBLSTAT=8 s IBBILL="ON HOLD"
  1. ;
  1. ;Call utility to add to DB
  1. D ADD(IBN,DFN,IBSITE,IBDT,IBSTATUS,IBBILL,IBREAS,1,"",.IBERROR)
  1. Q
  1. ;
  1. ADD(IBN,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,IBMAXFR
  1. ;Last chance check to see if all free visits are used up. If so, don't add the visit and exit.
  1. I $G(IBSTAT)=1,'$$NUMVSTCK(IBDFN,IBVISDT) 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,.08)=$G(IBN)
  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. CHKST44(IBOE) ; check stop codes in file 44 for Cleland Dole eligibility
  1. ;
  1. ; IBOE - ien in file 409.68
  1. ;
  1. ; returns 1 if either stop code (44/8) or credit stop code (44/2503) is eligible for C-D, or 0 otherwise.
  1. ;
  1. N FLD,IBLOC,IBSTIEN,IBSTOP,RES
  1. S RES=0
  1. S IBLOC=$$GET1^DIQ(409.68,IBOE,.04,"I")
  1. I IBLOC D
  1. .F FLD=8,2503 D Q:RES
  1. ..S IBSTIEN=$$GET1^DIQ(44,IBLOC,FLD,"I") I IBSTIEN S IBSTOP=$$GET1^DIQ(40.7,IBSTIEN,1) I IBSTOP,$$STCDCHK(IBSTOP) S RES=1
  1. ..Q
  1. .Q
  1. Q RES
  1. ;
  1. CDCHK(IBSTOPDA,IBFR) ;
  1. ; INPUT: IBSTOPDA - Stop Code
  1. ; IBFR - Date of Service
  1. ; Returns - 0 - Not eligible
  1. ; 1 - Eligible
  1. ;
  1. N CDDTCHK,IBSTCHCK
  1. S CDDTCHK=$$ISCDELIG^IBECEAMH(IBFR) ;Date Check Flag
  1. Q:'CDDTCHK 0 ;Exit if not within date range
  1. S IBSTCHCK="" I ($G(IBSTOPDA)'="") S IBSTCHCK=$$STCDCHK^IBECEAMH(IBSTOPDA) ;Stop code check flag, if stop code present
  1. I CDDTCHK,IBSTCHCK Q 1
  1. Q 0
  1. ;
  1. DTCHK(DFN,IBEVDT) ; Checks to see if the copay being cancelled as C-D is in the correct sequence (i.e. 1 of the oldest 3 for the calendar year)
  1. ; INPUT: DFN - Patient
  1. ; IBEVDT - Date of Service
  1. ; Returns - 0 - No sequence issue
  1. ; 1 - Possible sequence issue
  1. ;
  1. N STARTDT,ENDDT,LP,CHK,CT,SQFLG,DATA,VD,STAT
  1. ;
  1. S STARTDT=$E(IBEVDT,1,3)_0000,ENDDT=$E(IBEVDT,1,3)_9999
  1. S LP=0,CHK=1,CT=0,SQFLG=0
  1. ;Loop through the patients entries. Quit if:
  1. ; - None found for the calendar year.
  1. ; - If 3 Free visits found without a sequence issue
  1. ; - a sequence issue is found.
  1. ;
  1. F S LP=$O(^IBMH(351.83,"B",DFN,LP)) Q:'LP D Q:CT=3 Q:SQFLG
  1. . S DATA=$G(^IBMH(351.83,LP,0))
  1. . S VD=$P(DATA,U,3),STAT=$P(DATA,U,4)
  1. . I (IBEVDT<STARTDT)!(IBEVDT>ENDDT) Q ;Not for the calendar year, get the next entry
  1. . I STAT=1 D ;If entry is a free visit, update count and check sequence.
  1. . . S CT=CT+1
  1. . . I IBEVDT<VD S SQFLG=1 ;Event Date is before a Free visit. Possible sequence issue.
  1. Q SQFLG
  1. ;
  1. MESS1 ; Visit cancelled due to Cleland Dole.
  1. W !!,"Under the Cleland-Dole Act of 2022, this visit is free."
  1. Q
  1. ;
  1. MESS2 ; User received their 3 free visits
  1. N IBX
  1. W !!,"Under the Cleland-Dole Act of 2022, this patient has already"
  1. W !,"received their 3 free Mental Health visits for this calendar year."
  1. R !!,?10,"Press any key to continue. ",IBX:DTIME
  1. Q
  1. ;
  1. MESS2A ;User received 3 free visits, but the DoS is prior to one of those free visits.
  1. N IBX
  1. W !!,"Under the Cleland-Dole Act of 2022, this patient has already received"
  1. W !,"3 free visits for this calendar year. This date of service is prior to"
  1. W !,"the previously filed free visits for the calendar year. The free visit"
  1. W !,"sequence should be reviewed for updating or re-billing."
  1. R !!,?10,"Press any key to continue. ",IBX:DTIME
  1. Q
  1. ;
  1. MESS2B ; User received their 3 free visits
  1. W !!,"This visit has been entered into the Mental Health Visit Tracking"
  1. W !,"Database."
  1. Q
  1. ;
  1. MESS3(IBFLG) ;
  1. ;
  1. ;INPUT: IBFLG = 1 - Add No Free Visits remaining verbiage.
  1. ; 0 or NULL - Standard Message
  1. ;
  1. N IBX
  1. S IBFLG=$G(IBFLG)
  1. W !!,"This bill is not eligible for cancellation under the Cleland-Dole Act of 2022"
  1. I IBFLG W !," because no more free visits are available"
  1. W "."
  1. W !,"Please select another cancellation reason."
  1. R !!,?10,"Press any key to continue. ",IBX:DTIME
  1. W !!
  1. Q
  1. ;
  1. OECHK(IBOE,IBEVDT) ;
  1. ; INPUT: IBOE - Outpatient Encounter IEN (from Bill Resulting From field (#350, .04, 2nd ";" piece)
  1. ; IBEVDT - Date of Service
  1. ; Returns - 0 - Encounter Not eligible under Cleland-Dole
  1. ; 1 - Encounter eligible under Cleland-Dole
  1. ;
  1. N IBSDV,ERR,IBLP,RES,IBPRVIEN,IBPRCLS,IBCPTCHK,IBCPTARY,IBLP1,IBCPTCHK
  1. ;
  1. ;gets the list of providers on an encounter
  1. S (IBSDV,ERR)=""
  1. D GETPRV^SDOE(IBOE,"IBSDV","ERR")
  1. Q:$D(ERR)>1 0 ;Errors present
  1. Q:$D(IBSDV)'=11 0 ;No providers found
  1. ;
  1. ;Loop through the providers, check their Person Class. if Person class returns a 1, Encounter is eligible. If it returns a 2, Need to check the CPT codes
  1. S (RES,IBLP)=0
  1. F S IBLP=$O(IBSDV(IBLP)) Q:IBLP="" D Q:RES=1
  1. . S IBCPTARY=""
  1. . ; Get the User IEN of the Provider
  1. . S IBPRVIEN=$P($G(IBSDV(IBLP)),U)
  1. . ; Get the Person Class ID
  1. . S IBPRCLS=$P($$GET^XUA4A72(IBPRVIEN,IBEVDT),U,7) I IBPRCLS="" Q ; person class
  1. . ; Check to see if it is Cleland Dole Eligible
  1. . Q:'$$PRCLSCHK^IBECEAMH(IBPRCLS) ; Provider is not Cleland-Dole eligible.
  1. . ;Provider can potentially make the encounter Cleland Dole Eligible if a C-D eligible CPT code is used. Check the CPT code.
  1. . D GETPCECP^IBOMHC(IBOE,.IBCPTARY)
  1. . S IBLP1="",IBCPTCHK=0
  1. . ;Loop through the CPT codes. If a C-D eligible CPT code is found on the encounter, quit.
  1. . F S IBLP1=$O(IBCPTARY(IBLP1)) Q:IBLP1="" S IBCPTCHK=$$MHCPTCHK(IBLP1) I IBCPTCHK S RES=1 Q
  1. . K IBCPTARY
  1. Q RES
  1. ;
  1. UPMHDB(DFN,IBDOS) ; Update the MH Visit Tracking DB if the Cancellation Reason is usable on MH copays
  1. ;
  1. N IBNOFRVS
  1. ;
  1. ;Retrieve # visits
  1. S IBNOFRVS=$$NUMVSTCK(DFN,IBDOS)
  1. ;
  1. ;If free visit remain, convert visit to Free Visit
  1. I IBNOFRVS<3 D UPDVST(3) Q
  1. ;
  1. ;Otherwise, visit only.
  1. D UPDVST(2)
  1. ;
  1. Q
  1. ;
  1. UPDVST(IBN,IBCAN,IBVSTIEN) ; update the Visit Tracking file
  1. ;
  1. ;INPUT - IBCAN - Type of Update to perform
  1. ; 1 - Remove with Entered in Error Message
  1. ; 2 - Visit Only Update
  1. ; 3 - Free (if free not used) or Visit Only
  1. ; 4 - Remove with Duplicate Error message
  1. ;
  1. N IBSTAT,IBREAS,IBRTN,IBERROR
  1. I $G(IBCAN)'>0 Q
  1. S IBERROR=""
  1. S IBVSTIEN=$G(IBVSTIEN,0) I 'IBVSTIEN S IBVSTIEN=+$O(^IBMH(351.83,"D",IBN,""))
  1. I IBVSTIEN=0 D Q
  1. .W !!,"Unable to locate the bill in the Mental Health Visit Tracking Database"
  1. .W !,"for this veteran. Please review and update the Mental Health Visit "
  1. .W !,"Tracking Maintenance Utility.",!
  1. .Q
  1. ;
  1. ;Set Status and Reason based on update type.
  1. S:IBCAN=1 IBREAS=3,IBSTAT=3 ;Visits Removed
  1. S:IBCAN=2 IBREAS=5,IBSTAT=4 ;Visit set to Visit Only
  1. S:IBCAN=3 IBREAS=1,IBSTAT=1 ;Free visit
  1. S:IBCAN=4 IBREAS=4,IBSTAT=3 ;Duplicate Visit
  1. ;
  1. S IBRTN=$$UPDATE(0,IBVSTIEN,IBSTAT,"",IBREAS,1,.IBERROR)
  1. ;
  1. Q
  1. ;
  1. FNDVST(IBBLNO,IBVSTDT,IBN) ; Locate the Visit IEN
  1. ;
  1. N IBVSTIEN,IBVSTD,IBFOUND
  1. S IBVSTIEN=0,IBFOUND=0
  1. F S IBVSTIEN=$O(^IBMH(351.83,"C",IBBLNO,IBVSTIEN)) Q:IBVSTIEN="" D Q:IBFOUND=1
  1. . S IBVSTD=$G(^IBMH(351.83,IBVSTIEN,0))
  1. . I (IBVSTDT=$P(IBVSTD,U,3)),(IBN=$P(IBVSTD,U)) S IBFOUND=1
  1. Q +IBVSTIEN
  1. ;
  1. UPDATE(IBNP,IBIEN,IBSTAT,IBBILL,IBCOMM,IBUPDATE,RETURN) ; update an entry to the file
  1. ; INPUT:
  1. ; IBNP - Flag for processing type
  1. ; 1 = Nightly Process
  1. ; 0 or NULL = Manual Update (IB CANCEL/EDIT/ADD, MH Visit Maintenance,etc.)
  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,IBY,IBDOS
  1. S IBDFN=$$GET1^DIQ(351.83,IBIEN,.01,"I")
  1. S IBDOS=$$GET1^DIQ(351.83,IBIEN,.03,"I")
  1. S IBVISDT=$$GET1^DIQ(351.83,IBIEN,.03,"I")
  1. ;S IBMAXFR=3 ; max free visits in a calendar year
  1. ;S IBCTS=$$GETVST^IBECEA36(IBDFN,IBVISDT)
  1. S IBCTS=$$NUMVSTCK(IBDFN,IBDOS),IBY=0
  1. I $G(IBSTAT)=1,'IBCTS D Q:IBY<0
  1. . I IBNP D
  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. . . S IBY=-1
  1. . ;CHECK WITH USER OR AUTO CHANGE TO vISIT ONLY - currently auto change to visit only
  1. . S IBSTAT=4
  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. ASKMH() ; Mental Health visit (Cleland - Dole) confirmation prompt
  1. ;
  1. ; returns 1 for "yes", 0 for "no", or -1 for user exit / timeout
  1. ;
  1. N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
  1. W !
  1. S DIR("A")="Is this visit covered under the Cleland Dole Act? (Y/N): "
  1. S DIR(0)="YA"
  1. D ^DIR
  1. I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
  1. Q $S(+Y=1:1,1:0)
  1. ;
  1. ASKCONT() ; "do you wish to continue" confirmation prompt
  1. ;
  1. ; returns 1 for "yes", 0 for "no", or -1 for user exit / timeout
  1. ;
  1. N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
  1. W !
  1. S DIR("A")="Do you wish to continue? (Y/N): "
  1. S DIR(0)="YA"
  1. D ^DIR
  1. I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
  1. Q $S(+Y=1:1,1:0)