- 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
