106 lines
6.1 KiB
Mathematica
106 lines
6.1 KiB
Mathematica
HBHCAPPT ; LR VAMC(IRMS)/MJT-HBHC batch job to create ^HBHC(632) (visit) nodes from PCE module info => patient, appointment date/time, hospital location (clinic), prov, DX code(s), & CPT code(s), calls ^HBHCCAN, HBHCAPP1 ; Jul 2000
|
|
;;1.0;HOSPITAL BASED HOME CARE;**6,8,10,12,13,15,16,14**;NOV 01, 1993
|
|
; Daily auto-queued option, also called from ^HBHCFILE, HBHCLSDT, last date to include in transmit set up in ^HBHCFILE
|
|
D START^HBHCAPP1
|
|
SCAN ; Scan
|
|
N HBHCQRY
|
|
D OPEN^SDQ(.HBHCQRY)
|
|
D INDEX^SDQ(.HBHCQRY,"DATE/TIME","SET")
|
|
D DATE^SDQ(.HBHCQRY,HBHCBGDT,HBHCLSDT,"SET")
|
|
D SCANCB^SDQ(.HBHCQRY,"D CB^HBHCAPPT(Y,Y0,.SDSTOP)","SET")
|
|
D ACTIVE^SDQ(.HBHCQRY,"TRUE","SET")
|
|
D SCAN^SDQ(.HBHCQRY,"FORWARD")
|
|
D CLOSE^SDQ(.HBHCQRY)
|
|
I ($D(^HBHC(634.1,"B")))!($D(^HBHC(634.2,"B")))!($D(^HBHC(634.3,"B")))!($D(^HBHC(634.5,"B"))) D MAIL^HBHCAPP1
|
|
; Delete File Update in Progress Flag
|
|
S $P(^HBHC(631.9,1,0),U,8)=""
|
|
EXIT ; Exit module
|
|
D EXIT^HBHCAPP1
|
|
Q
|
|
CB(HBHCOEP,HBHCSCE0,HBHCSTOP) ;
|
|
; Omit Child encounter, (child if Parent Encounter field contains data)
|
|
Q:$P(HBHCSCE0,U,6)]""
|
|
; Quit if invalid status for HBHC purposes
|
|
Q:($P(HBHCSCE0,U,12)=4)!($P(HBHCSCE0,U,12)=5)!($P(HBHCSCE0,U,12)=6)!($P(HBHCSCE0,U,12)=7)!($P(HBHCSCE0,U,12)=9)!($P(HBHCSCE0,U,12)=10)!($P(HBHCSCE0,U,12)=11)!($P(HBHCSCE0,U,12)=13)
|
|
; Clinic missing
|
|
Q:$P(HBHCSCE0,U,4)=""
|
|
; Include only HBHC clinics
|
|
Q:'$D(^HBHC(631.6,"B",$P(HBHCSCE0,U,4)))
|
|
S HBHCCLN=$P(HBHCSCE0,U,4)
|
|
D VERIFY I 'HBHCFLG D PROCESS D:$D(HBHCMSG) ERROR^HBHCAPP1
|
|
Q
|
|
VERIFY ; Verify record doesn't already exist in ^HBHC(632) file
|
|
S HBHCFLG=0,HBHCDPT=$P(HBHCSCE0,U,2),HBHCAPDT=$P(HBHCSCE0,U)
|
|
I HBHCDPT="" S HBHCFLG=1 Q
|
|
S HBHCBXRF=0 F S HBHCBXRF=$O(^HBHC(632,"B",HBHCDPT,HBHCBXRF)) Q:(HBHCBXRF'>0)!(HBHCFLG) S:($D(^HBHC(632,"AE",HBHCOEP)))&(HBHCAPDT=$P(^HBHC(632,HBHCBXRF,0),U,2))&('$D(^HBHC(632,"AC","C",HBHCBXRF))) HBHCFLG=1
|
|
Q
|
|
PROCESS ; Process provider, diagnosis (DX), & CPT code data
|
|
; Dx
|
|
K HBHCDXL,HBHCDX
|
|
D GETDX^SDOE(HBHCOEP,"HBHCDXL")
|
|
S HBHCCNT=1 F HBHCI=1:1:HBHCDXL S HBHCDX(HBHCI)=""
|
|
S HBHCDFN=0 F S HBHCDFN=$O(HBHCDXL(HBHCDFN)) Q:(HBHCDFN'>0)!(HBHCCNT>HBHCDXL) S:$P(HBHCDXL(HBHCDFN),U,12)="P" HBHCDX(1)=$P(HBHCDXL(HBHCDFN),U) S:$P(HBHCDXL(HBHCDFN),U,12)="S" HBHCCNT=HBHCCNT+1,HBHCDX(HBHCCNT)=$P(HBHCDXL(HBHCDFN),U)
|
|
; Dx missing
|
|
I (+$G(HBHCDXL)'>0) S HBHCMSG=3 Q
|
|
; provider, use Encounter Provider (field 1204, file 9000010.18) or V Provider (9000010.06) (if encounter provider doesn't exist), each provider within encounter will become a separate HBHC Visit record
|
|
K HBHCPRV1,HBHCPRVL
|
|
D GETPRV^SDOE(HBHCOEP,"HBHCPRVL")
|
|
S (HBHCPCNT,HBHCDFN,HBHCONE)=0 F S HBHCDFN=$O(HBHCPRVL(HBHCDFN)) Q:HBHCDFN'>0 S HBHCPRV=$P(HBHCPRVL(HBHCDFN),U) D CHECK S:HBHCONE=1 HBHCPCNT=HBHCPCNT+1,HBHCPRV1(HBHCPRV)=""
|
|
; Provider missing
|
|
I (+$G(HBHCPRVL)'>0) S HBHCMSG=2 Q
|
|
; HBHC provider missing
|
|
I HBHCONE=0 S HBHCMSG=11 Q
|
|
; Multiple HBHC provider numbers
|
|
I HBHCONE>1 S HBHCMSG=12 Q
|
|
; CPT Code
|
|
K HBHCCPTL,HBHCPRV
|
|
D GETCPT^SDOE(HBHCOEP,"HBHCCPTL")
|
|
S (HBHCDFN,HBHCONE)=0 F S HBHCDFN=$O(HBHCCPTL(HBHCDFN)) Q:(HBHCDFN'>0)!($D(HBHCMSG)) S HBHCPRV=$P($G(HBHCCPTL(HBHCDFN,12)),U,4) D:HBHCPRV]"" CHECK S HBHCNBR=$P(HBHCCPTL(HBHCDFN,0),U,16) D PROV
|
|
; Provider mismatch
|
|
Q:$D(HBHCMSG)
|
|
; Provider ambiguous
|
|
I $D(HBHCPRV("ZZ")) S HBHCMSG=5 Q
|
|
; CPT Code missing
|
|
I (+$G(HBHCCPTL)=0) S HBHCMSG=4 Q
|
|
; outpatient encounter must have 'checked-out' status (2) to ensure provider, Dx, & CPT data exist, or inpatient status (8)
|
|
I ($P(HBHCSCE0,U,12)'=2)&($P(HBHCSCE0,U,12)'=8) S HBHCMSG=1 Q
|
|
SET ; Set node, call ^DIK to set cross-refs in ^HBHC(632) (visit) file
|
|
S HBHCPRV="" F S HBHCPRV=$O(HBHCPRV(HBHCPRV)) Q:HBHCPRV="" D SETLOOP
|
|
Q
|
|
SETLOOP ; Set loop
|
|
S HBHC="" F S HBHC=$O(^HBHC(631.4,"C",HBHCPRV,HBHC)) Q:(HBHC="")!('$D(^HBHC(631.4,"AC",1,HBHC)))
|
|
L +^HBHC(632,0) F S HBHCDFN=$P(^HBHC(632,0),U,3)+1,$P(^HBHC(632,0),U,3)=HBHCDFN Q:'$D(^HBHC(632,HBHCDFN,0))
|
|
S $P(^HBHC(632,0),U,4)=$P(^HBHC(632,0),U,4)+1 L -^HBHC(632,0)
|
|
L +^HBHC(632,HBHCDFN,2) S HBHCCPT=""
|
|
F S HBHCCPT=$O(HBHCPRV(HBHCPRV,HBHCCPT)) Q:HBHCCPT="" S HBHCNBR="" F S HBHCNBR=$O(HBHCPRV(HBHCPRV,HBHCCPT,HBHCNBR)) Q:HBHCNBR="" D SETCPT S HBHCK=0 F S HBHCK=$O(HBHCPRV(HBHCPRV,HBHCCPT,HBHCNBR,HBHCK)) Q:HBHCK'>0 D SETMOD
|
|
L -^HBHC(632,HBHCDFN,2)
|
|
L +^HBHC(632,HBHCDFN,3) K DD,DO S DIC="^HBHC(632,",DIC(0)="L",DIC("P")=$P(^DD(632,33,0),U,2),DA(1)=HBHCDFN,DIC=DIC_DA(1)_",3,",HBHCI="" F S HBHCI=$O(HBHCDX(HBHCI)) Q:HBHCI="" S X=HBHCDX(HBHCI) D FILE^DICN
|
|
L -^HBHC(632,HBHCDFN,3)
|
|
L +^HBHC(632,HBHCDFN,0) S ^HBHC(632,HBHCDFN,0)=HBHCDPT_U_HBHCAPDT_U_HBHCCLN_U_HBHC_U_U_U_U_"N"_U_U_U_U_U_U_U_U_U_U_U_U_U_U_HBHCOEP L -^HBHC(632,HBHCDFN,0)
|
|
K DIK S DIK="^HBHC(632,",DA=HBHCDFN D IX^DIK K DIK
|
|
Q
|
|
CHECK ; Check to ensure provider only has 1 HBHC Provider Number (631.4) or if > 1, has others flagged as Inactive Provider Numbers
|
|
S (HBHCONE,HBHCIEN)=0 F S HBHCIEN=$O(^HBHC(631.4,"C",HBHCPRV,HBHCIEN)) Q:(HBHCIEN'>0)!(HBHCONE>1) S:'$D(^HBHC(631.4,"AC",1,HBHCIEN)) HBHCONE=HBHCONE+1
|
|
Q
|
|
PROV ; Encounter provider & CPT code processing
|
|
S:HBHCPCNT=1 HBHCTXT="",HBHCTXT=$O(HBHCPRV1(HBHCTXT))
|
|
F HBHCJ=1:1:HBHCNBR D:HBHCPRV="" SUB1 D:HBHCPRV]"" SUB2
|
|
Q
|
|
SUB1 ; Subroutine 1 for encounter provider & CPT code processing
|
|
S HBHCPRV($S(HBHCPCNT=1:HBHCTXT,1:"ZZ"),$P(HBHCCPTL(HBHCDFN,0),U),HBHCJ)=""
|
|
S HBHCK=0 F S HBHCK=$O(HBHCCPTL(HBHCDFN,1,HBHCK)) Q:HBHCK'>0 S HBHCPRV($S(HBHCPCNT=1:HBHCTXT,1:"ZZ"),$P(HBHCCPTL(HBHCDFN,0),U),HBHCJ,HBHCK)=HBHCCPTL(HBHCDFN,1,HBHCK,0)
|
|
Q
|
|
SUB2 ; Subroutine 2 for encounter provider & CPT code processing
|
|
I (HBHCONE=1)&($D(HBHCPRV1(HBHCPRV))) S HBHCPRV(HBHCPRV,$P(HBHCCPTL(HBHCDFN,0),U),HBHCJ)="",HBHCK=0 F S HBHCK=$O(HBHCCPTL(HBHCDFN,1,HBHCK)) Q:HBHCK'>0 S HBHCPRV(HBHCPRV,$P(HBHCCPTL(HBHCDFN,0),U),HBHCJ,HBHCK)=HBHCCPTL(HBHCDFN,1,HBHCK,0)
|
|
S:'$D(HBHCPRV1(HBHCPRV)) HBHCMSG=13
|
|
Q
|
|
SETCPT ; Set CPT multiple
|
|
K DD,DO S DIC="^HBHC(632,",DIC(0)="L",DIC("P")=$P(^DD(632,32,0),U,2),DA(1)=HBHCDFN,X=HBHCCPT,DIC=DIC_DA(1)_",2," D FILE^DICN
|
|
; Set up for CPT Modifier update
|
|
S DA=+Y,DA(2)=DA(1),DA(1)=DA
|
|
K DD,DO S DIC("P")=$P(^DD(632.032,1,0),U,2),DIC=DIC_DA_",1,"
|
|
Q
|
|
SETMOD ; Set CPT Modifier multiple
|
|
S X=HBHCPRV(HBHCPRV,HBHCCPT,HBHCNBR,HBHCK) D FILE^DICN S DA=+Y
|
|
Q
|