- ABMUPTIN ; IHS/SD/SDR - 3PB/UFMS Pseudo TIN report
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;
- ; New routine - v2.5 p12 SDD item 4.9.3.1
- ;
- EP ;
- 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
- G:$D(DIROUT)!$D(DTOUT)!$D(DUOUT)!$D(DIRUT) XIT
- S ABMADD=Y
- S ABM("HD",0)="===== INSURER LISTING WITH PSEUDO TINS ====="
- S ABMY("LOC")=DUZ(2)
- S ABM("LVL")=0
- S ABM("CONJ")=""
- S ABM("TXT")=""
- S ABM("PG")=1
- D LOC^ABMDRHD G XIT:'$D(IO)!$G(POP)!$D(DTOUT)!$D(DUOUT)
- S ABMQ("RX")="XIT^ABMUPTIN"
- S ABMQ("NS")="ABM"
- S ABMQ("RP")="COMPUTE^ABMUPTIN"
- D ^ABMDRDBQ
- Q
- COMPUTE ;
- K DIC,DIE,X,Y,DA,ABMC,ABMI,ABMCNT
- S ABMI=0
- D WHD^ABMDRHD
- W !,?2,"INSURER",?35,$S(ABMADD="B":"BILLING",1:"MAILING")_" ADDRESS",?70,"TIN"
- W !?5,"Address",?37,"City",?53,"ST",?56,"Zip",?67,"Phone"
- W !
- F ABMI=1:1:80 W "-"
- S ABMI=0
- F S ABMI=$O(^AUTNINS(ABMI)) Q:+ABMI=0 D
- .K ABMC
- .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"))
- .Q:$A($E(ABMTIN,9))<65!($A($E(ABMTIN,9))>91)
- .W !?2,$E($G(ABMC("9999999.18",ABMI_",",".01","E")),1,30)
- .W ?70,$G(ABMC("9999999.18",ABMI_",",".11","E"))
- .W !
- .I ABMADD="M" D
- ..W ?5,$G(ABMC("9999999.18",ABMI_",",".02","E"))
- ..W ?37,$G(ABMC("9999999.18",ABMI_",",".03","E"))
- ..W ?53,$P($G(^DIC(5,$G(ABMC("9999999.18",ABMI_",",".04","I")),0)),U,2)
- ..W ?56,$G(ABMC("9999999.18",ABMI_",",".05","E"))
- ..W ?67,$G(ABMC("9999999.18",ABMI_",",".06","E"))
- .I ABMADD="B" D
- ..W ?5,$G(ABMC("9999999.18",ABMI_",","2","E"))
- ..W ?37,$G(ABMC("9999999.18",ABMI_",","3","E"))
- ..I $G(ABMC("9999999.18",ABMI_",","4","I"))'="" W ?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 +$G(ABMCNT)>0 D
- .W !!?40,"TOTAL INSURERS WITH PSEUDO TIN: ",ABMCNT
- Q
- XIT ;
- K ABMC,ABMADD,ABMI,ABMTIN
- Q
- ABMUPTIN ; IHS/SD/SDR - 3PB/UFMS Pseudo TIN report
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;
- +3 ; New routine - v2.5 p12 SDD item 4.9.3.1
- +4 ;
- EP ;
- +1 SET DIR(0)="S^B:Billing Address;M:Mailing Address"
- +2 SET DIR("A")="Which address would you like to see on the report"
- +3 DO ^DIR
- +4 IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)
- GOTO XIT
- +5 SET ABMADD=Y
- +6 SET ABM("HD",0)="===== INSURER LISTING WITH PSEUDO TINS ====="
- +7 SET ABMY("LOC")=DUZ(2)
- +8 SET ABM("LVL")=0
- +9 SET ABM("CONJ")=""
- +10 SET ABM("TXT")=""
- +11 SET ABM("PG")=1
- +12 DO LOC^ABMDRHD
- IF '$DATA(IO)!$GET(POP)!$DATA(DTOUT)!$DATA(DUOUT)
- GOTO XIT
- +13 SET ABMQ("RX")="XIT^ABMUPTIN"
- +14 SET ABMQ("NS")="ABM"
- +15 SET ABMQ("RP")="COMPUTE^ABMUPTIN"
- +16 DO ^ABMDRDBQ
- +17 QUIT
- COMPUTE ;
- +1 KILL DIC,DIE,X,Y,DA,ABMC,ABMI,ABMCNT
- +2 SET ABMI=0
- +3 DO WHD^ABMDRHD
- +4 WRITE !,?2,"INSURER",?35,$SELECT(ABMADD="B":"BILLING",1:"MAILING")_" ADDRESS",?70,"TIN"
- +5 WRITE !?5,"Address",?37,"City",?53,"ST",?56,"Zip",?67,"Phone"
- +6 WRITE !
- +7 FOR ABMI=1:1:80
- WRITE "-"
- +8 SET ABMI=0
- +9 FOR
- SET ABMI=$ORDER(^AUTNINS(ABMI))
- IF +ABMI=0
- QUIT
- Begin DoDot:1
- +10 KILL ABMC
- +11 DO GETS^DIQ("9999999.18",ABMI,".01;.02;.03;.04;.05;.06;.11;2;3;4;5","IE","ABMC")
- +12 SET ABMTIN=$GET(ABMC("9999999.18",ABMI_",",".11","E"))
- +13 IF $ASCII($EXTRACT(ABMTIN,9))<65!($ASCII($EXTRACT(ABMTIN,9))>91)
- QUIT
- +14 WRITE !?2,$EXTRACT($GET(ABMC("9999999.18",ABMI_",",".01","E")),1,30)
- +15 WRITE ?70,$GET(ABMC("9999999.18",ABMI_",",".11","E"))
- +16 WRITE !
- +17 IF ABMADD="M"
- Begin DoDot:2
- +18 WRITE ?5,$GET(ABMC("9999999.18",ABMI_",",".02","E"))
- +19 WRITE ?37,$GET(ABMC("9999999.18",ABMI_",",".03","E"))
- +20 WRITE ?53,$PIECE($GET(^DIC(5,$GET(ABMC("9999999.18",ABMI_",",".04","I")),0)),U,2)
- +21 WRITE ?56,$GET(ABMC("9999999.18",ABMI_",",".05","E"))
- +22 WRITE ?67,$GET(ABMC("9999999.18",ABMI_",",".06","E"))
- End DoDot:2
- +23 IF ABMADD="B"
- Begin DoDot:2
- +24 WRITE ?5,$GET(ABMC("9999999.18",ABMI_",","2","E"))
- +25 WRITE ?37,$GET(ABMC("9999999.18",ABMI_",","3","E"))
- +26 IF $GET(ABMC("9999999.18",ABMI_",","4","I"))'=""
- WRITE ?53,$PIECE($GET(^DIC(5,$GET(ABMC("9999999.18",ABMI_",","4","I")),0)),U,2)
- +27 WRITE ?56,$PIECE($GET(ABMC("9999999.18",ABMI_",","5","E")),"-")
- +28 WRITE ?67,$GET(ABMC("9999999.18",ABMI_",",".06","E"))
- End DoDot:2
- +29 SET ABMCNT=+$GET(ABMCNT)+1
- End DoDot:1
- +30 IF +$GET(ABMCNT)>0
- Begin DoDot:1
- +31 WRITE !!?40,"TOTAL INSURERS WITH PSEUDO TIN: ",ABMCNT
- End DoDot:1
- +32 QUIT
- XIT ;
- +1 KILL ABMC,ABMADD,ABMI,ABMTIN
- +2 QUIT
