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 Dec 13, 2024@02:21:29 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)
