- IBCONS2 ;ALB/CPM - NSC W/INSURANCE OUTPUT (CON'T) ; 31-JAN-92
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- ;MAP TO DGCRONS2
- ;
- LOOP1 ; Compilation for both Inpatient Admisssion and Discharge reports.
- N DA,IBADM
- D DIV
- F I=(IBBEG-.0001):0 S I=$O(^DGPM(IBSUB,I)) Q:'I!(I>(IBEND+.99)) D
- . S DFN=0 F S DFN=$O(^DGPM(IBSUB,I,DFN)) Q:'DFN S DA=+$O(^(DFN,0)) D D:PTF PTF I '$G(IBSC),$G(IBDV) D PROC K IBADMVT
- .. S:IBINPT=2 DA=+$P($G(^DGPM(DA,0)),"^",14),IBADM=+$G(^DGPM(DA,0))
- .. S PTF=$P($G(^DGPM(DA,0)),"^",16)
- .. S IBADMVT=DA
- .. S IBDV=+$P($G(^DIC(42,+$P($G(^DGPM(DA,0)),"^",6),0)),"^",11)
- Q
- ;
- ;
- LOOP2 ; Compilation for the Outpatient report.
- D DIV
- DIS F I=IBBEG-.0001:0 S I=$O(^DPT("ADIS",I)) Q:'I!(I>(IBEND+.99)) D
- . F DFN=0:0 S DFN=$O(^DPT("ADIS",I,DFN)) Q:'DFN S J=$O(^(DFN,0)) D
- .. S IBOE="" I $D(^DPT(DFN,"DIS",J,0)) S IBOE=$P($G(^DPT(DFN,"DIS",J,0)),"^",18)
- .. I $D(^DPT(DFN,"DIS",J,0)),$P(^(0),U,2)<2 S IBSTOP="Registration: "_$P($G(^DIC(37,+$P(^(0),U,7),0)),"^"),IBDV=$P(^DPT(DFN,"DIS",J,0),"^",4) D PROC
- ;
- ADD F I=IBBEG-.0001:0 S I=$O(^SDV(I)) Q:'I!(I>(IBEND+.99)) S X=$G(^(I,0)) D
- . K IBOE
- . S DFN=$P(X,"^",2),IBDV=$P(X,"^",3) Q:'$D(^DPT(+DFN,0))
- . F N=0:0 S N=$O(^SDV(I,"CS",N)) Q:'N I $$RPT^IBEFUNC(+$P($G(^(N,0)),"^",5),I) D D PROC Q
- ..S IBOE=$G(IBOE)_$P($G(^SDV(I,"CS",N,0)),"^",8)_"^"
- ..N X S X=0
- ..S IBSTOP="Add/Edit Stop Code^"
- ..F S X=$O(^SDV(I,"CS","B",X)) Q:'X S IBSTOP=IBSTOP_$P($G(^DIC(40.7,+X,0)),"^",2)_"^"
- ;
- CLIN F IBDC=0:0 S IBDC=$O(^SC("AC","C",IBDC)) Q:'IBDC I $D(^SC(IBDC,0)),$P(^(0),"^",17)="N" F I=IBBEG-.0001:0 S I=$O(^SC(IBDC,"S",I)) Q:'I!(I>(IBEND+.99)) F IBDFN=0:0 S IBDFN=$O(^SC(IBDC,"S",I,1,IBDFN)) Q:IBDFN<1 D CLIN1
- Q
- ;
- CLIN1 I $D(^SC(IBDC,"S",I,1,IBDFN,0)) S IBAPPT=^(0),DFN=+IBAPPT I $P(IBAPPT,"^",9)'="C",$D(^DPT(DFN,"S",I,0)),$P(^(0),"^",2)']"",$$RPT^IBEFUNC(+$P(^(0),"^",16),I) S IBOE=$P(^DPT(DFN,"S",I,0),"^",20),IBDV=$P(^SC(IBDC,0),"^",15) D STOPS,PROC
- Q
- ;
- STOPS ; -finds stops
- N X
- S X=$G(^DPT(DFN,"S",I,0)) S IBSTOP="Clinic: "_$P(^SC(IBDC,0),"^")_"^"
- I X'="" S IBSTOP=IBSTOP_$S(+$P(X,"^",3):"LAB^",1:"")_$S(+$P(X,"^",4):"X-RAY^",1:"")_$S(+$P(X,"^",5):"EKG^",1:"")
- Q
- ;
- PROC ; -process each episode of care
- I VAUTD'=1 Q:'$D(VAUTD(+IBDV))
- I VAUTD=1 Q:'+IBDV
- D PTCHK Q:'IBFLAG ; -is patient a vet and have ins data
- D INS Q:'IBFLAG ; -is insurance valid for date of care
- K IBRMARK
- D TRACK^IBCONS3 ; -find tracking entry get reason not billable
- D BILL,SET ; -on billed or unbilled list
- Q
- ;
- INS ;S IBINDT=I D ^IBCNS S IBFLAG=$S('$D(IBINS):0,1:IBINS)
- S IBFLAG=$$INSURED^IBCNS1(DFN,I)
- Q
- ;
- PTCHK S IBFLAG=0 I $D(^DPT(+DFN,.312)),$G(^("VET"))="Y" S IBFLAG=1
- Q
- ;
- SET N TERMD,DPT0,SSN S DPT0=$G(^DPT(+DFN,0)),SSN=$P(DPT0,"^",9)
- S TERMD=$S(IBTERM:$E(SSN,8,9)_$E(SSN,6,7)_$E(SSN,4,5)_$E(SSN,1,3),1:0)
- S ^TMP($J,IBDV,$S(B]"":2,1:1),$S(IBTERM:+TERMD,1:$P(DPT0,"^")),DFN,I)=B I $D(IBSTOP),'$D(^(I,1)) S ^(1)=IBSTOP
- I $G(IBRMARK)'="" S ^TMP($J,IBDV,$S(B]"":2,1:1),$S(IBTERM:+TERMD,1:$P(DPT0,"^")),DFN,I,2)=$G(IBRMARK)
- K IBSTOP,IBRMARK
- Q
- ;
- BILL ; Add to billed list if is insurance bill, not canceled
- ; if opt, date is in list, if inpt, admission date = event date
- ;
- S B="",I1=$S(IBINPT=2:IBADM,IBINPT:I,1:I\1)
- I IBINPT,$D(^DGCR(399,"C",DFN)) F M=0:0 S M=$O(^DGCR(399,"C",DFN,M)) Q:'M I $D(^DGCR(399,M,0)),$P(^(0),"^",13)<7,$P($P(^(0),"^",3),".")=$P(I1,"."),$P(^(0),"^",11)="i" S B=B_M_"^" Q:$L(B)>200
- I 'IBINPT,$D(^DGCR(399,"AOPV",DFN,I1)) F M=0:0 S M=$O(^DGCR(399,"AOPV",DFN,I1,M)) Q:'M I $P(^DGCR(399,M,0),"^",13)<7,$P(^(0),"^",11)="i" S B=B_M_"^" Q:$L(B)>200
- Q
- ;
- PTF ; if all movements are for sc condition then not billable
- ;
- S IBSC="" Q:'$D(^DGPT(+PTF))
- S IBMOV=0 F S IBMOV=$O(^DGPT(PTF,"M",IBMOV)) Q:'IBMOV S IBSC=$P($G(^(IBMOV,0)),"^",18) I IBSC=2!(IBSC="") Q
- S IBSC=$S(IBSC=2!(IBSC=""):0,1:1)
- Q
- DIV ;adds the requested divisions to the report
- N IBDIV
- I VAUTD'=1 D
- .S IBDIV="" F S IBDIV=$O(VAUTD(IBDIV)) Q:'IBDIV S ^TMP($J,IBDIV)=""
- I VAUTD=1 D
- .S IBDIV="" F S IBDIV=$O(^DG(40.8,IBDIV)) Q:IBDIV']""!(+IBDIV'=IBDIV) I $P($G(^DG(40.8,IBDIV,0)),"^",1)]"" S ^TMP($J,IBDIV)=""
- Q
- IBCONS2 ;ALB/CPM - NSC W/INSURANCE OUTPUT (CON'T) ; 31-JAN-92
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- +3 ;MAP TO DGCRONS2
- +4 ;
- LOOP1 ; Compilation for both Inpatient Admisssion and Discharge reports.
- +1 NEW DA,IBADM
- +2 DO DIV
- +3 FOR I=(IBBEG-.0001):0
- SET I=$ORDER(^DGPM(IBSUB,I))
- IF 'I!(I>(IBEND+.99))
- QUIT
- Begin DoDot:1
- +4 SET DFN=0
- FOR
- SET DFN=$ORDER(^DGPM(IBSUB,I,DFN))
- IF 'DFN
- QUIT
- SET DA=+$ORDER(^(DFN,0))
- Begin DoDot:2
- +5 IF IBINPT=2
- SET DA=+$PIECE($GET(^DGPM(DA,0)),"^",14)
- SET IBADM=+$GET(^DGPM(DA,0))
- +6 SET PTF=$PIECE($GET(^DGPM(DA,0)),"^",16)
- +7 SET IBADMVT=DA
- +8 SET IBDV=+$PIECE($GET(^DIC(42,+$PIECE($GET(^DGPM(DA,0)),"^",6),0)),"^",11)
- End DoDot:2
- IF PTF
- DO PTF
- IF '$GET(IBSC)
- IF $GET(IBDV)
- DO PROC
- KILL IBADMVT
- End DoDot:1
- +9 QUIT
- +10 ;
- +11 ;
- LOOP2 ; Compilation for the Outpatient report.
- +1 DO DIV
- DIS FOR I=IBBEG-.0001:0
- SET I=$ORDER(^DPT("ADIS",I))
- IF 'I!(I>(IBEND+.99))
- QUIT
- Begin DoDot:1
- +1 FOR DFN=0:0
- SET DFN=$ORDER(^DPT("ADIS",I,DFN))
- IF 'DFN
- QUIT
- SET J=$ORDER(^(DFN,0))
- Begin DoDot:2
- +2 SET IBOE=""
- IF $DATA(^DPT(DFN,"DIS",J,0))
- SET IBOE=$PIECE($GET(^DPT(DFN,"DIS",J,0)),"^",18)
- +3 IF $DATA(^DPT(DFN,"DIS",J,0))
- IF $PIECE(^(0),U,2)<2
- SET IBSTOP="Registration: "_$PIECE($GET(^DIC(37,+$PIECE(^(0),U,7),0)),"^")
- SET IBDV=$PIECE(^DPT(DFN,"DIS",J,0),"^",4)
- DO PROC
- End DoDot:2
- End DoDot:1
- +4 ;
- ADD FOR I=IBBEG-.0001:0
- SET I=$ORDER(^SDV(I))
- IF 'I!(I>(IBEND+.99))
- QUIT
- SET X=$GET(^(I,0))
- Begin DoDot:1
- +1 KILL IBOE
- +2 SET DFN=$PIECE(X,"^",2)
- SET IBDV=$PIECE(X,"^",3)
- IF '$DATA(^DPT(+DFN,0))
- QUIT
- +3 FOR N=0:0
- SET N=$ORDER(^SDV(I,"CS",N))
- IF 'N
- QUIT
- IF $$RPT^IBEFUNC(+$PIECE($GET(^(N,0)),"^",5),I)
- Begin DoDot:2
- +4 SET IBOE=$GET(IBOE)_$PIECE($GET(^SDV(I,"CS",N,0)),"^",8)_"^"
- +5 NEW X
- SET X=0
- +6 SET IBSTOP="Add/Edit Stop Code^"
- +7 FOR
- SET X=$ORDER(^SDV(I,"CS","B",X))
- IF 'X
- QUIT
- SET IBSTOP=IBSTOP_$PIECE($GET(^DIC(40.7,+X,0)),"^",2)_"^"
- End DoDot:2
- DO PROC
- QUIT
- End DoDot:1
- +8 ;
- CLIN FOR IBDC=0:0
- SET IBDC=$ORDER(^SC("AC","C",IBDC))
- IF 'IBDC
- QUIT
- IF $DATA(^SC(IBDC,0))
- IF $PIECE(^(0),"^",17)="N"
- FOR I=IBBEG-.0001:0
- SET I=$ORDER(^SC(IBDC,"S",I))
- IF 'I!(I>(IBEND+.99))
- QUIT
- FOR IBDFN=0:0
- SET IBDFN=$ORDER(^SC(IBDC,"S",I,1,IBDFN))
- IF IBDFN<1
- QUIT
- DO CLIN1
- +1 QUIT
- +2 ;
- CLIN1 IF $DATA(^SC(IBDC,"S",I,1,IBDFN,0))
- SET IBAPPT=^(0)
- SET DFN=+IBAPPT
- IF $PIECE(IBAPPT,"^",9)'="C"
- IF $DATA(^DPT(DFN,"S",I,0))
- IF $PIECE(^(0),"^",2)']""
- IF $$RPT^IBEFUNC(+$PIECE(^(0),"^",16),I)
- SET IBOE=$PIECE(^DPT(DFN,"S",I,0),"^",20)
- SET IBDV=$PIECE(^SC(IBDC,0),"^",15)
- DO STOPS
- DO PROC
- +1 QUIT
- +2 ;
- STOPS ; -finds stops
- +1 NEW X
- +2 SET X=$GET(^DPT(DFN,"S",I,0))
- SET IBSTOP="Clinic: "_$PIECE(^SC(IBDC,0),"^")_"^"
- +3 IF X'=""
- SET IBSTOP=IBSTOP_$SELECT(+$PIECE(X,"^",3):"LAB^",1:"")_$SELECT(+$PIECE(X,"^",4):"X-RAY^",1:"")_$SELECT(+$PIECE(X,"^",5):"EKG^",1:"")
- +4 QUIT
- +5 ;
- PROC ; -process each episode of care
- +1 IF VAUTD'=1
- IF '$DATA(VAUTD(+IBDV))
- QUIT
- +2 IF VAUTD=1
- IF '+IBDV
- QUIT
- +3 ; -is patient a vet and have ins data
- DO PTCHK
- IF 'IBFLAG
- QUIT
- +4 ; -is insurance valid for date of care
- DO INS
- IF 'IBFLAG
- QUIT
- +5 KILL IBRMARK
- +6 ; -find tracking entry get reason not billable
- DO TRACK^IBCONS3
- +7 ; -on billed or unbilled list
- DO BILL
- DO SET
- +8 QUIT
- +9 ;
- INS ;S IBINDT=I D ^IBCNS S IBFLAG=$S('$D(IBINS):0,1:IBINS)
- +1 SET IBFLAG=$$INSURED^IBCNS1(DFN,I)
- +2 QUIT
- +3 ;
- PTCHK SET IBFLAG=0
- IF $DATA(^DPT(+DFN,.312))
- IF $GET(^("VET"))="Y"
- SET IBFLAG=1
- +1 QUIT
- +2 ;
- SET NEW TERMD,DPT0,SSN
- SET DPT0=$GET(^DPT(+DFN,0))
- SET SSN=$PIECE(DPT0,"^",9)
- +1 SET TERMD=$SELECT(IBTERM:$EXTRACT(SSN,8,9)_$EXTRACT(SSN,6,7)_$EXTRACT(SSN,4,5)_$EXTRACT(SSN,1,3),1:0)
- +2 SET ^TMP($JOB,IBDV,$SELECT(B]"":2,1:1),$SELECT(IBTERM:+TERMD,1:$PIECE(DPT0,"^")),DFN,I)=B
- IF $DATA(IBSTOP)
- IF '$DATA(^(I,1))
- SET ^(1)=IBSTOP
- +3 IF $GET(IBRMARK)'=""
- SET ^TMP($JOB,IBDV,$SELECT(B]"":2,1:1),$SELECT(IBTERM:+TERMD,1:$PIECE(DPT0,"^")),DFN,I,2)=$GET(IBRMARK)
- +4 KILL IBSTOP,IBRMARK
- +5 QUIT
- +6 ;
- BILL ; Add to billed list if is insurance bill, not canceled
- +1 ; if opt, date is in list, if inpt, admission date = event date
- +2 ;
- +3 SET B=""
- SET I1=$SELECT(IBINPT=2:IBADM,IBINPT:I,1:I\1)
- +4 IF IBINPT
- IF $DATA(^DGCR(399,"C",DFN))
- FOR M=0:0
- SET M=$ORDER(^DGCR(399,"C",DFN,M))
- IF 'M
- QUIT
- IF $DATA(^DGCR(399,M,0))
- IF $PIECE(^(0),"^",13)<7
- IF $PIECE($PIECE(^(0),"^",3),".")=$PIECE(I1,".")
- IF $PIECE(^(0),"^",11)="i"
- SET B=B_M_"^"
- IF $LENGTH(B)>200
- QUIT
- +5 IF 'IBINPT
- IF $DATA(^DGCR(399,"AOPV",DFN,I1))
- FOR M=0:0
- SET M=$ORDER(^DGCR(399,"AOPV",DFN,I1,M))
- IF 'M
- QUIT
- IF $PIECE(^DGCR(399,M,0),"^",13)<7
- IF $PIECE(^(0),"^",11)="i"
- SET B=B_M_"^"
- IF $LENGTH(B)>200
- QUIT
- +6 QUIT
- +7 ;
- PTF ; if all movements are for sc condition then not billable
- +1 ;
- +2 SET IBSC=""
- IF '$DATA(^DGPT(+PTF))
- QUIT
- +3 SET IBMOV=0
- FOR
- SET IBMOV=$ORDER(^DGPT(PTF,"M",IBMOV))
- IF 'IBMOV
- QUIT
- SET IBSC=$PIECE($GET(^(IBMOV,0)),"^",18)
- IF IBSC=2!(IBSC="")
- QUIT
- +4 SET IBSC=$SELECT(IBSC=2!(IBSC=""):0,1:1)
- +5 QUIT
- DIV ;adds the requested divisions to the report
- +1 NEW IBDIV
- +2 IF VAUTD'=1
- Begin DoDot:1
- +3 SET IBDIV=""
- FOR
- SET IBDIV=$ORDER(VAUTD(IBDIV))
- IF 'IBDIV
- QUIT
- SET ^TMP($JOB,IBDIV)=""
- End DoDot:1
- +4 IF VAUTD=1
- Begin DoDot:1
- +5 SET IBDIV=""
- FOR
- SET IBDIV=$ORDER(^DG(40.8,IBDIV))
- IF IBDIV']""!(+IBDIV'=IBDIV)
- QUIT
- IF $PIECE($GET(^DG(40.8,IBDIV,0)),"^",1)]""
- SET ^TMP($JOB,IBDIV)=""
- End DoDot:1
- +6 QUIT
