ABMUITIN ; IHS/SD/SDR - 3PB/UFMS TIN report
;;2.6;IHS 3P BILLING SYSTEM;**10,11**;NOV 12, 2009;Build 133
;
EP ;EP
K ABMTCNT,ABML,ABMCNT,ABM
K DIR
S DIR(0)="S^1:Insurers with TIN;2:Insurers without TIN;3:Both"
S DIR("A")="Which insurers would you like to see"
D ^DIR K DIR
G:$D(DIROUT)!$D(DTOUT)!$D(DUOUT)!$D(DIRUT) XIT
S ABMWINS=Y
;
S DIR(0)="S^B:Billing Address;M:Mailing Address"
S DIR("A")="Which address would you like to see on the report"
D ^DIR K DIR
G:$D(DIROUT)!$D(DTOUT)!$D(DUOUT)!$D(DIRUT) XIT
S ABMADD=Y
;
;this next part will ask for a time frame. This will be used to go
;through claims for that many years and find the active insurers on them
;and they will be the only insurers to print on report.
W !!
S X1=DT
S X2=-1825
D C^%DTC
S ABMTIME=X
S X1=DT
S X2=-365
D C^%DTC
S ABMDFLT=X
K DIR
S DIR(0)="D^"_ABMTIME_":DT:X"
S DIR("A",1)="This report prints insurers that have been billed back to a user-selected date."
S DIR("A")="Please select date for report"
S DIR("B")=$$SDT^ABMDUTL(ABMDFLT)
D ^DIR K DIR
G:$D(DIROUT)!$D(DTOUT)!$D(DUOUT)!$D(DIRUT) XIT
S ABMTIME=Y
;
W !!!
HD I ABMWINS=1 S ABM("HD",0)="Insurers with TIN"
I ABMWINS=2 S ABM("HD",0)="Insurers without TIN"
I ABMWINS=3 S ABM("HD",0)="Insurers with and without TIN"
S ABM("PG")=1
S ABMY("LOC")=DUZ(2)
S ABM("LVL")=0
S ABM("CONJ")=""
S ABM("TXT")=""
S ABMQ("RX")="XIT^ABMUITIN"
S ABMQ("NS")="ABM"
S ABMQ("RP")="LOOP^ABMUITIN"
D ^ABMDRDBQ
Q
LOOP ;create list of insurers to print
;
S ABMDTLP=ABMTIME-.5
F S ABMDTLP=$O(^ABMDBILL(DUZ(2),"AP",ABMDTLP)) Q:+ABMDTLP=0 D
.S ABMBDFN=0
.F S ABMBDFN=$O(^ABMDBILL(DUZ(2),"AP",ABMDTLP,ABMBDFN)) Q:+ABMBDFN=0 D
..I $P($G(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,8)'="" D
...S ABMAINS=$P($G(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,8)
...;S ABMITYP=$P($G(^AUTNINS(ABMAINS,2)),U) ;abm*2.6*10 HEAT73780
...S ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMAINS,".211","I"),1,"I") ;abm*2.6*10 HEAT73780
...S ABMINAM=$P($G(^AUTNINS(ABMAINS,0)),U)
...Q:ABMITYP="N"!(ABMITYP="I") ;don't check Ben or Non-Ben
...I $G(ABM(ABMAINS))="" S ABMTCNT=+$G(ABMTCNT)+1,ABM(ABMAINS)=1
...I ABMWINS=2,($P($G(^AUTNINS(ABMAINS,0)),U,11)'="") Q
...I ABMWINS=1,($P($G(^AUTNINS(ABMAINS,0)),U,11)="") Q
...;S ABMITYP=$P($G(^AUTNINS(ABMAINS,2)),U) ;abm*2.6*10 HEAT73780
...S ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMAINS,".211","I"),1,"I") ;abm*2.6*10 HEAT73780
...S ABMINAM=$P($G(^AUTNINS(ABMAINS,0)),U)
...S ABML(ABMITYP,ABMINAM,ABMAINS)=""
D PRINT
Q
PRINT ; print insurers
D WHD^ABMDRHD G XIT:'$D(IO)!$G(POP)!$D(DTOUT)!$D(DUOUT)
W !,"INSURER (IEN)",?35,"TIN"
W !?5,"Address",?37,"City",?53,"ST",?56,"Zip",?67,"Phone"
W !
F ABMI=1:1:80 W "-"
S ABMITYP=0
F S ABMITYP=$O(ABML(ABMITYP)) Q:ABMITYP="" D
.;W !!?3,$P($T(@ABMITYP^ABMUCASH),";;",2) ;abm*2.6*11 insurer type
.W !!?3,$$INSTYP^ABMUCASH(ABMITYP) ;abm*2.6*11 insurer type
.S ABMINAM=""
.F S ABMINAM=$O(ABML(ABMITYP,ABMINAM)) Q:ABMINAM="" D
..S ABMI=0
..F S ABMI=$O(ABML(ABMITYP,ABMINAM,ABMI)) Q:+ABMI=0 D
...W !,ABMINAM,"(",ABMI,")"
...D GETS^DIQ("9999999.18",ABMI,".01;.02;.03;.04;.05;.06;.11;2;3;4;5","IE","ABMC")
...S ABMTIN=$G(ABMC("9999999.18",ABMI_",",".11","E"))
...W ?35,ABMTIN
...W !?5
...I ABMADD="M" D
....W $G(ABMC("9999999.18",ABMI_",",".02","E"))
....W ?37,$G(ABMC("9999999.18",ABMI_",",".03","E"))
....W:$G(ABMC("9999999.18",ABMI_",",".04","I"))'="" ?53,$P($G(^DIC(5,$G(ABMC("9999999.18",ABMI_",",".04","I")),0)),U,2)
....W ?56,$G(ABMC("9999999.18",ABMI_",",".05","E"))
...I ABMADD="B" D
....W $G(ABMC("9999999.18",ABMI_",","2","E"))
....W ?37,$G(ABMC("9999999.18",ABMI_",","3","E"))
....W:$G(ABMC("9999999.18",ABMI_",","4","I"))'="" ?53,$P($G(^DIC(5,$G(ABMC("9999999.18",ABMI_",","4","I")),0)),U,2)
....W ?56,$P($G(ABMC("9999999.18",ABMI_",","5","E")),"-")
...W ?67,$G(ABMC("9999999.18",ABMI_",",".06","E"))
...S ABMCNT=+$G(ABMCNT)+1
...I $Y>(IOSL-5) D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT) S ABM("PG")=+$G(ABM("PG"))+1 D WHD^ABMDRHD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W " (cont)"
I +$G(ABMCNT)>0 D
.W !!?35,"TOTAL INSURERS WITH"_$S(ABMWINS=2:"OUT",ABMWINS=3:" AND WITHOUT",1:"")_" TIN: ",ABMCNT
.W !!?35,"TOTAL INSURER COUNT: ",ABMTCNT
Q
XIT ;
K ABMWINS,DIC,DIE,X,Y,DA,ABMC,ABMI,ABMTIME
K ABML,ABM,ABMCNT,ABMTCNT
Q
ABMUITIN ; IHS/SD/SDR - 3PB/UFMS TIN report
+1 ;;2.6;IHS 3P BILLING SYSTEM;**10,11**;NOV 12, 2009;Build 133
+2 ;
EP ;EP
+1 KILL ABMTCNT,ABML,ABMCNT,ABM
+2 KILL DIR
+3 SET DIR(0)="S^1:Insurers with TIN;2:Insurers without TIN;3:Both"
+4 SET DIR("A")="Which insurers would you like to see"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)
GOTO XIT
+7 SET ABMWINS=Y
+8 ;
+9 SET DIR(0)="S^B:Billing Address;M:Mailing Address"
+10 SET DIR("A")="Which address would you like to see on the report"
+11 DO ^DIR
KILL DIR
+12 IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)
GOTO XIT
+13 SET ABMADD=Y
+14 ;
+15 ;this next part will ask for a time frame. This will be used to go
+16 ;through claims for that many years and find the active insurers on them
+17 ;and they will be the only insurers to print on report.
+18 WRITE !!
+19 SET X1=DT
+20 SET X2=-1825
+21 DO C^%DTC
+22 SET ABMTIME=X
+23 SET X1=DT
+24 SET X2=-365
+25 DO C^%DTC
+26 SET ABMDFLT=X
+27 KILL DIR
+28 SET DIR(0)="D^"_ABMTIME_":DT:X"
+29 SET DIR("A",1)="This report prints insurers that have been billed back to a user-selected date."
+30 SET DIR("A")="Please select date for report"
+31 SET DIR("B")=$$SDT^ABMDUTL(ABMDFLT)
+32 DO ^DIR
KILL DIR
+33 IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)
GOTO XIT
+34 SET ABMTIME=Y
+35 ;
+36 WRITE !!!
HD IF ABMWINS=1
SET ABM("HD",0)="Insurers with TIN"
+1 IF ABMWINS=2
SET ABM("HD",0)="Insurers without TIN"
+2 IF ABMWINS=3
SET ABM("HD",0)="Insurers with and without TIN"
+3 SET ABM("PG")=1
+4 SET ABMY("LOC")=DUZ(2)
+5 SET ABM("LVL")=0
+6 SET ABM("CONJ")=""
+7 SET ABM("TXT")=""
+8 SET ABMQ("RX")="XIT^ABMUITIN"
+9 SET ABMQ("NS")="ABM"
+10 SET ABMQ("RP")="LOOP^ABMUITIN"
+11 DO ^ABMDRDBQ
+12 QUIT
LOOP ;create list of insurers to print
+1 ;
+2 SET ABMDTLP=ABMTIME-.5
+3 FOR
SET ABMDTLP=$ORDER(^ABMDBILL(DUZ(2),"AP",ABMDTLP))
IF +ABMDTLP=0
QUIT
Begin DoDot:1
+4 SET ABMBDFN=0
+5 FOR
SET ABMBDFN=$ORDER(^ABMDBILL(DUZ(2),"AP",ABMDTLP,ABMBDFN))
IF +ABMBDFN=0
QUIT
Begin DoDot:2
+6 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,8)'=""
Begin DoDot:3
+7 SET ABMAINS=$PIECE($GET(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,8)
+8 ;S ABMITYP=$P($G(^AUTNINS(ABMAINS,2)),U) ;abm*2.6*10 HEAT73780
+9 ;abm*2.6*10 HEAT73780
SET ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMAINS,".211","I"),1,"I")
+10 SET ABMINAM=$PIECE($GET(^AUTNINS(ABMAINS,0)),U)
+11 ;don't check Ben or Non-Ben
IF ABMITYP="N"!(ABMITYP="I")
QUIT
+12 IF $GET(ABM(ABMAINS))=""
SET ABMTCNT=+$GET(ABMTCNT)+1
SET ABM(ABMAINS)=1
+13 IF ABMWINS=2
IF ($PIECE($GET(^AUTNINS(ABMAINS,0)),U,11)'="")
QUIT
+14 IF ABMWINS=1
IF ($PIECE($GET(^AUTNINS(ABMAINS,0)),U,11)="")
QUIT
+15 ;S ABMITYP=$P($G(^AUTNINS(ABMAINS,2)),U) ;abm*2.6*10 HEAT73780
+16 ;abm*2.6*10 HEAT73780
SET ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMAINS,".211","I"),1,"I")
+17 SET ABMINAM=$PIECE($GET(^AUTNINS(ABMAINS,0)),U)
+18 SET ABML(ABMITYP,ABMINAM,ABMAINS)=""
End DoDot:3
End DoDot:2
End DoDot:1
+19 DO PRINT
+20 QUIT
PRINT ; print insurers
+1 DO WHD^ABMDRHD
IF '$DATA(IO)!$GET(POP)!$DATA(DTOUT)!$DATA(DUOUT)
GOTO XIT
+2 WRITE !,"INSURER (IEN)",?35,"TIN"
+3 WRITE !?5,"Address",?37,"City",?53,"ST",?56,"Zip",?67,"Phone"
+4 WRITE !
+5 FOR ABMI=1:1:80
WRITE "-"
+6 SET ABMITYP=0
+7 FOR
SET ABMITYP=$ORDER(ABML(ABMITYP))
IF ABMITYP=""
QUIT
Begin DoDot:1
+8 ;W !!?3,$P($T(@ABMITYP^ABMUCASH),";;",2) ;abm*2.6*11 insurer type
+9 ;abm*2.6*11 insurer type
WRITE !!?3,$$INSTYP^ABMUCASH(ABMITYP)
+10 SET ABMINAM=""
+11 FOR
SET ABMINAM=$ORDER(ABML(ABMITYP,ABMINAM))
IF ABMINAM=""
QUIT
Begin DoDot:2
+12 SET ABMI=0
+13 FOR
SET ABMI=$ORDER(ABML(ABMITYP,ABMINAM,ABMI))
IF +ABMI=0
QUIT
Begin DoDot:3
+14 WRITE !,ABMINAM,"(",ABMI,")"
+15 DO GETS^DIQ("9999999.18",ABMI,".01;.02;.03;.04;.05;.06;.11;2;3;4;5","IE","ABMC")
+16 SET ABMTIN=$GET(ABMC("9999999.18",ABMI_",",".11","E"))
+17 WRITE ?35,ABMTIN
+18 WRITE !?5
+19 IF ABMADD="M"
Begin DoDot:4
+20 WRITE $GET(ABMC("9999999.18",ABMI_",",".02","E"))
+21 WRITE ?37,$GET(ABMC("9999999.18",ABMI_",",".03","E"))
+22 IF $GET(ABMC("9999999.18",ABMI_",",".04","I"))'=""
WRITE ?53,$PIECE($GET(^DIC(5,$GET(ABMC("9999999.18",ABMI_",",".04","I")),0)),U,2)
+23 WRITE ?56,$GET(ABMC("9999999.18",ABMI_",",".05","E"))
End DoDot:4
+24 IF ABMADD="B"
Begin DoDot:4
+25 WRITE $GET(ABMC("9999999.18",ABMI_",","2","E"))
+26 WRITE ?37,$GET(ABMC("9999999.18",ABMI_",","3","E"))
+27 IF $GET(ABMC("9999999.18",ABMI_",","4","I"))'=""
WRITE ?53,$PIECE($GET(^DIC(5,$GET(ABMC("9999999.18",ABMI_",","4","I")),0)),U,2)
+28 WRITE ?56,$PIECE($GET(ABMC("9999999.18",ABMI_",","5","E")),"-")
End DoDot:4
+29 WRITE ?67,$GET(ABMC("9999999.18",ABMI_",",".06","E"))
+30 SET ABMCNT=+$GET(ABMCNT)+1
+31 IF $Y>(IOSL-5)
DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!$DATA(DIRUT)
QUIT
SET ABM("PG")=+$GET(ABM("PG"))+1
DO WHD^ABMDRHD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
WRITE " (cont)"
End DoDot:3
End DoDot:2
End DoDot:1
+32 IF +$GET(ABMCNT)>0
Begin DoDot:1
+33 WRITE !!?35,"TOTAL INSURERS WITH"_$SELECT(ABMWINS=2:"OUT",ABMWINS=3:" AND WITHOUT",1:"")_" TIN: ",ABMCNT
+34 WRITE !!?35,"TOTAL INSURER COUNT: ",ABMTCNT
End DoDot:1
+35 QUIT
XIT ;
+1 KILL ABMWINS,DIC,DIE,X,Y,DA,ABMC,ABMI,ABMTIME
+2 KILL ABML,ABM,ABMCNT,ABMTCNT
+3 QUIT
