IBDFOSG1 ;ALB/MAF/AAS - SCANNED ENCOUNTERS WITH BILLING DATA CONT. ; JUL 6 1995
;;3.0;AUTOMATED INFO COLLECTION SYS;**29**;APR 24, 1997
;
START ; -- Loop thru clinics
N IBDFCLIN,IBQUIT
S IBQUIT=0
S ^TMP("GTOT",$J)="0^0^0^0^0^0^0^0^0"
F IBDFCLIN=0:0 S IBDFCLIN=$O(^SC(IBDFCLIN)) Q:'IBDFCLIN D CK(IBDFCLIN),BLD:'IBQUIT
Q
;
CHECK(CLIN) ;
; -- Check to see if clinic has a form and its one that
; is not for future use only.
N IBDFNODE,IBDFCL,HASFORM
S HASFORM=1
I $O(^SD(409.95,"B",+CLIN,0)) D
.S IBDFCL=$O(^SD(409.95,"B",+CLIN,0))
.S IBDFNODE=^SD(409.95,IBDFCL,0)
Q HASFORM
;
CK(XCL) ; -- Check clinic, division, form
Q:'$D(^SC(XCL,0))
S IBQUIT=0
S IBDFNODE=$G(^SC(XCL,0))
Q:$P(IBDFNODE,"^",3)'="C"
S IBDIVNM=$P($G(^DG(40.8,+$P(IBDFNODE,"^",15),0)),"^",1) I IBDIVNM="" S IBDIVNM=$S(IBDFMUL=0:$$PRIM^VASITE,1:"NOT SPECIFIED")
I VAUTD=0 Q:'$D(VAUTD(+$P(IBDFNODE,"^",15)))
I '$$CHECK(XCL) S IBQUIT=1 Q
S ^TMP("CTOT",$J,IBDIVNM,$P(IBDFNODE,"^",1))="0^0^0^0^0^0^0^0^0"
I '$D(^TMP("DTOT",$J,IBDIVNM)) S ^TMP("DTOT",$J,IBDIVNM)="0^0^0^0^0^0^0^0^0"
Q
;
BLD ; -- scan appts
F IBDFT=IBDFBEG:0 S IBDFT=$O(^SC(IBDFCLIN,"S",IBDFT)) Q:'IBDFT!($P(IBDFT,".",1)>IBDFEND) D
.F IBDFDA=0:0 S IBDFDA=$O(^SC(IBDFCLIN,"S",IBDFT,1,IBDFDA)) Q:'IBDFDA I $D(^SC(IBDFCLIN,"S",IBDFT,1,IBDFDA,0)) S IBDFSA=^(0) S DFN=+IBDFSA D CK1
Q
;
CK1 ; -- Check scheduling nodes, forms tracking, if scanned,
; patient insured, bill entered, bill printed,
; avg time from encounter to printed bill.
;
I $P($G(^DPT(DFN,"S",IBDFT,0)),"^",2)]"" Q
N IBDFXPC,IBDFYPC
S IBDFXPC=$P(IBDFNODE,"^",1) ;Clinic name
S IBDFYPC=$P($G(^DPT(+$G(DFN),0)),"^",1) ;patient name
;
I $D(^IBD(357.96,"APTAP",DFN,IBDFT)) S IBDFIFN=$O(^IBD(357.96,"APTAP",DFN,IBDFT,0)) I $P($G(^IBD(357.96,+IBDFIFN,0)),"^",11)>1,$P(^(0),"^",11)<5 D
.S (IBFLG1,IBFLG2,IBFLG3,IBFLG5,IBFLG6,IBFLG7,IBFLG8,IBFLG9)=0
.I $$INSURED^IBCNS1(DFN,IBDFT) S IBFLG3=1
.I '$D(^DGCR(399,"AOPV",DFN,$P(IBDFT,".",1))) D SET Q
.F IBDFNUM=0:0 S IBDFNUM=$O(^DGCR(399,"AOPV",DFN,$P(IBDFT,".",1),IBDFNUM)) Q:IBDFNUM']""!(IBFLG2) D
..S IBMCNODE=$G(^DGCR(399,IBDFNUM,0))
..S IBMCSND=$G(^DGCR(399,IBDFNUM,"S"))
..Q:$P(IBMCSND,"^",17) ;canceled date
..I 'IBFLG1,$P(IBMCSND,"^",1) D ;bill entered
...S IBFLG1=1,^TMP("IBD-ENTERED",$J,IBDFNUM)="",^TMP("IBD-ENTERED",$J,IBDIVNM,IBDFNUM,DFN)=""
..I $P(IBMCSND,"^",12),'$D(^TMP("IBD-PRINTED",$J,IBDFNUM)) S IBFLG2=1,^TMP("IBD-PRINTED",$J,IBDFNUM)="" ;bill printed
..;
..; -- find amount billed/received if unique bill
..I IBFLG2,'$D(^TMP("IBD-BILL",$J,IBDFNUM)) D
...S ^TMP("IBD-BILL",$J,IBDFNUM)=1
...S IBFLG6=+$P(^DGCR(399,IBDFNUM,"U1"),"^")
...S X=$$TPR^PRCAFN(IBDFNUM) S:X>0 IBFLG7=X
...S IBFLG8=1 ;is new unique bill
...S IBFLG9=+$P($G(^DGCR(399,IBDFNUM,"OP",0)),"^",4)
...Q
..Q
.;
.S X1=$S($P(IBMCSND,"^",12):$P(IBMCSND,"^",12),1:$G(VADAT("W"))),X2=IBDFT D ^%DTC S IBFLG5=X
.D SET
Q
SET ; -- Set counters in temp arrays
; Piece 1 := Number bills entered
; Piece 2 := Number bills generated
; Piece 3 := Number of forms scanned for patients with INS
; Piece 4 := Number of forms scanned
; Piece 5 := Number of days from encounter date to bill printed
; Piece 6 := amount billed (for unique bill)
; Piece 7 := amount received (for unique bills)
; Piece 8 := number of unique bills
; Piece 9 := Number of visit dates on bills in 8
;
S ^TMP("MCCR",$J,IBDIVNM,IBDFXPC,IBDFYPC,DFN,IBDFT)=IBDFCLIN_"^"_^IBD(357.96,IBDFIFN,0)
;
S IBDFTMP=^TMP("CTOT",$J,IBDIVNM,$P(IBDFNODE,"^",1))
S IBDFTMP1=^TMP("DTOT",$J,IBDIVNM)
S IBDFTMP2=^TMP("GTOT",$J)
;
I IBFLG1 D INC(1,1) ; Bills Entered
I IBFLG2 D INC(2,1) ; Bills Generated
I IBFLG3 D INC(3,1) ; With insurance
D INC(4,1) ; number scanned
I IBFLG5 D INC(5,IBFLG5) ;Days from encounter to Printed Bill
I IBFLG6 D INC(6,IBFLG6) ;Amount billed
I IBFLG7 D INC(7,IBFLG7) ;Amount Received
I IBFLG8 D INC(8,1) ; Number of Bills
I IBFLG9 D INC(9,IBFLG9) ;number of visits on bills
;
S ^TMP("CTOT",$J,IBDIVNM,$P(IBDFNODE,"^",1))=IBDFTMP
S ^TMP("DTOT",$J,IBDIVNM)=IBDFTMP1
S ^TMP("GTOT",$J)=IBDFTMP2
Q
;
INC(PIECE,VALUE) ;
; -- increment counters,
S $P(IBDFTMP,"^",PIECE)=$P(IBDFTMP,"^",PIECE)+VALUE
S $P(IBDFTMP1,"^",PIECE)=$P(IBDFTMP1,"^",PIECE)+VALUE
S $P(IBDFTMP2,"^",PIECE)=$P(IBDFTMP2,"^",PIECE)+VALUE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFOSG1 4487 printed Dec 13, 2024@02:53:04 Page 2
IBDFOSG1 ;ALB/MAF/AAS - SCANNED ENCOUNTERS WITH BILLING DATA CONT. ; JUL 6 1995
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**29**;APR 24, 1997
+2 ;
START ; -- Loop thru clinics
+1 NEW IBDFCLIN,IBQUIT
+2 SET IBQUIT=0
+3 SET ^TMP("GTOT",$JOB)="0^0^0^0^0^0^0^0^0"
+4 FOR IBDFCLIN=0:0
SET IBDFCLIN=$ORDER(^SC(IBDFCLIN))
if 'IBDFCLIN
QUIT
DO CK(IBDFCLIN)
if 'IBQUIT
DO BLD
+5 QUIT
+6 ;
CHECK(CLIN) ;
+1 ; -- Check to see if clinic has a form and its one that
+2 ; is not for future use only.
+3 NEW IBDFNODE,IBDFCL,HASFORM
+4 SET HASFORM=1
+5 IF $ORDER(^SD(409.95,"B",+CLIN,0))
Begin DoDot:1
+6 SET IBDFCL=$ORDER(^SD(409.95,"B",+CLIN,0))
+7 SET IBDFNODE=^SD(409.95,IBDFCL,0)
End DoDot:1
+8 QUIT HASFORM
+9 ;
CK(XCL) ; -- Check clinic, division, form
+1 if '$DATA(^SC(XCL,0))
QUIT
+2 SET IBQUIT=0
+3 SET IBDFNODE=$GET(^SC(XCL,0))
+4 if $PIECE(IBDFNODE,"^",3)'="C"
QUIT
+5 SET IBDIVNM=$PIECE($GET(^DG(40.8,+$PIECE(IBDFNODE,"^",15),0)),"^",1)
IF IBDIVNM=""
SET IBDIVNM=$SELECT(IBDFMUL=0:$$PRIM^VASITE,1:"NOT SPECIFIED")
+6 IF VAUTD=0
if '$DATA(VAUTD(+$PIECE(IBDFNODE,"^",15)))
QUIT
+7 IF '$$CHECK(XCL)
SET IBQUIT=1
QUIT
+8 SET ^TMP("CTOT",$JOB,IBDIVNM,$PIECE(IBDFNODE,"^",1))="0^0^0^0^0^0^0^0^0"
+9 IF '$DATA(^TMP("DTOT",$JOB,IBDIVNM))
SET ^TMP("DTOT",$JOB,IBDIVNM)="0^0^0^0^0^0^0^0^0"
+10 QUIT
+11 ;
BLD ; -- scan appts
+1 FOR IBDFT=IBDFBEG:0
SET IBDFT=$ORDER(^SC(IBDFCLIN,"S",IBDFT))
if 'IBDFT!($PIECE(IBDFT,".",1)>IBDFEND)
QUIT
Begin DoDot:1
+2 FOR IBDFDA=0:0
SET IBDFDA=$ORDER(^SC(IBDFCLIN,"S",IBDFT,1,IBDFDA))
if 'IBDFDA
QUIT
IF $DATA(^SC(IBDFCLIN,"S",IBDFT,1,IBDFDA,0))
SET IBDFSA=^(0)
SET DFN=+IBDFSA
DO CK1
End DoDot:1
+3 QUIT
+4 ;
CK1 ; -- Check scheduling nodes, forms tracking, if scanned,
+1 ; patient insured, bill entered, bill printed,
+2 ; avg time from encounter to printed bill.
+3 ;
+4 IF $PIECE($GET(^DPT(DFN,"S",IBDFT,0)),"^",2)]""
QUIT
+5 NEW IBDFXPC,IBDFYPC
+6 ;Clinic name
SET IBDFXPC=$PIECE(IBDFNODE,"^",1)
+7 ;patient name
SET IBDFYPC=$PIECE($GET(^DPT(+$GET(DFN),0)),"^",1)
+8 ;
+9 IF $DATA(^IBD(357.96,"APTAP",DFN,IBDFT))
SET IBDFIFN=$ORDER(^IBD(357.96,"APTAP",DFN,IBDFT,0))
IF $PIECE($GET(^IBD(357.96,+IBDFIFN,0)),"^",11)>1
IF $PIECE(^(0),"^",11)<5
Begin DoDot:1
+10 SET (IBFLG1,IBFLG2,IBFLG3,IBFLG5,IBFLG6,IBFLG7,IBFLG8,IBFLG9)=0
+11 IF $$INSURED^IBCNS1(DFN,IBDFT)
SET IBFLG3=1
+12 IF '$DATA(^DGCR(399,"AOPV",DFN,$PIECE(IBDFT,".",1)))
DO SET
QUIT
+13 FOR IBDFNUM=0:0
SET IBDFNUM=$ORDER(^DGCR(399,"AOPV",DFN,$PIECE(IBDFT,".",1),IBDFNUM))
if IBDFNUM']""!(IBFLG2)
QUIT
Begin DoDot:2
+14 SET IBMCNODE=$GET(^DGCR(399,IBDFNUM,0))
+15 SET IBMCSND=$GET(^DGCR(399,IBDFNUM,"S"))
+16 ;canceled date
if $PIECE(IBMCSND,"^",17)
QUIT
+17 ;bill entered
IF 'IBFLG1
IF $PIECE(IBMCSND,"^",1)
Begin DoDot:3
+18 SET IBFLG1=1
SET ^TMP("IBD-ENTERED",$JOB,IBDFNUM)=""
SET ^TMP("IBD-ENTERED",$JOB,IBDIVNM,IBDFNUM,DFN)=""
End DoDot:3
+19 ;bill printed
IF $PIECE(IBMCSND,"^",12)
IF '$DATA(^TMP("IBD-PRINTED",$JOB,IBDFNUM))
SET IBFLG2=1
SET ^TMP("IBD-PRINTED",$JOB,IBDFNUM)=""
+20 ;
+21 ; -- find amount billed/received if unique bill
+22 IF IBFLG2
IF '$DATA(^TMP("IBD-BILL",$JOB,IBDFNUM))
Begin DoDot:3
+23 SET ^TMP("IBD-BILL",$JOB,IBDFNUM)=1
+24 SET IBFLG6=+$PIECE(^DGCR(399,IBDFNUM,"U1"),"^")
+25 SET X=$$TPR^PRCAFN(IBDFNUM)
if X>0
SET IBFLG7=X
+26 ;is new unique bill
SET IBFLG8=1
+27 SET IBFLG9=+$PIECE($GET(^DGCR(399,IBDFNUM,"OP",0)),"^",4)
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 ;
+31 SET X1=$SELECT($PIECE(IBMCSND,"^",12):$PIECE(IBMCSND,"^",12),1:$GET(VADAT("W")))
SET X2=IBDFT
DO ^%DTC
SET IBFLG5=X
+32 DO SET
End DoDot:1
+33 QUIT
SET ; -- Set counters in temp arrays
+1 ; Piece 1 := Number bills entered
+2 ; Piece 2 := Number bills generated
+3 ; Piece 3 := Number of forms scanned for patients with INS
+4 ; Piece 4 := Number of forms scanned
+5 ; Piece 5 := Number of days from encounter date to bill printed
+6 ; Piece 6 := amount billed (for unique bill)
+7 ; Piece 7 := amount received (for unique bills)
+8 ; Piece 8 := number of unique bills
+9 ; Piece 9 := Number of visit dates on bills in 8
+10 ;
+11 SET ^TMP("MCCR",$JOB,IBDIVNM,IBDFXPC,IBDFYPC,DFN,IBDFT)=IBDFCLIN_"^"_^IBD(357.96,IBDFIFN,0)
+12 ;
+13 SET IBDFTMP=^TMP("CTOT",$JOB,IBDIVNM,$PIECE(IBDFNODE,"^",1))
+14 SET IBDFTMP1=^TMP("DTOT",$JOB,IBDIVNM)
+15 SET IBDFTMP2=^TMP("GTOT",$JOB)
+16 ;
+17 ; Bills Entered
IF IBFLG1
DO INC(1,1)
+18 ; Bills Generated
IF IBFLG2
DO INC(2,1)
+19 ; With insurance
IF IBFLG3
DO INC(3,1)
+20 ; number scanned
DO INC(4,1)
+21 ;Days from encounter to Printed Bill
IF IBFLG5
DO INC(5,IBFLG5)
+22 ;Amount billed
IF IBFLG6
DO INC(6,IBFLG6)
+23 ;Amount Received
IF IBFLG7
DO INC(7,IBFLG7)
+24 ; Number of Bills
IF IBFLG8
DO INC(8,1)
+25 ;number of visits on bills
IF IBFLG9
DO INC(9,IBFLG9)
+26 ;
+27 SET ^TMP("CTOT",$JOB,IBDIVNM,$PIECE(IBDFNODE,"^",1))=IBDFTMP
+28 SET ^TMP("DTOT",$JOB,IBDIVNM)=IBDFTMP1
+29 SET ^TMP("GTOT",$JOB)=IBDFTMP2
+30 QUIT
+31 ;
INC(PIECE,VALUE) ;
+1 ; -- increment counters,
+2 SET $PIECE(IBDFTMP,"^",PIECE)=$PIECE(IBDFTMP,"^",PIECE)+VALUE
+3 SET $PIECE(IBDFTMP1,"^",PIECE)=$PIECE(IBDFTMP1,"^",PIECE)+VALUE
+4 SET $PIECE(IBDFTMP2,"^",PIECE)=$PIECE(IBDFTMP2,"^",PIECE)+VALUE
+5 QUIT
