ABMF400 ; IHS/SD/SDR - 3P BILLING - Find Medicare 400/900 references ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
EN ;EP
W !!,"Now going through 3P Exp Local Mods file looking for Medicare references..."
K ABMLST,ABMFOUND
S ABMINS=0
F S ABMINS=$O(^ABMEXLM("AA",ABMINS)) Q:+ABMINS=0 D
.S ABMEXP=0
.F S ABMEXP=$O(^ABMEXLM("AA",ABMINS,ABMEXP)) Q:+ABMEXP=0 D
..S ABMRTYP=""
..F S ABMRTYP=$O(^ABMEXLM("AA",ABMINS,ABMEXP,ABMRTYP)) Q:ABMRTYP="" D
...S ABMI=0
...F S ABMI=$O(^ABMEXLM("AA",ABMINS,ABMEXP,ABMRTYP,ABMI)) Q:+ABMI=0 D
....S ABMLST($P($G(^ABMEXLM("AA",ABMINS,ABMEXP,ABMRTYP,ABMI)),U,2))=""
;
S ABMRTN=""
F S ABMRTN=$O(ABMLST(ABMRTN)) Q:ABMRTN="" D
.S ABMLCNT=0
.F S ABMLCNT=$O(^ROUTINE(ABMRTN,0,ABMLCNT)) Q:+ABMLCNT=0 D
..I $G(^ROUTINE(ABMRTN,0,ABMLCNT))["400" S ABMFOUND(400,ABMRTN,ABMLCNT)=$G(^ROUTINE(ABMRTN,0,ABMLCNT))
..I $G(^ROUTINE(ABMRTN,0,ABMLCNT))["900" S ABMFOUND(900,ABMRTN,ABMLCNT)=$G(^ROUTINE(ABMRTN,0,ABMLCNT))
;
I '$D(ABMFOUND) W !!,"NO Medicare entries found."
;
I $D(ABMFOUND) D
.W !!,"***WARNING*** DO SCREEN PRINT OR REFERENCE INSTALL FILE"
.W !!,"Entries were found that contain possible Medicare entries that should be"
.W !,"reviewed."
.W !,"NUMBER",?9,"ROUTINE",?20,"LINE",?25,"CODE"
.S ABMI=0
.F S ABMI=$O(ABMFOUND(ABMI)) Q:+ABMI=0 D
..S ABMRTN=""
..F S ABMRTN=$O(ABMFOUND(ABMI,ABMRTN)) Q:ABMRTN="" D
...S ABMLCNT=0
...F S ABMLCNT=$O(ABMFOUND(ABMI,ABMRTN,ABMLCNT)) Q:+ABMLCNT=0 D
....W !,ABMI,?9,ABMRTN,?20,ABMLCNT,?25,$G(ABMFOUND(ABMI,ABMRTN,ABMLCNT))
Q
ABMF400 ; IHS/SD/SDR - 3P BILLING - Find Medicare 400/900 references ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
EN ;EP
+1 WRITE !!,"Now going through 3P Exp Local Mods file looking for Medicare references..."
+2 KILL ABMLST,ABMFOUND
+3 SET ABMINS=0
+4 FOR
SET ABMINS=$ORDER(^ABMEXLM("AA",ABMINS))
IF +ABMINS=0
QUIT
Begin DoDot:1
+5 SET ABMEXP=0
+6 FOR
SET ABMEXP=$ORDER(^ABMEXLM("AA",ABMINS,ABMEXP))
IF +ABMEXP=0
QUIT
Begin DoDot:2
+7 SET ABMRTYP=""
+8 FOR
SET ABMRTYP=$ORDER(^ABMEXLM("AA",ABMINS,ABMEXP,ABMRTYP))
IF ABMRTYP=""
QUIT
Begin DoDot:3
+9 SET ABMI=0
+10 FOR
SET ABMI=$ORDER(^ABMEXLM("AA",ABMINS,ABMEXP,ABMRTYP,ABMI))
IF +ABMI=0
QUIT
Begin DoDot:4
+11 SET ABMLST($PIECE($GET(^ABMEXLM("AA",ABMINS,ABMEXP,ABMRTYP,ABMI)),U,2))=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 ;
+13 SET ABMRTN=""
+14 FOR
SET ABMRTN=$ORDER(ABMLST(ABMRTN))
IF ABMRTN=""
QUIT
Begin DoDot:1
+15 SET ABMLCNT=0
+16 FOR
SET ABMLCNT=$ORDER(^ROUTINE(ABMRTN,0,ABMLCNT))
IF +ABMLCNT=0
QUIT
Begin DoDot:2
+17 IF $GET(^ROUTINE(ABMRTN,0,ABMLCNT))["400"
SET ABMFOUND(400,ABMRTN,ABMLCNT)=$GET(^ROUTINE(ABMRTN,0,ABMLCNT))
+18 IF $GET(^ROUTINE(ABMRTN,0,ABMLCNT))["900"
SET ABMFOUND(900,ABMRTN,ABMLCNT)=$GET(^ROUTINE(ABMRTN,0,ABMLCNT))
End DoDot:2
End DoDot:1
+19 ;
+20 IF '$DATA(ABMFOUND)
WRITE !!,"NO Medicare entries found."
+21 ;
+22 IF $DATA(ABMFOUND)
Begin DoDot:1
+23 WRITE !!,"***WARNING*** DO SCREEN PRINT OR REFERENCE INSTALL FILE"
+24 WRITE !!,"Entries were found that contain possible Medicare entries that should be"
+25 WRITE !,"reviewed."
+26 WRITE !,"NUMBER",?9,"ROUTINE",?20,"LINE",?25,"CODE"
+27 SET ABMI=0
+28 FOR
SET ABMI=$ORDER(ABMFOUND(ABMI))
IF +ABMI=0
QUIT
Begin DoDot:2
+29 SET ABMRTN=""
+30 FOR
SET ABMRTN=$ORDER(ABMFOUND(ABMI,ABMRTN))
IF ABMRTN=""
QUIT
Begin DoDot:3
+31 SET ABMLCNT=0
+32 FOR
SET ABMLCNT=$ORDER(ABMFOUND(ABMI,ABMRTN,ABMLCNT))
IF +ABMLCNT=0
QUIT
Begin DoDot:4
+33 WRITE !,ABMI,?9,ABMRTN,?20,ABMLCNT,?25,$GET(ABMFOUND(ABMI,ABMRTN,ABMLCNT))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 QUIT
