IBACCROWFT ;EDE/WCJ - ACC (Automated Community Care) Claims - Roll Up Utilities ; 24-APR-2024
;;2.0;INTEGRATED BILLING;**770**;21-MAR-94;Build 119
;;Per VA Directive 6402, this routine should not be modified.
Q
;
LKUPSCRN(Y) ; Look Up Screen
; only let them pick facilities in our table
N RET,IEN,STATION
S RET=0
S STATION=$$GET1^DIQ(4,+Y,99)
I STATION="" Q RET
I '$D(^IBA(364.99,"B",STATION)) Q RET
S IEN=$O(^IBA(364.99,"B",STATION,""),-1)
I '+IEN Q RET
I '$$GET1^DIQ(364.99,IEN,.04,"I") Q RET
S RET=1
Q RET
;
MCD(STATION) ; Medical Center Division
; pass in the complete 3-7 character station number
; and get the MCD to bill from 40.8
; or DEFAULT DIVISION from site parameter file if we can't find a MCD for a VAMC
; VAMC will have 3 digit number or 3 digit followed by A then whatever
;
N SCREEN,MCD
;
;wcj;IB770;v37;EBILL-5371
;I +STATION=STATION!($E(STATION,4)="A") D
;. S SCREEN="I $P(^(0),U,7),$$GET1^DIQ(4,$P(^(0),U,7),99)=STATION"
;. S MCD=$$FIND1^DIC(40.8,,"X",STATION,"AD",SCREEN,"RETURN")
;
S SCREEN="I $P(^(0),U,7),$$GET1^DIQ(4,$P(^(0),U,7),99)=STATION"
S MCD=$$FIND1^DIC(40.8,,"X",STATION,"AD",SCREEN,"RETURN")
I $G(MCD) Q MCD
;
;maybe grab the default from the site parameters
Q $$GET1^DIQ(350.9,1,1.25,"I")
;
;leave
;
N RET,IEN,LOOP,WL
S RET=0
; use new crosswalk to see what it rolls up to
I '$D(^IBA(364.99,"B",STATION)) Q RET
S IEN=$O(^IBA(364.99,"B",STATION,""),-1) I 'IEN Q RET
S WL=$P($G(^IBA(364.99,IEN,0)),U,2)
I WL="" Q RET
S LOOP=0 F S LOOP=$O(^IBA(364.99,"C",WL,LOOP)) Q:'LOOP I $P($G(^IBA(364.99,LOOP,0)),U,4) S RET=1 Q
I 'RET Q RET
;
;get the pointer into 40.8
N DIC,X,Y
S X=$P($G(^IBA(364.99,LOOP,0)),U)
S DIC(0)="MX",DIC=40.8 D ^DIC ;ICR #2817 (Controlled)
I Y<0 Q RET
Q Y
;
;WCJ;v8;10/24/24
RUST(STATION) ; roll-up station aka division
; pass in the complete 3-7 character station number
; and get the Division for 4 sites that use them
; or 0 if can't figure out.
;
N RET,IEN,LOOP,WL
I $G(STATION)="" Q ""
S RET=STATION
; use new crosswalk to see what it rolls up to
I '$D(^IBA(364.99,"B",STATION)) Q $E(STATION,1,3)
S IEN=$O(^IBA(364.99,"B",STATION,""),-1) I 'IEN Q $E(STATION,1,3) ; don't think it could ever get here and yet there was code here
S WL=$P($G(^IBA(364.99,IEN,0)),U,2)
I WL="" Q STATION
S LOOP=0 F S LOOP=$O(^IBA(364.99,"C",WL,LOOP)) Q:'LOOP I $P($G(^IBA(364.99,LOOP,0)),U,4) S RET=1 Q
I 'RET Q STATION
;
Q $P(^IBA(364.99,LOOP,0),U)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCROWFT 2542 printed May 25, 2026@12:09:43 Page 2
IBACCROWFT ;EDE/WCJ - ACC (Automated Community Care) Claims - Roll Up Utilities ; 24-APR-2024
+1 ;;2.0;INTEGRATED BILLING;**770**;21-MAR-94;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
LKUPSCRN(Y) ; Look Up Screen
+1 ; only let them pick facilities in our table
+2 NEW RET,IEN,STATION
+3 SET RET=0
+4 SET STATION=$$GET1^DIQ(4,+Y,99)
+5 IF STATION=""
QUIT RET
+6 IF '$DATA(^IBA(364.99,"B",STATION))
QUIT RET
+7 SET IEN=$ORDER(^IBA(364.99,"B",STATION,""),-1)
+8 IF '+IEN
QUIT RET
+9 IF '$$GET1^DIQ(364.99,IEN,.04,"I")
QUIT RET
+10 SET RET=1
+11 QUIT RET
+12 ;
MCD(STATION) ; Medical Center Division
+1 ; pass in the complete 3-7 character station number
+2 ; and get the MCD to bill from 40.8
+3 ; or DEFAULT DIVISION from site parameter file if we can't find a MCD for a VAMC
+4 ; VAMC will have 3 digit number or 3 digit followed by A then whatever
+5 ;
+6 NEW SCREEN,MCD
+7 ;
+8 ;wcj;IB770;v37;EBILL-5371
+9 ;I +STATION=STATION!($E(STATION,4)="A") D
+10 ;. S SCREEN="I $P(^(0),U,7),$$GET1^DIQ(4,$P(^(0),U,7),99)=STATION"
+11 ;. S MCD=$$FIND1^DIC(40.8,,"X",STATION,"AD",SCREEN,"RETURN")
+12 ;
+13 SET SCREEN="I $P(^(0),U,7),$$GET1^DIQ(4,$P(^(0),U,7),99)=STATION"
+14 SET MCD=$$FIND1^DIC(40.8,,"X",STATION,"AD",SCREEN,"RETURN")
+15 IF $GET(MCD)
QUIT MCD
+16 ;
+17 ;maybe grab the default from the site parameters
+18 QUIT $$GET1^DIQ(350.9,1,1.25,"I")
+19 ;
+20 ;leave
+21 ;
+22 NEW RET,IEN,LOOP,WL
+23 SET RET=0
+24 ; use new crosswalk to see what it rolls up to
+25 IF '$DATA(^IBA(364.99,"B",STATION))
QUIT RET
+26 SET IEN=$ORDER(^IBA(364.99,"B",STATION,""),-1)
IF 'IEN
QUIT RET
+27 SET WL=$PIECE($GET(^IBA(364.99,IEN,0)),U,2)
+28 IF WL=""
QUIT RET
+29 SET LOOP=0
FOR
SET LOOP=$ORDER(^IBA(364.99,"C",WL,LOOP))
if 'LOOP
QUIT
IF $PIECE($GET(^IBA(364.99,LOOP,0)),U,4)
SET RET=1
QUIT
+30 IF 'RET
QUIT RET
+31 ;
+32 ;get the pointer into 40.8
+33 NEW DIC,X,Y
+34 SET X=$PIECE($GET(^IBA(364.99,LOOP,0)),U)
+35 ;ICR #2817 (Controlled)
SET DIC(0)="MX"
SET DIC=40.8
DO ^DIC
+36 IF Y<0
QUIT RET
+37 QUIT Y
+38 ;
+39 ;WCJ;v8;10/24/24
RUST(STATION) ; roll-up station aka division
+1 ; pass in the complete 3-7 character station number
+2 ; and get the Division for 4 sites that use them
+3 ; or 0 if can't figure out.
+4 ;
+5 NEW RET,IEN,LOOP,WL
+6 IF $GET(STATION)=""
QUIT ""
+7 SET RET=STATION
+8 ; use new crosswalk to see what it rolls up to
+9 IF '$DATA(^IBA(364.99,"B",STATION))
QUIT $EXTRACT(STATION,1,3)
+10 ; don't think it could ever get here and yet there was code here
SET IEN=$ORDER(^IBA(364.99,"B",STATION,""),-1)
IF 'IEN
QUIT $EXTRACT(STATION,1,3)
+11 SET WL=$PIECE($GET(^IBA(364.99,IEN,0)),U,2)
+12 IF WL=""
QUIT STATION
+13 SET LOOP=0
FOR
SET LOOP=$ORDER(^IBA(364.99,"C",WL,LOOP))
if 'LOOP
QUIT
IF $PIECE($GET(^IBA(364.99,LOOP,0)),U,4)
SET RET=1
QUIT
+14 IF 'RET
QUIT STATION
+15 ;
+16 QUIT $PIECE(^IBA(364.99,LOOP,0),U)
+17 ;
