IBAECN1 ;WOIFO/SS-LTC PHASE 2 NIGHTLY JOB ; 20-FEB-02
;;2.0;INTEGRATED BILLING;**176,188**;21-MAR-94
;; Per VHA Directive 10-93-142, this routine should not be modified.
;
BILDATE() ;billing start date for Long Term Care Billing
; Means Test for LTC care billing stopped on JUNE 17,2002 /see
; STDATE^IBAECU1()/ . LTC billing for LTC care must start on
; JULY 26,2002. There is no billing for LTC care in period
; between JUNE 17,2002 and JULY 26,2002. That means LTC clock
; will start on JULY 5,2002 (because of 21 "free" days)
Q 3020705 ;
;
NJ ;LTC Nightly job
N X I $D(^%ZOSF("TRAP")) S X="ERR^IBAECN1",@^("TRAP")
N IBPRMNTH S IBPRMNTH=$$PREVMNTH^IBAECM1() ;last day of previous month
Q:$$BILDATE()>IBPRMNTH
;
N IBLSTMJ S IBLSTMJ=$$LASTMJ^IBAECU()
;run code for the 1st monthly job
I IBLSTMJ=0 D MJ1ST^IBAECM3 Q
;if was run & successfully completed this month- quit
Q:IBLSTMJ'<($E($$TODAY(),1,5)_"01")
;------- local arrays
;IBMDS1(0)-1st,IBMDS1(1) last day in the month,
;IBMDS1(2)-year_month, IBMDS1 - number of days
N IBMDS1 S IBMDS1=""
;dates,days for processing month which is normally
; previous month because MJ runs 1stday of the month
S IBMDS1(1)=IBPRMNTH,IBMDS1(2)=$E(IBMDS1(1),1,5)
S IBMDS1(0)=IBMDS1(2)_"01",IBMDS1=$E(IBMDS1(1),6,7)
D MJT^IBAECM1
D RESET
Q
;
ERR ;Error trap for NJ
N XMSUB,XMTEXT,XMY,XMZ,XMMG,IBL,IBT,XMDUZ,IBPAT,IBTODAY
N XMGROUP S XMGROUP=$$GET1^DIQ(350.9,"1,",.09)
Q:XMGROUP=""
S XMGROUP="G."_XMGROUP
S IBPAT="Unknown",IBTODAY=""
N Y D NOW^%DTC S Y=% X ^DD("DD") S IBTODAY=Y
I +$G(DFN)>0 D
. N VADM,VA,VAERR
. D DEM^VADPT
. S IBPAT=$G(VADM(1))_", SSN: "_$P($G(VADM(2)),"^",2)
S:IBPAT=", SSN: " IBPAT="Unknown"
S XMSUB="LTC Monthly Job Failure",XMY(XMGROUP)=""
S XMTEXT="IBT(",XMDUZ="INTEGRATED BILLING PACKAGE"
S IBT(1,0)="**********************************************"
S IBT(2,0)="LTC Monthly Job crashed on "_IBTODAY
S IBT(3,0)="when the system was processing the following patient : "
S IBT(4,0)=" "_IBPAT
S IBT(5,0)="Please verify data for the patient, fix findings"
S IBT(6,0)="and then:"
S IBT(7,0)="- if today is the last day of the month then you"
S IBT(8,0)=" need to run NJ^IBAECN1 today manually from"
S IBT(9,0)=" programmer mode."
S IBT(10,0)="- otherwise let the system run the NJ^IBAECN1"
S IBT(11,0)=" automatically after midnight."
S IBT(12,0)=""
S IBT(13,0)="In both cases, please, check patient's charges and"
S IBT(14,0)="your e-mail again."
D ^XMD
Q
;
;checks if the most recent treating specialty of the admission
;is related to LTC?
;invoked from PROC^IBAMTC Exmpl:
; I $$ISLTCADM(DFN,IBA)
;to create entries in 351.81 if necessary
;Input:
;IBDFN - patient's ien in file (#2)
;IB405 - ien of admission (#405)
;Output:
;returns 0 if the specialty for non-LTC care
;otherwise - returns 1
;
ISLTCADM(IBDFN,IB405) ;
;1) treat all LTC as Means Test if the legislation is not effective yet
I $$YESTRDAY()<$$BILDATE() Q 0
N IBSPEC,IBTS
S IBTS="M"
;2) determine treating specialty (TS)
S IBSPEC=$$LASTTS(IBDFN,IB405) ;most recent TS (pointer #42.4)
I IBSPEC>0 S IBTS=$P($$TREATSP^IBAECU2(IBSPEC),"^",1) ;is it LTC or not?
I IBSPEC'>0 S IBTS="M" ;treat unknown as Means Test
I IBTS="L" D Q 1 ;if TS is LTC
. I $$CLOCK^IBAECU(IBDFN,$$YESTRDAY())
Q 0
;finds the most recent parent entry in #350 related to admission
;Input:
;IBDFN - patient's dfn
;IBDT - the date to seek from (today)
;IBADM - admission we are seeking for
;IBSTAT = status we are seeking for
;output:
;returns ien_of_350^IB_action_type
;or "0^" if not found
FIND350(IBDFN,IBDATE,IBADM,IBSTAT) ;
N IB350,IBDT,IBINF,IBFL
S IBFL=0,IBINF=""
S IBDT=-IBDATE F S IBDT=$O(^IB("AFDT",IBDFN,IBDT)) Q:IBFL!(+IBDT=0) D
. S IB350=0 F S IB350=$O(^IB("AFDT",IBDFN,IBDT,IB350)) Q:+IB350=0 D
. . Q:'$D(^IB("AC",IBSTAT,IB350))
. . S IBINF=$G(^IB(IB350,0))
. . Q:IB350'=$P(IBINF,"^",16) ;non parent
. . Q:$P($P(IBINF,"^",4),":",1)'="405" ;non inpatient
. . S:$P($P(IBINF,"^",4),":",2)=IBADM IBFL=IB350
Q IBFL_"^"_$P($G(IBINF),"^",3)
;
;edit #350 event entry
;IBIENCL - ien of #350
;IBLSTDT = DATE LAST BILLED
;IBADM - ien in #405
STAT350(IBIENCL,IBLSTDT,IBADM) ;
N IBIENS,IBFDA,IBERR,IBDFN1
S IBDFN1=$P($G(^IB(IBIENCL,0)),"^",2)
Q:+IBDFN1=0
S IBIENS=IBIENCL_"," ; "D0,"
S IBFDA(350,IBIENS,13)=+$G(DUZ)
S:'$P($G(^IB(IBIENCL,0)),"^",17) IBFDA(350,IBIENS,.17)=(+$G(^DGPM(IBADM,0)))\1
S IBFDA(350,IBIENS,.18)=(+$G(IBLSTDT))\1
D NOW^%DTC S IBD=%
S IBFDA(350,IBIENS,14)=IBD
D FILE^DIE("","IBFDA","IBERR")
I $D(IBERR) D
. D ERRLOG^IBAECU5(+$G(IBDFN1),+$G(IBIENCL),"BILLING ACTION:","closing parent entry"_$G(IBERR("DIERR",1,"TEXT",1)))
Q
;------
;create a new inpatient parent event entry in #350
;Input:
;DFN - patient's ien #2
;IBADMIEN - admission ien #405
;IBEVDT - event date (piece 17) for parent entry must be an admission date,
;IBNH:
; 1 - for 56 (#350.1) NHCU ADMISSION
; 93 - for 93 (#350.1) LTC ADMISSION
; 0 - all other events
;Returns:
;New ien of #350 Or 0 if not created
CREV350(DFN,IBADMIEN,IBEVDT,IBNH) ;
Q:IBEVDT=0 0
N IBEVDA,IBSL,IBSERV
S IBEVDA=0
D SERV^IBAUTL2
I '$D(IBSITE)!('$D(IBFAC)) D SITE^IBAUTL
S IBSL="405:"_IBADMIEN
;if LTC ADMISSION set IBNHLTC
I IBNH=93 N IBNHLTC S IBNHLTC=93
D EVADD^IBAUTL3
Q IBEVDA
;
;Find original admission ien, considering ASIH movements
;Input: ien of 405 that can be "child", for example
; we have ien of Nursing Home admission
; then patient moved to ASIH to hospital
; if IBA is ASIH hospital admission ien then call will return
; "original" Nursing Home admission's ien
;Output: ien of 405 of "original" admission
ORIGADM(IBA) ;
N X,Y,Z S Z=IBA
F S X=$G(^DGPM(Z,0)),Y=$P(X,"^",21) Q:Y="" S Z=+$P($G(^DGPM(Y,0)),"^",14)
Q +Z
;
;most recent treating specialty
;input:
;IBDFN - patient ien
;IB405ADM - admission's #405 ien
;output:
;returns ien of SPECIALTY FILE (#42.4)
LASTTS(IBDFN,IB405ADM) ;
N IBDT6,IBSPEC
S IBDT6=0
S IBDT6=+$O(^DGPM("ATS",IBDFN,IB405ADM,IBDT6))
Q:+IBDT6=0 -1 ;error
S IBSPEC=$O(^DGPM("ATS",IBDFN,IB405ADM,IBDT6,0))
Q:+IBSPEC=0 -1 ;error
;convert fac spec (45.7) -> treat spec (#42.4)
S IBSPEC=+$P($G(^DIC(45.7,IBSPEC,0)),"^",2)
Q:+IBSPEC=0 -1
Q IBSPEC
;returns today date
TODAY() ;
N X
D NOW^%DTC
Q X
;returns yesterday date
YESTRDAY() ;
N X1,X2,X
S X1=$$TODAY()
S X2=-1
D C^%DTC
Q X
;returns 1 if the most recent treating specialty for this billable
;event and for this date was LTC
;DFN -patient ien
;IBEVDA - ien of event in #350
;IBDT - date
ASIHORG(DFN,IBEVDA,IBDT) ;
N IB405 S IB405=+$P($P($G(^IB(+IBEVDA,0)),"^",4),":",2)
Q:IB405=0 0
Q $$ISLTC4DT(DFN,IB405,IBDT_.2359)
;
;returns 1 if the most recent treating specialty for the admission
;and the date was LTC specialty
;otherwise returns 0 or -1
;DFN -patient ien
;IB405ADM - ien of #405
;IBDT - date
ISLTC4DT(IBDFN,IB405ADM,IBDT) ;
N IBDT6,IBSPEC,IBTS
S IBDT6=9999999.9999999-IBDT
S IBDT6=+$O(^DGPM("ATS",IBDFN,IB405ADM,IBDT6))
Q:+IBDT6=0 -1 ;error
S IBSPEC=$O(^DGPM("ATS",IBDFN,IB405ADM,IBDT6,0))
Q:+IBSPEC=0 -1 ;error
;convert fac spec (45.7) -> treat spec (#42.4)
S IBSPEC=+$P($G(^DIC(45.7,IBSPEC,0)),"^",2)
I IBSPEC>0 S IBTS=$P($$TREATSP^IBAECU2(IBSPEC),"^",1) ;is it LTC or not?
I IBSPEC'>0 S IBTS="M" ;unknown as Means Test
I IBTS="L" Q 1 ;if TS is LTC
Q 0
;
RESET ; this will reset the ^xtmp global
K ^XTMP("IB1010EC")
S ^XTMP("IB1010EC",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^LIST OF PATIENTS ALREADY REPORTED AS MISSING 1010EC INFO"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAECN1 7754 printed Apr 09, 2024@21:10:12 Page 2
IBAECN1 ;WOIFO/SS-LTC PHASE 2 NIGHTLY JOB ; 20-FEB-02
+1 ;;2.0;INTEGRATED BILLING;**176,188**;21-MAR-94
+2 ;; Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
BILDATE() ;billing start date for Long Term Care Billing
+1 ; Means Test for LTC care billing stopped on JUNE 17,2002 /see
+2 ; STDATE^IBAECU1()/ . LTC billing for LTC care must start on
+3 ; JULY 26,2002. There is no billing for LTC care in period
+4 ; between JUNE 17,2002 and JULY 26,2002. That means LTC clock
+5 ; will start on JULY 5,2002 (because of 21 "free" days)
+6 ;
QUIT 3020705
+7 ;
NJ ;LTC Nightly job
+1 NEW X
IF $DATA(^%ZOSF("TRAP"))
SET X="ERR^IBAECN1"
SET @^("TRAP")
+2 ;last day of previous month
NEW IBPRMNTH
SET IBPRMNTH=$$PREVMNTH^IBAECM1()
+3 if $$BILDATE()>IBPRMNTH
QUIT
+4 ;
+5 NEW IBLSTMJ
SET IBLSTMJ=$$LASTMJ^IBAECU()
+6 ;run code for the 1st monthly job
+7 IF IBLSTMJ=0
DO MJ1ST^IBAECM3
QUIT
+8 ;if was run & successfully completed this month- quit
+9 if IBLSTMJ'<($EXTRACT($$TODAY(),1,5)_"01")
QUIT
+10 ;------- local arrays
+11 ;IBMDS1(0)-1st,IBMDS1(1) last day in the month,
+12 ;IBMDS1(2)-year_month, IBMDS1 - number of days
+13 NEW IBMDS1
SET IBMDS1=""
+14 ;dates,days for processing month which is normally
+15 ; previous month because MJ runs 1stday of the month
+16 SET IBMDS1(1)=IBPRMNTH
SET IBMDS1(2)=$EXTRACT(IBMDS1(1),1,5)
+17 SET IBMDS1(0)=IBMDS1(2)_"01"
SET IBMDS1=$EXTRACT(IBMDS1(1),6,7)
+18 DO MJT^IBAECM1
+19 DO RESET
+20 QUIT
+21 ;
ERR ;Error trap for NJ
+1 NEW XMSUB,XMTEXT,XMY,XMZ,XMMG,IBL,IBT,XMDUZ,IBPAT,IBTODAY
+2 NEW XMGROUP
SET XMGROUP=$$GET1^DIQ(350.9,"1,",.09)
+3 if XMGROUP=""
QUIT
+4 SET XMGROUP="G."_XMGROUP
+5 SET IBPAT="Unknown"
SET IBTODAY=""
+6 NEW Y
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET IBTODAY=Y
+7 IF +$GET(DFN)>0
Begin DoDot:1
+8 NEW VADM,VA,VAERR
+9 DO DEM^VADPT
+10 SET IBPAT=$GET(VADM(1))_", SSN: "_$PIECE($GET(VADM(2)),"^",2)
End DoDot:1
+11 if IBPAT=", SSN
SET IBPAT="Unknown"
+12 SET XMSUB="LTC Monthly Job Failure"
SET XMY(XMGROUP)=""
+13 SET XMTEXT="IBT("
SET XMDUZ="INTEGRATED BILLING PACKAGE"
+14 SET IBT(1,0)="**********************************************"
+15 SET IBT(2,0)="LTC Monthly Job crashed on "_IBTODAY
+16 SET IBT(3,0)="when the system was processing the following patient : "
+17 SET IBT(4,0)=" "_IBPAT
+18 SET IBT(5,0)="Please verify data for the patient, fix findings"
+19 SET IBT(6,0)="and then:"
+20 SET IBT(7,0)="- if today is the last day of the month then you"
+21 SET IBT(8,0)=" need to run NJ^IBAECN1 today manually from"
+22 SET IBT(9,0)=" programmer mode."
+23 SET IBT(10,0)="- otherwise let the system run the NJ^IBAECN1"
+24 SET IBT(11,0)=" automatically after midnight."
+25 SET IBT(12,0)=""
+26 SET IBT(13,0)="In both cases, please, check patient's charges and"
+27 SET IBT(14,0)="your e-mail again."
+28 DO ^XMD
+29 QUIT
+30 ;
+31 ;checks if the most recent treating specialty of the admission
+32 ;is related to LTC?
+33 ;invoked from PROC^IBAMTC Exmpl:
+34 ; I $$ISLTCADM(DFN,IBA)
+35 ;to create entries in 351.81 if necessary
+36 ;Input:
+37 ;IBDFN - patient's ien in file (#2)
+38 ;IB405 - ien of admission (#405)
+39 ;Output:
+40 ;returns 0 if the specialty for non-LTC care
+41 ;otherwise - returns 1
+42 ;
ISLTCADM(IBDFN,IB405) ;
+1 ;1) treat all LTC as Means Test if the legislation is not effective yet
+2 IF $$YESTRDAY()<$$BILDATE()
QUIT 0
+3 NEW IBSPEC,IBTS
+4 SET IBTS="M"
+5 ;2) determine treating specialty (TS)
+6 ;most recent TS (pointer #42.4)
SET IBSPEC=$$LASTTS(IBDFN,IB405)
+7 ;is it LTC or not?
IF IBSPEC>0
SET IBTS=$PIECE($$TREATSP^IBAECU2(IBSPEC),"^",1)
+8 ;treat unknown as Means Test
IF IBSPEC'>0
SET IBTS="M"
+9 ;if TS is LTC
IF IBTS="L"
Begin DoDot:1
+10 IF $$CLOCK^IBAECU(IBDFN,$$YESTRDAY())
End DoDot:1
QUIT 1
+11 QUIT 0
+12 ;finds the most recent parent entry in #350 related to admission
+13 ;Input:
+14 ;IBDFN - patient's dfn
+15 ;IBDT - the date to seek from (today)
+16 ;IBADM - admission we are seeking for
+17 ;IBSTAT = status we are seeking for
+18 ;output:
+19 ;returns ien_of_350^IB_action_type
+20 ;or "0^" if not found
FIND350(IBDFN,IBDATE,IBADM,IBSTAT) ;
+1 NEW IB350,IBDT,IBINF,IBFL
+2 SET IBFL=0
SET IBINF=""
+3 SET IBDT=-IBDATE
FOR
SET IBDT=$ORDER(^IB("AFDT",IBDFN,IBDT))
if IBFL!(+IBDT=0)
QUIT
Begin DoDot:1
+4 SET IB350=0
FOR
SET IB350=$ORDER(^IB("AFDT",IBDFN,IBDT,IB350))
if +IB350=0
QUIT
Begin DoDot:2
+5 if '$DATA(^IB("AC",IBSTAT,IB350))
QUIT
+6 SET IBINF=$GET(^IB(IB350,0))
+7 ;non parent
if IB350'=$PIECE(IBINF,"^",16)
QUIT
+8 ;non inpatient
if $PIECE($PIECE(IBINF,"^",4),"
QUIT
+9 if $PIECE($PIECE(IBINF,"^",4),"
SET IBFL=IB350
End DoDot:2
End DoDot:1
+10 QUIT IBFL_"^"_$PIECE($GET(IBINF),"^",3)
+11 ;
+12 ;edit #350 event entry
+13 ;IBIENCL - ien of #350
+14 ;IBLSTDT = DATE LAST BILLED
+15 ;IBADM - ien in #405
STAT350(IBIENCL,IBLSTDT,IBADM) ;
+1 NEW IBIENS,IBFDA,IBERR,IBDFN1
+2 SET IBDFN1=$PIECE($GET(^IB(IBIENCL,0)),"^",2)
+3 if +IBDFN1=0
QUIT
+4 ; "D0,"
SET IBIENS=IBIENCL_","
+5 SET IBFDA(350,IBIENS,13)=+$GET(DUZ)
+6 if '$PIECE($GET(^IB(IBIENCL,0)),"^",17)
SET IBFDA(350,IBIENS,.17)=(+$GET(^DGPM(IBADM,0)))\1
+7 SET IBFDA(350,IBIENS,.18)=(+$GET(IBLSTDT))\1
+8 DO NOW^%DTC
SET IBD=%
+9 SET IBFDA(350,IBIENS,14)=IBD
+10 DO FILE^DIE("","IBFDA","IBERR")
+11 IF $DATA(IBERR)
Begin DoDot:1
+12 DO ERRLOG^IBAECU5(+$GET(IBDFN1),+$GET(IBIENCL),"BILLING ACTION:","closing parent entry"_$GET(IBERR("DIERR",1,"TEXT",1)))
End DoDot:1
+13 QUIT
+14 ;------
+15 ;create a new inpatient parent event entry in #350
+16 ;Input:
+17 ;DFN - patient's ien #2
+18 ;IBADMIEN - admission ien #405
+19 ;IBEVDT - event date (piece 17) for parent entry must be an admission date,
+20 ;IBNH:
+21 ; 1 - for 56 (#350.1) NHCU ADMISSION
+22 ; 93 - for 93 (#350.1) LTC ADMISSION
+23 ; 0 - all other events
+24 ;Returns:
+25 ;New ien of #350 Or 0 if not created
CREV350(DFN,IBADMIEN,IBEVDT,IBNH) ;
+1 if IBEVDT=0
QUIT 0
+2 NEW IBEVDA,IBSL,IBSERV
+3 SET IBEVDA=0
+4 DO SERV^IBAUTL2
+5 IF '$DATA(IBSITE)!('$DATA(IBFAC))
DO SITE^IBAUTL
+6 SET IBSL="405:"_IBADMIEN
+7 ;if LTC ADMISSION set IBNHLTC
+8 IF IBNH=93
NEW IBNHLTC
SET IBNHLTC=93
+9 DO EVADD^IBAUTL3
+10 QUIT IBEVDA
+11 ;
+12 ;Find original admission ien, considering ASIH movements
+13 ;Input: ien of 405 that can be "child", for example
+14 ; we have ien of Nursing Home admission
+15 ; then patient moved to ASIH to hospital
+16 ; if IBA is ASIH hospital admission ien then call will return
+17 ; "original" Nursing Home admission's ien
+18 ;Output: ien of 405 of "original" admission
ORIGADM(IBA) ;
+1 NEW X,Y,Z
SET Z=IBA
+2 FOR
SET X=$GET(^DGPM(Z,0))
SET Y=$PIECE(X,"^",21)
if Y=""
QUIT
SET Z=+$PIECE($GET(^DGPM(Y,0)),"^",14)
+3 QUIT +Z
+4 ;
+5 ;most recent treating specialty
+6 ;input:
+7 ;IBDFN - patient ien
+8 ;IB405ADM - admission's #405 ien
+9 ;output:
+10 ;returns ien of SPECIALTY FILE (#42.4)
LASTTS(IBDFN,IB405ADM) ;
+1 NEW IBDT6,IBSPEC
+2 SET IBDT6=0
+3 SET IBDT6=+$ORDER(^DGPM("ATS",IBDFN,IB405ADM,IBDT6))
+4 ;error
if +IBDT6=0
QUIT -1
+5 SET IBSPEC=$ORDER(^DGPM("ATS",IBDFN,IB405ADM,IBDT6,0))
+6 ;error
if +IBSPEC=0
QUIT -1
+7 ;convert fac spec (45.7) -> treat spec (#42.4)
+8 SET IBSPEC=+$PIECE($GET(^DIC(45.7,IBSPEC,0)),"^",2)
+9 if +IBSPEC=0
QUIT -1
+10 QUIT IBSPEC
+11 ;returns today date
TODAY() ;
+1 NEW X
+2 DO NOW^%DTC
+3 QUIT X
+4 ;returns yesterday date
YESTRDAY() ;
+1 NEW X1,X2,X
+2 SET X1=$$TODAY()
+3 SET X2=-1
+4 DO C^%DTC
+5 QUIT X
+6 ;returns 1 if the most recent treating specialty for this billable
+7 ;event and for this date was LTC
+8 ;DFN -patient ien
+9 ;IBEVDA - ien of event in #350
+10 ;IBDT - date
ASIHORG(DFN,IBEVDA,IBDT) ;
+1 NEW IB405
SET IB405=+$PIECE($PIECE($GET(^IB(+IBEVDA,0)),"^",4),":",2)
+2 if IB405=0
QUIT 0
+3 QUIT $$ISLTC4DT(DFN,IB405,IBDT_.2359)
+4 ;
+5 ;returns 1 if the most recent treating specialty for the admission
+6 ;and the date was LTC specialty
+7 ;otherwise returns 0 or -1
+8 ;DFN -patient ien
+9 ;IB405ADM - ien of #405
+10 ;IBDT - date
ISLTC4DT(IBDFN,IB405ADM,IBDT) ;
+1 NEW IBDT6,IBSPEC,IBTS
+2 SET IBDT6=9999999.9999999-IBDT
+3 SET IBDT6=+$ORDER(^DGPM("ATS",IBDFN,IB405ADM,IBDT6))
+4 ;error
if +IBDT6=0
QUIT -1
+5 SET IBSPEC=$ORDER(^DGPM("ATS",IBDFN,IB405ADM,IBDT6,0))
+6 ;error
if +IBSPEC=0
QUIT -1
+7 ;convert fac spec (45.7) -> treat spec (#42.4)
+8 SET IBSPEC=+$PIECE($GET(^DIC(45.7,IBSPEC,0)),"^",2)
+9 ;is it LTC or not?
IF IBSPEC>0
SET IBTS=$PIECE($$TREATSP^IBAECU2(IBSPEC),"^",1)
+10 ;unknown as Means Test
IF IBSPEC'>0
SET IBTS="M"
+11 ;if TS is LTC
IF IBTS="L"
QUIT 1
+12 QUIT 0
+13 ;
RESET ; this will reset the ^xtmp global
+1 KILL ^XTMP("IB1010EC")
+2 SET ^XTMP("IB1010EC",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^LIST OF PATIENTS ALREADY REPORTED AS MISSING 1010EC INFO"
+3 QUIT
+4 ;
