- IBMHUT1 ;YMG/EDE - IB Mental Health Utilities ;MAY 15 2023
- ;;2.0;Integrated Billing;**784**;21-MAR-94;Build 8
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- ;
- MHVST(IBSDT,IBEDT) ; loop through file 350 and populate file 351.83, as needed
- ;
- ; IBSDT - start date
- ; IBEDT - end date
- ;
- N DFN,IBATYP,IBATYPN,IBCANC,IBDT,IBENC,IBEVDT,IBIEN,IBMHPROC,IBMHTRK,IBOK,IBSTAT,IBSTATN,IENS,N0,Z
- I '+$G(IBSDT)!('+$G(IBEDT)) Q ; invalid date(s)
- S DFN=0 F S DFN=$O(^IB("AFDT",DFN)) Q:'DFN D
- .S IBDT=-(IBEDT+.01) F S IBDT=$O(^IB("AFDT",DFN,IBDT)) Q:'IBDT!(-IBDT<IBSDT) D
- ..S IBEVDT=-IBDT
- ..S IBIEN=0 F S IBIEN=$O(^IB("AFDT",DFN,IBDT,IBIEN)) Q:'IBIEN D
- ...S N0=$G(^IB(IBIEN,0)) ; file 350 entry, node 0
- ...S IBATYP=$P(N0,U,3) I 'IBATYP Q
- ...S IBATYPN=$P($G(^IBE(350.1,IBATYP,0)),U) I IBATYPN'["OPT" Q ; not an outpatient charge
- ...S IBSTAT=$P(N0,U,5) I 'IBSTAT Q
- ...S IBSTATN=$P($G(^IBE(350.21,IBSTAT,0)),U)
- ...S IBOK=$S(IBATYPN["CC MH":1,1:0)
- ...I 'IBOK S IBOK=$$ISCDCANC^IBECEAMH(IBIEN)
- ...I 'IBOK S Z=$P($P(N0,U,4),";") Q:$P(Z,":")'="409.68" S IBENC=$P(Z,":",2),IBOK=$$OECHK^IBECEAMH(IBENC,IBEVDT)
- ...I IBOK D
- ....; eligible for Cleland-Dole
- ....S IBMHTRK=+$O(^IBMH(351.83,"D",IBIEN,"")) ; file 351.83 ien, if entry already exists
- ....I IBSTATN="BILLED"!("^ON HOLD^HOLD - RATE^HOLD - REVIEW^"[(U_IBSTATN_U)),IBMHTRK>0,'$$ISBILLED(IBIEN) D ADDVST^IBECEAMH(DFN,IBEVDT,IBIEN,2)
- ....I IBSTATN="CANCELLED" D
- .....S IBCANC=+$P(N0,U,10) I 'IBCANC Q
- .....S IENS=IBCANC_",",IBMHPROC=$$GET1^DIQ(350.3,IENS,.07,"I") I 'IBMHPROC Q
- .....I '$$GET1^DIQ(350.3,IENS,.08,"I") Q ; cancellation reason can't cancel C-D charge
- .....I IBMHTRK>0 D UPDVST^IBECEAMH(IBIEN,IBMHPROC) Q
- .....I $P(^IBE(350.3,IBCANC,0),U)="CLELAND-DOLE",$$NUMVSTCK^IBECEAMH(DFN,IBEVDT) D ADDVST^IBECEAMH(DFN,IBEVDT,IBIEN,1,2)
- ....Q
- ...Q
- ..Q
- .Q
- Q
- ;
- ISBILLED(IBIEN) ; check if there's a "billed" entry in file 351.83 for a given charge
- ;
- ; IBIEN - file 350 ien
- ;
- ; returns 1 if there's a corresponding entry in file 351.83 with "billed" status, or 0 otherwise.
- ;
- N IBMHIEN,RES
- S (RES,IBMHIEN)=0 F S IBMHIEN=$O(^IBMH(351.83,"D",IBIEN,IBMHIEN)) Q:'IBMHIEN!RES I $P(^IBMH(351.83,IBMHIEN,0),U,4)=2 S RES=1
- Q RES
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBMHUT1 2272 printed Mar 13, 2025@21:29:31 Page 2
- IBMHUT1 ;YMG/EDE - IB Mental Health Utilities ;MAY 15 2023
- +1 ;;2.0;Integrated Billing;**784**;21-MAR-94;Build 8
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- MHVST(IBSDT,IBEDT) ; loop through file 350 and populate file 351.83, as needed
- +1 ;
- +2 ; IBSDT - start date
- +3 ; IBEDT - end date
- +4 ;
- +5 NEW DFN,IBATYP,IBATYPN,IBCANC,IBDT,IBENC,IBEVDT,IBIEN,IBMHPROC,IBMHTRK,IBOK,IBSTAT,IBSTATN,IENS,N0,Z
- +6 ; invalid date(s)
- IF '+$GET(IBSDT)!('+$GET(IBEDT))
- QUIT
- +7 SET DFN=0
- FOR
- SET DFN=$ORDER(^IB("AFDT",DFN))
- if 'DFN
- QUIT
- Begin DoDot:1
- +8 SET IBDT=-(IBEDT+.01)
- FOR
- SET IBDT=$ORDER(^IB("AFDT",DFN,IBDT))
- if 'IBDT!(-IBDT<IBSDT)
- QUIT
- Begin DoDot:2
- +9 SET IBEVDT=-IBDT
- +10 SET IBIEN=0
- FOR
- SET IBIEN=$ORDER(^IB("AFDT",DFN,IBDT,IBIEN))
- if 'IBIEN
- QUIT
- Begin DoDot:3
- +11 ; file 350 entry, node 0
- SET N0=$GET(^IB(IBIEN,0))
- +12 SET IBATYP=$PIECE(N0,U,3)
- IF 'IBATYP
- QUIT
- +13 ; not an outpatient charge
- SET IBATYPN=$PIECE($GET(^IBE(350.1,IBATYP,0)),U)
- IF IBATYPN'["OPT"
- QUIT
- +14 SET IBSTAT=$PIECE(N0,U,5)
- IF 'IBSTAT
- QUIT
- +15 SET IBSTATN=$PIECE($GET(^IBE(350.21,IBSTAT,0)),U)
- +16 SET IBOK=$SELECT(IBATYPN["CC MH":1,1:0)
- +17 IF 'IBOK
- SET IBOK=$$ISCDCANC^IBECEAMH(IBIEN)
- +18 IF 'IBOK
- SET Z=$PIECE($PIECE(N0,U,4),";")
- if $PIECE(Z,"
- QUIT
- SET IBENC=$PIECE(Z,":",2)
- SET IBOK=$$OECHK^IBECEAMH(IBENC,IBEVDT)
- +19 IF IBOK
- Begin DoDot:4
- +20 ; eligible for Cleland-Dole
- +21 ; file 351.83 ien, if entry already exists
- SET IBMHTRK=+$ORDER(^IBMH(351.83,"D",IBIEN,""))
- +22 IF IBSTATN="BILLED"!("^ON HOLD^HOLD - RATE^HOLD - REVIEW^"[(U_IBSTATN_U))
- IF IBMHTRK>0
- IF '$$ISBILLED(IBIEN)
- DO ADDVST^IBECEAMH(DFN,IBEVDT,IBIEN,2)
- +23 IF IBSTATN="CANCELLED"
- Begin DoDot:5
- +24 SET IBCANC=+$PIECE(N0,U,10)
- IF 'IBCANC
- QUIT
- +25 SET IENS=IBCANC_","
- SET IBMHPROC=$$GET1^DIQ(350.3,IENS,.07,"I")
- IF 'IBMHPROC
- QUIT
- +26 ; cancellation reason can't cancel C-D charge
- IF '$$GET1^DIQ(350.3,IENS,.08,"I")
- QUIT
- +27 IF IBMHTRK>0
- DO UPDVST^IBECEAMH(IBIEN,IBMHPROC)
- QUIT
- +28 IF $PIECE(^IBE(350.3,IBCANC,0),U)="CLELAND-DOLE"
- IF $$NUMVSTCK^IBECEAMH(DFN,IBEVDT)
- DO ADDVST^IBECEAMH(DFN,IBEVDT,IBIEN,1,2)
- End DoDot:5
- +29 QUIT
- End DoDot:4
- +30 QUIT
- End DoDot:3
- +31 QUIT
- End DoDot:2
- +32 QUIT
- End DoDot:1
- +33 QUIT
- +34 ;
- ISBILLED(IBIEN) ; check if there's a "billed" entry in file 351.83 for a given charge
- +1 ;
- +2 ; IBIEN - file 350 ien
- +3 ;
- +4 ; returns 1 if there's a corresponding entry in file 351.83 with "billed" status, or 0 otherwise.
- +5 ;
- +6 NEW IBMHIEN,RES
- +7 SET (RES,IBMHIEN)=0
- FOR
- SET IBMHIEN=$ORDER(^IBMH(351.83,"D",IBIEN,IBMHIEN))
- if 'IBMHIEN!RES
- QUIT
- IF $PIECE(^IBMH(351.83,IBMHIEN,0),U,4)=2
- SET RES=1
- +8 QUIT RES
