- IBAMTS ;ALB/CPM - APPOINTMENT EVENT DRIVER INTERFACE ; 20-JUL-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- EN ; Main interface entry point.
- ;
- S IBJOB=5,IBWHER="",IBDUZ=DUZ,IBY=1
- I '$$BILST^DGMTUB(DFN) G ENQ ; never Category C
- I '$$CHECK^IBECEAU(0) D ^IBAERR1 G ENQ ; can't set vital parameters
- ;
- ; - process all parent outpatient encounters
- S IBORG=0 F S IBORG=$O(^TMP("SDEVT",$J,SDHDL,IBORG)) Q:'IBORG D
- .S IBOE=0 F S IBOE=$O(^TMP("SDEVT",$J,SDHDL,IBORG,"SDOE",IBOE)) Q:'IBOE S IBEVT=$G(^(IBOE,0,"AFTER")),IBEV0=$G(^("BEFORE")) D
- ..S IBDT=$S(IBEVT:+IBEVT,1:+IBEV0),IBDAT=$P(IBDT,".")
- ..S IBAPTY=$S(IBEVT:$P(IBEVT,"^",10),1:$P(IBEV0,"^",10))
- ..S IBBILLED=$$BFO^IBECEAU(DFN,IBDAT),IBY=1
- ..;
- ..; - if C&P encounter, cancel charges for the day and quit
- ..I IBAPTY=1 D:IBBILLED Q
- ...S IBCRES=+$O(^IBE(350.3,"B","COMP & PENSION VISIT RECORDED",0))
- ...S:'IBCRES IBCRES=23 S IBWHER=""
- ...D CANCH^IBECEAU4(IBBILLED,IBCRES,0)
- ..;
- ..; - quit if there are any C&P encounters on the visit date
- ..Q:$$CNP^IBECEAU(DFN,IBDAT)
- ..;
- ..; - don't process child events
- ..I IBEVT]"" Q:$P(IBEVT,"^",6)
- ..I IBEVT="",IBEV0]"" Q:$P(IBEV0,"^",6)
- ..;
- ..; - get statuses
- ..S IBAST=+$P(IBEVT,"^",12),IBBST=+$P(IBEV0,"^",12)
- ..;
- ..; - do either NEW or UPDATED processing
- ..I IBAST=2,IBBST'=2 D NEW^IBAMTS1 Q
- ..D UPD^IBAMTS2
- ;
- ENQ K IBJOB,IBWHER,IBORG,IBOE,IBEVT,IBEV0,IBAST,IBBST,IBDUZ,IBY
- K IBDT,IBDAT,IBAPTY,IBBILLED,IBSERV,IBSITE,IBFAC,IBCRES,IBRTED
- Q
- ;
- BULL ; Send bulletin when classified patients are billed stops which
- ; are exempt from the classification process.
- N IBT,IBC,IBPT,IBDUZ S IBPT=$$PT^IBEFUNC(DFN)
- S XMSUB="CHARGE FOR STOP CODE EXEMPT FROM CLASSIFICATION"
- S IBT(1)="The following patient, who has claimed exposure to "_$$CLTY
- S IBT(2)="was billed the Means Test outpatient copay for a stop code which is"
- S IBT(3)="exempt from classification:"
- S IBT(4)=" " S IBC=4
- S IBDUZ=DUZ D PAT^IBAERR1
- S Y=IBDAT D DD^%DT
- S IBC=IBC+1,IBT(IBC)="Stop Date: "_Y
- S IBC=IBC+1,IBT(IBC)="Stop Code: "_$P($G(^DIC(40.7,+$P(IBEVT,"^",3),0)),"^")
- S IBC=IBC+1,IBT(IBC)=" "
- S IBC=IBC+1,IBT(IBC)="Please check this patient's medical record to determine if the care provided"
- S IBC=IBC+1,IBT(IBC)="was related to the claimed exposure, and, if related, cancel the charge."
- D MAIL^IBAERR1
- K X,Y,XMSUB,XMY,XMTEXT,XMDUZ
- Q
- ;
- CLTY() ; Return the classification type
- N X,Y D CL^SDCO21(DFN,IBDAT,"",.X) S Y=""
- I $D(X(1)) S Y="Agent Orange" G CLTYQ
- I $D(X(2)) S Y="Ionizing Radiation" G CLTYQ
- I $D(X(4)) S Y="Environmental Contaminants"
- CLTYQ Q Y_","
- IBAMTS ;ALB/CPM - APPOINTMENT EVENT DRIVER INTERFACE ; 20-JUL-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- EN ; Main interface entry point.
- +1 ;
- +2 SET IBJOB=5
- SET IBWHER=""
- SET IBDUZ=DUZ
- SET IBY=1
- +3 ; never Category C
- IF '$$BILST^DGMTUB(DFN)
- GOTO ENQ
- +4 ; can't set vital parameters
- IF '$$CHECK^IBECEAU(0)
- DO ^IBAERR1
- GOTO ENQ
- +5 ;
- +6 ; - process all parent outpatient encounters
- +7 SET IBORG=0
- FOR
- SET IBORG=$ORDER(^TMP("SDEVT",$JOB,SDHDL,IBORG))
- IF 'IBORG
- QUIT
- Begin DoDot:1
- +8 SET IBOE=0
- FOR
- SET IBOE=$ORDER(^TMP("SDEVT",$JOB,SDHDL,IBORG,"SDOE",IBOE))
- IF 'IBOE
- QUIT
- SET IBEVT=$GET(^(IBOE,0,"AFTER"))
- SET IBEV0=$GET(^("BEFORE"))
- Begin DoDot:2
- +9 SET IBDT=$SELECT(IBEVT:+IBEVT,1:+IBEV0)
- SET IBDAT=$PIECE(IBDT,".")
- +10 SET IBAPTY=$SELECT(IBEVT:$PIECE(IBEVT,"^",10),1:$PIECE(IBEV0,"^",10))
- +11 SET IBBILLED=$$BFO^IBECEAU(DFN,IBDAT)
- SET IBY=1
- +12 ;
- +13 ; - if C&P encounter, cancel charges for the day and quit
- +14 IF IBAPTY=1
- IF IBBILLED
- Begin DoDot:3
- +15 SET IBCRES=+$ORDER(^IBE(350.3,"B","COMP & PENSION VISIT RECORDED",0))
- +16 IF 'IBCRES
- SET IBCRES=23
- SET IBWHER=""
- +17 DO CANCH^IBECEAU4(IBBILLED,IBCRES,0)
- End DoDot:3
- QUIT
- +18 ;
- +19 ; - quit if there are any C&P encounters on the visit date
- +20 IF $$CNP^IBECEAU(DFN,IBDAT)
- QUIT
- +21 ;
- +22 ; - don't process child events
- +23 IF IBEVT]""
- IF $PIECE(IBEVT,"^",6)
- QUIT
- +24 IF IBEVT=""
- IF IBEV0]""
- IF $PIECE(IBEV0,"^",6)
- QUIT
- +25 ;
- +26 ; - get statuses
- +27 SET IBAST=+$PIECE(IBEVT,"^",12)
- SET IBBST=+$PIECE(IBEV0,"^",12)
- +28 ;
- +29 ; - do either NEW or UPDATED processing
- +30 IF IBAST=2
- IF IBBST'=2
- DO NEW^IBAMTS1
- QUIT
- +31 DO UPD^IBAMTS2
- End DoDot:2
- End DoDot:1
- +32 ;
- ENQ KILL IBJOB,IBWHER,IBORG,IBOE,IBEVT,IBEV0,IBAST,IBBST,IBDUZ,IBY
- +1 KILL IBDT,IBDAT,IBAPTY,IBBILLED,IBSERV,IBSITE,IBFAC,IBCRES,IBRTED
- +2 QUIT
- +3 ;
- BULL ; Send bulletin when classified patients are billed stops which
- +1 ; are exempt from the classification process.
- +2 NEW IBT,IBC,IBPT,IBDUZ
- SET IBPT=$$PT^IBEFUNC(DFN)
- +3 SET XMSUB="CHARGE FOR STOP CODE EXEMPT FROM CLASSIFICATION"
- +4 SET IBT(1)="The following patient, who has claimed exposure to "_$$CLTY
- +5 SET IBT(2)="was billed the Means Test outpatient copay for a stop code which is"
- +6 SET IBT(3)="exempt from classification:"
- +7 SET IBT(4)=" "
- SET IBC=4
- +8 SET IBDUZ=DUZ
- DO PAT^IBAERR1
- +9 SET Y=IBDAT
- DO DD^%DT
- +10 SET IBC=IBC+1
- SET IBT(IBC)="Stop Date: "_Y
- +11 SET IBC=IBC+1
- SET IBT(IBC)="Stop Code: "_$PIECE($GET(^DIC(40.7,+$PIECE(IBEVT,"^",3),0)),"^")
- +12 SET IBC=IBC+1
- SET IBT(IBC)=" "
- +13 SET IBC=IBC+1
- SET IBT(IBC)="Please check this patient's medical record to determine if the care provided"
- +14 SET IBC=IBC+1
- SET IBT(IBC)="was related to the claimed exposure, and, if related, cancel the charge."
- +15 DO MAIL^IBAERR1
- +16 KILL X,Y,XMSUB,XMY,XMTEXT,XMDUZ
- +17 QUIT
- +18 ;
- CLTY() ; Return the classification type
- +1 NEW X,Y
- DO CL^SDCO21(DFN,IBDAT,"",.X)
- SET Y=""
- +2 IF $DATA(X(1))
- SET Y="Agent Orange"
- GOTO CLTYQ
- +3 IF $DATA(X(2))
- SET Y="Ionizing Radiation"
- GOTO CLTYQ
- +4 IF $DATA(X(4))
- SET Y="Environmental Contaminants"
- CLTYQ QUIT Y_","
