- 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
