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