ABMUCANV ; IHS/SD/SDR - 3PB/UFMS CAN view/print
;;2.6;IHS 3P BILLING SYSTEM;**21**;NOV 12, 2009;Build 379
;
; new routine - v2.5 p12 SDD item 4.3
;IHS/SD/SDR - 2.6*21 - VMBP RQMT_99 - Updated to output Insurer Type correctly after switch to
; Insurer Type file (9999999.181)
;
K DIR
S DIR(0)="S^ITBA:Insurer Type to Budget Activity;CTCC:Clinic Type to Cost Center"
S DIR("A")="Which crosswalk would you like to see"
D ^DIR K DIR
G:$D(DIROUT)!$D(DTOUT)!$D(DUOUT)!$D(DIRUT) XIT
S ABMTAG=Y
W !!!
HD I ABMTAG="ITBA" S ABM("HD",0)="MAPPING of Insurer Type to Budget Activity"
I ABMTAG="CTCC" S ABM("HD",0)="MAPPING of Clinic to Cost Center"
S ABM("PG")=1
S ABMY("LOC")=DUZ(2)
S ABM("LVL")=0
S ABM("CONJ")=""
S ABM("TXT")=""
D LOC^ABMDRHD G XIT:'$D(IO)!$G(POP)!$D(DTOUT)!$D(DUOUT)
S ABMQ("RX")="XIT^ABMUCANV"
S ABMQ("NS")="ABM"
S ABMQ("RP")=ABMTAG_"^ABMUCANV"
D ^ABMDRDBQ
Q
ITBA ;EP - INSURER TYPE to BUDGET ACTIVITY
K DIC,DIE,X,Y,DA,ABMC,ABMI
S ABMI=0
D WHD^ABMDRHD
D GETS^DIQ("9999999.06",DUZ(2),".04","E","ABMC")
S ABMAREA=$G(ABMC("9999999.06",DUZ(2)_",",".04","E"))
W !,?2,"Insurer Type",?25,"Budget Activity",?42,"EFFECTIVE DATE",?58,"END DATE"
F S ABMI=$O(^ABMUITBA(ABMI)) Q:+ABMI=0 D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.D GETS^DIQ("9002274.41",ABMI,".01:.05","E","ABMC")
.Q:($G(ABMC("9002274.41",ABMI_",",".05","E"))'=ABMAREA)
.;W !?2,$G(ABMC("9002274.41",ABMI_",",".01","E")) ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_99
.;start new abm*2.6*21 IHS/SD/SDR RQMT_99
.S ABMITC=$G(ABMC("9002274.41",ABMI_",",".01","E"))
.S ABMITYP=$O(^AUTTINTY("C",ABMITC,0))
.S ABMITYP=$$GET1^DIQ(9999999.181,ABMITYP,".01","E")
.W !?2,ABMITYP
.;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_99
.W ?27,$G(ABMC("9002274.41",ABMI_",",".02","E"))
.W ?42,$G(ABMC("9002274.41",ABMI_",",".03","E"))
.W ?58,$G(ABMC("9002274.41",ABMI_",",".04","E"))
.I $Y>(IOSL-5) D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S ABM("PG")=+$G(ABM("PG"))+1 D WHD^ABMDRHD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W " (cont)"
Q
;
CTCC ;EP - COST CENTER to CLINIC
K DIC,DIE,X,Y,DA,ABMC,ABMI
S ABMI=0
D WHD^ABMDRHD
W !?2,"CC",?5,"CLINIC",?37,"Cost Center",?50,"EFFECTIVE DATE",?66,"END DATE"
F S ABMI=$O(^ABMUCTCC(ABMI)) Q:+ABMI=0 D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.D GETS^DIQ("9002274.42",ABMI,".01:.05","IE","ABMC")
.W !?2,$G(ABMC("9002274.42",ABMI_",",".01","I"))
.W ?5,$G(ABMC("9002274.42",ABMI_",",".02","E"))
.W ?40,$G(ABMC("9002274.42",ABMI_",",".03","E"))
.W ?50,$G(ABMC("9002274.42",ABMI_",",".04","E"))
.W ?63,$G(ABMC("9002274.42",ABMI_",",".05","E"))
.I $Y>(IOSL-5) D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S ABM("PG")=+$G(ABM("PG"))+1 D WHD^ABMDRHD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W " (cont)"
Q
ATFL ;EP - ASUFAC to FED LOC - currently not being called; table not distributed
K DIC,DIE,X,Y,DA,ABMC,ABMI
S ABMI=0
D WHD^ABMDRHD
W !?2,"LOCATION",?29,"ASUFAC",?36,"ACCT PT",?44,"FED LOC",?52,"EFF DT",?67,"END DT"
F S ABMI=$O(^ABMUCTCC(ABMI)) Q:+ABMI=0 D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.D GETS^DIQ("9002274.43",ABMI,".01:.06","IE","ABMC")
.W !?2,$E($G(ABMC("9002274.43",ABMI_",",".01","E")),1,25)
.W ?29,$G(ABMC("9002274.43",ABMI_",",".02","E"))
.W ?38,$G(ABMC("9002274.43",ABMI_",",".03","E"))
.W ?46,$G(ABMC("9002274.43",ABMI_",",".04","E"))
.W ?52,$G(ABMC("9002274.43",ABMI_",",".05","E"))
.W ?67,$G(ABMC("9002274.43",ABMI_",",".06","E"))
.I $Y>(IOSL-5) D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S ABM("PG")=+$G(ABM("PG"))+1 D WHD^ABMDRHD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W " (cont)"
Q
XIT ;
K ABMTAG,DIC,DIE,X,Y,DA,ABMC,ABMI
Q
ABMUCANV ; IHS/SD/SDR - 3PB/UFMS CAN view/print
+1 ;;2.6;IHS 3P BILLING SYSTEM;**21**;NOV 12, 2009;Build 379
+2 ;
+3 ; new routine - v2.5 p12 SDD item 4.3
+4 ;IHS/SD/SDR - 2.6*21 - VMBP RQMT_99 - Updated to output Insurer Type correctly after switch to
+5 ; Insurer Type file (9999999.181)
+6 ;
+7 KILL DIR
+8 SET DIR(0)="S^ITBA:Insurer Type to Budget Activity;CTCC:Clinic Type to Cost Center"
+9 SET DIR("A")="Which crosswalk would you like to see"
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)
GOTO XIT
+12 SET ABMTAG=Y
+13 WRITE !!!
HD IF ABMTAG="ITBA"
SET ABM("HD",0)="MAPPING of Insurer Type to Budget Activity"
+1 IF ABMTAG="CTCC"
SET ABM("HD",0)="MAPPING of Clinic to Cost Center"
+2 SET ABM("PG")=1
+3 SET ABMY("LOC")=DUZ(2)
+4 SET ABM("LVL")=0
+5 SET ABM("CONJ")=""
+6 SET ABM("TXT")=""
+7 DO LOC^ABMDRHD
IF '$DATA(IO)!$GET(POP)!$DATA(DTOUT)!$DATA(DUOUT)
GOTO XIT
+8 SET ABMQ("RX")="XIT^ABMUCANV"
+9 SET ABMQ("NS")="ABM"
+10 SET ABMQ("RP")=ABMTAG_"^ABMUCANV"
+11 DO ^ABMDRDBQ
+12 QUIT
ITBA ;EP - INSURER TYPE to BUDGET ACTIVITY
+1 KILL DIC,DIE,X,Y,DA,ABMC,ABMI
+2 SET ABMI=0
+3 DO WHD^ABMDRHD
+4 DO GETS^DIQ("9999999.06",DUZ(2),".04","E","ABMC")
+5 SET ABMAREA=$GET(ABMC("9999999.06",DUZ(2)_",",".04","E"))
+6 WRITE !,?2,"Insurer Type",?25,"Budget Activity",?42,"EFFECTIVE DATE",?58,"END DATE"
+7 FOR
SET ABMI=$ORDER(^ABMUITBA(ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+8 DO GETS^DIQ("9002274.41",ABMI,".01:.05","E","ABMC")
+9 IF ($GET(ABMC("9002274.41",ABMI_",",".05","E"))'=ABMAREA)
QUIT
+10 ;W !?2,$G(ABMC("9002274.41",ABMI_",",".01","E")) ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_99
+11 ;start new abm*2.6*21 IHS/SD/SDR RQMT_99
+12 SET ABMITC=$GET(ABMC("9002274.41",ABMI_",",".01","E"))
+13 SET ABMITYP=$ORDER(^AUTTINTY("C",ABMITC,0))
+14 SET ABMITYP=$$GET1^DIQ(9999999.181,ABMITYP,".01","E")
+15 WRITE !?2,ABMITYP
+16 ;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_99
+17 WRITE ?27,$GET(ABMC("9002274.41",ABMI_",",".02","E"))
+18 WRITE ?42,$GET(ABMC("9002274.41",ABMI_",",".03","E"))
+19 WRITE ?58,$GET(ABMC("9002274.41",ABMI_",",".04","E"))
+20 IF $Y>(IOSL-5)
DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
SET ABM("PG")=+$GET(ABM("PG"))+1
DO WHD^ABMDRHD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
WRITE " (cont)"
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+21 QUIT
+22 ;
CTCC ;EP - COST CENTER to CLINIC
+1 KILL DIC,DIE,X,Y,DA,ABMC,ABMI
+2 SET ABMI=0
+3 DO WHD^ABMDRHD
+4 WRITE !?2,"CC",?5,"CLINIC",?37,"Cost Center",?50,"EFFECTIVE DATE",?66,"END DATE"
+5 FOR
SET ABMI=$ORDER(^ABMUCTCC(ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+6 DO GETS^DIQ("9002274.42",ABMI,".01:.05","IE","ABMC")
+7 WRITE !?2,$GET(ABMC("9002274.42",ABMI_",",".01","I"))
+8 WRITE ?5,$GET(ABMC("9002274.42",ABMI_",",".02","E"))
+9 WRITE ?40,$GET(ABMC("9002274.42",ABMI_",",".03","E"))
+10 WRITE ?50,$GET(ABMC("9002274.42",ABMI_",",".04","E"))
+11 WRITE ?63,$GET(ABMC("9002274.42",ABMI_",",".05","E"))
+12 IF $Y>(IOSL-5)
DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
SET ABM("PG")=+$GET(ABM("PG"))+1
DO WHD^ABMDRHD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
WRITE " (cont)"
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+13 QUIT
ATFL ;EP - ASUFAC to FED LOC - currently not being called; table not distributed
+1 KILL DIC,DIE,X,Y,DA,ABMC,ABMI
+2 SET ABMI=0
+3 DO WHD^ABMDRHD
+4 WRITE !?2,"LOCATION",?29,"ASUFAC",?36,"ACCT PT",?44,"FED LOC",?52,"EFF DT",?67,"END DT"
+5 FOR
SET ABMI=$ORDER(^ABMUCTCC(ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+6 DO GETS^DIQ("9002274.43",ABMI,".01:.06","IE","ABMC")
+7 WRITE !?2,$EXTRACT($GET(ABMC("9002274.43",ABMI_",",".01","E")),1,25)
+8 WRITE ?29,$GET(ABMC("9002274.43",ABMI_",",".02","E"))
+9 WRITE ?38,$GET(ABMC("9002274.43",ABMI_",",".03","E"))
+10 WRITE ?46,$GET(ABMC("9002274.43",ABMI_",",".04","E"))
+11 WRITE ?52,$GET(ABMC("9002274.43",ABMI_",",".05","E"))
+12 WRITE ?67,$GET(ABMC("9002274.43",ABMI_",",".06","E"))
+13 IF $Y>(IOSL-5)
DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
SET ABM("PG")=+$GET(ABM("PG"))+1
DO WHD^ABMDRHD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
WRITE " (cont)"
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+14 QUIT
XIT ;
+1 KILL ABMTAG,DIC,DIE,X,Y,DA,ABMC,ABMI
+2 QUIT
