ABMPRVCV.m

ABMPRVCV ; IHS/SD/SDR-Move Service Line provider to multiple ; 

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;

 ; Loop through multiples and move provider over to be rendering

 ; on the service lines

 ;

 S ABMDFN=0

 F  S ABMDFN=$O(^ABMDCLM(DUZ(2),ABMDFN)) Q:+ABMDFN=0  D

 .D CLM21,CLM23,CLM27,CLM35,CLM37,CLM39,CLM43

 S ABMDFN=0

 F  S ABMDFN=$O(^ABMDBILL(DUZ(2),ABMDFN)) Q:+ABMDFN=0  D

 .D BILL21,BILL23,BILL27,BILL35,BILL37,BILL39,BILL43

 Q

CLM21 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMDFN,21,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDCLM(DUZ(2),ABMDFN,21,ABMIEN,0)),U,14)'="" D

 ..Q:$D(^ABMDCLM(DUZ(2),ABMDFN,21,ABMIEN,"P","B",$P($G(^ABMDCLM(DUZ(2),ABMDFN,21,ABMIEN,0)),U,14)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDCLM(DUZ(2),"_DA(2)_",21,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.3021,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDCLM(DUZ(2),ABMDFN,21,ABMIEN,0)),U,14)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

CLM23 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMDFN,23,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDCLM(DUZ(2),ABMDFN,23,ABMIEN,0)),U,23)'="" D

 ..Q:$D(^ABMDCLM(DUZ(2),ABMDFN,23,ABMIEN,"P","B",$P($G(^ABMDCLM(DUZ(2),ABMDFN,23,ABMIEN,0)),U,23)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDCLM(DUZ(2),"_DA(2)_",23,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.3023,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDCLM(DUZ(2),ABMDFN,23,ABMIEN,0)),U,14)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

CLM27 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMDFN,27,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDCLM(DUZ(2),ABMDFN,27,ABMIEN,0)),U,10)'="" D

 ..Q:$D(^ABMDCLM(DUZ(2),ABMDFN,27,ABMIEN,"P","B",$P($G(^ABMDCLM(DUZ(2),ABMDFN,27,ABMIEN,0)),U,10)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDCLM(DUZ(2),"_DA(2)_",27,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.3027,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDCLM(DUZ(2),ABMDFN,27,ABMIEN,0)),U,10)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

CLM35 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMDFN,35,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDCLM(DUZ(2),ABMDFN,35,ABMIEN,0)),U,10)'="" D

 ..Q:$D(^ABMDCLM(DUZ(2),ABMDFN,35,ABMIEN,"P","B",$P($G(^ABMDCLM(DUZ(2),ABMDFN,35,ABMIEN,0)),U,10)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDCLM(DUZ(2),"_DA(2)_",35,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.3035,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDCLM(DUZ(2),ABMDFN,35,ABMIEN,0)),U,10)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

CLM37 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMDFN,37,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDCLM(DUZ(2),ABMDFN,37,ABMIEN,0)),U,11)'="" D

 ..Q:$D(^ABMDCLM(DUZ(2),ABMDFN,37,ABMIEN,"P","B",$P($G(^ABMDCLM(DUZ(2),ABMDFN,37,ABMIEN,0)),U,11)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDCLM(DUZ(2),"_DA(2)_",37,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.3037,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDCLM(DUZ(2),ABMDFN,37,ABMIEN,0)),U,11)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

CLM39 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMDFN,39,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDCLM(DUZ(2),ABMDFN,39,ABMIEN,0)),U,11)'="" D

 ..Q:$D(^ABMDCLM(DUZ(2),ABMDFN,39,ABMIEN,"P","B",$P($G(^ABMDCLM(DUZ(2),ABMDFN,39,ABMIEN,0)),U,11)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDCLM(DUZ(2),"_DA(2)_",39,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.3039,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDCLM(DUZ(2),ABMDFN,39,ABMIEN,0)),U,11)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

CLM43 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMDFN,43,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDCLM(DUZ(2),ABMDFN,43,ABMIEN,0)),U,11)'="" D

 ..Q:$D(^ABMDCLM(DUZ(2),ABMDFN,43,ABMIEN,"P","B",$P($G(^ABMDCLM(DUZ(2),ABMDFN,43,ABMIEN,0)),U,11)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDCLM(DUZ(2),"_DA(2)_",43,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.3043,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDCLM(DUZ(2),ABMDFN,43,ABMIEN,0)),U,11)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

BILL21 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMDFN,21,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDBILL(DUZ(2),ABMDFN,21,ABMIEN,0)),U,14)'="" D

 ..Q:$D(^ABMDBILL(DUZ(2),ABMDFN,21,ABMIEN,"P","B",$P($G(^ABMDBILL(DUZ(2),ABMDFN,21,ABMIEN,0)),U,14)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDBILL(DUZ(2),"_DA(2)_",21,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.4021,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDBILL(DUZ(2),ABMDFN,21,ABMIEN,0)),U,14)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

BILL23 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMDFN,23,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDBILL(DUZ(2),ABMDFN,23,ABMIEN,0)),U,23)'="" D

 ..Q:$D(^ABMDBILL(DUZ(2),ABMDFN,23,ABMIEN,"P","B",$P($G(^ABMDBILL(DUZ(2),ABMDFN,23,ABMIEN,0)),U,23)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDBILL(DUZ(2),"_DA(2)_",23,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.4023,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDBILL(DUZ(2),ABMDFN,23,ABMIEN,0)),U,14)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

BILL27 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMDFN,27,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDBILL(DUZ(2),ABMDFN,27,ABMIEN,0)),U,10)'="" D

 ..Q:$D(^ABMDBILL(DUZ(2),ABMDFN,27,ABMIEN,"P","B",$P($G(^ABMDBILL(DUZ(2),ABMDFN,27,ABMIEN,0)),U,10)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDBILL(DUZ(2),"_DA(2)_",27,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.4027,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDBILL(DUZ(2),ABMDFN,27,ABMIEN,0)),U,10)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

BILL35 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMDFN,35,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDBILL(DUZ(2),ABMDFN,35,ABMIEN,0)),U,10)'="" D

 ..Q:$D(^ABMDBILL(DUZ(2),ABMDFN,35,ABMIEN,"P","B",$P($G(^ABMDBILL(DUZ(2),ABMDFN,35,ABMIEN,0)),U,10)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDBILL(DUZ(2),"_DA(2)_",35,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.4035,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDBILL(DUZ(2),ABMDFN,35,ABMIEN,0)),U,10)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

BILL37 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMDFN,37,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDBILL(DUZ(2),ABMDFN,37,ABMIEN,0)),U,11)'="" D

 ..Q:$D(^ABMDBILL(DUZ(2),ABMDFN,37,ABMIEN,"P","B",$P($G(^ABMDBILL(DUZ(2),ABMDFN,37,ABMIEN,0)),U,11)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDBILL(DUZ(2),"_DA(2)_",37,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.4037,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDBILL(DUZ(2),ABMDFN,37,ABMIEN,0)),U,11)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

BILL39 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMDFN,39,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDBILL(DUZ(2),ABMDFN,39,ABMIEN,0)),U,11)'="" D

 ..Q:$D(^ABMDBILL(DUZ(2),ABMDFN,39,ABMIEN,"P","B",$P($G(^ABMDBILL(DUZ(2),ABMDFN,39,ABMIEN,0)),U,11)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDBILL(DUZ(2),"_DA(2)_",39,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.4039,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDBILL(DUZ(2),ABMDFN,39,ABMIEN,0)),U,11)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

BILL43 ;

 S ABMIEN=0

 F  S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMDFN,43,ABMIEN)) Q:+ABMIEN=0  D

 .I $P($G(^ABMDBILL(DUZ(2),ABMDFN,43,ABMIEN,0)),U,11)'="" D

 ..Q:$D(^ABMDBILL(DUZ(2),ABMDFN,43,ABMIEN,"P","B",$P($G(^ABMDBILL(DUZ(2),ABMDFN,43,ABMIEN,0)),U,11)))

 ..K DIC,DA,X,Y,DR

 ..S DA(2)=ABMDFN

 ..S DA(1)=ABMIEN

 ..S DIC="^ABMDBILL(DUZ(2),"_DA(2)_",43,"_DA(1)_",""P"","

 ..S DIC("P")=$P(^DD(9002274.4043,.18,0),U,2)

 ..S DIC(0)="OLM"

 ..S X=$P($G(^ABMDBILL(DUZ(2),ABMDFN,43,ABMIEN,0)),U,11)

 ..S DIC("DR")=".02////R"

 ..D FILE^DICN

 Q

ABMPRVCV  ; IHS/SD/SDR-Move Service Line provider to multiple ; 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;

 +3       ; Loop through multiples and move provider over to be rendering

 +4       ; on the service lines

 +5       ;

 +6        SET ABMDFN=0

 +7        FOR 

               SET ABMDFN=$ORDER(^ABMDCLM(DUZ(2),ABMDFN))

               IF +ABMDFN=0

                   QUIT 

               Begin DoDot:1

 +8                DO CLM21

                   DO CLM23

                   DO CLM27

                   DO CLM35

                   DO CLM37

                   DO CLM39

                   DO CLM43

               End DoDot:1

 +9        SET ABMDFN=0

 +10       FOR 

               SET ABMDFN=$ORDER(^ABMDBILL(DUZ(2),ABMDFN))

               IF +ABMDFN=0

                   QUIT 

               Begin DoDot:1

 +11               DO BILL21

                   DO BILL23

                   DO BILL27

                   DO BILL35

                   DO BILL37

                   DO BILL39

                   DO BILL43

               End DoDot:1

 +12       QUIT 

CLM21     ;

 +1        SET ABMIEN=0

 +2        FOR 

               SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMDFN,21,ABMIEN))

               IF +ABMIEN=0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,21,ABMIEN,0)),U,14)'=""

                       Begin DoDot:2

 +4                        IF $DATA(^ABMDCLM(DUZ(2),ABMDFN,21,ABMIEN,"P","B",$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,21,ABMIEN,0)),U,14)))

                               QUIT 

 +5                        KILL DIC,DA,X,Y,DR

 +6                        SET DA(2)=ABMDFN

 +7                        SET DA(1)=ABMIEN

 +8                        SET DIC="^ABMDCLM(DUZ(2),"_DA(2)_",21,"_DA(1)_",""P"","

 +9                        SET DIC("P")=$PIECE(^DD(9002274.3021,.18,0),U,2)

 +10                       SET DIC(0)="OLM"

 +11                       SET X=$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,21,ABMIEN,0)),U,14)

 +12                       SET DIC("DR")=".02////R"

 +13                       DO FILE^DICN

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

CLM23     ;

 +1        SET ABMIEN=0

 +2        FOR 

               SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMDFN,23,ABMIEN))

               IF +ABMIEN=0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,23,ABMIEN,0)),U,23)'=""

                       Begin DoDot:2

 +4                        IF $DATA(^ABMDCLM(DUZ(2),ABMDFN,23,ABMIEN,"P","B",$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,23,ABMIEN,0)),U,23)))

                               QUIT 

 +5                        KILL DIC,DA,X,Y,DR

 +6                        SET DA(2)=ABMDFN

 +7                        SET DA(1)=ABMIEN

 +8                        SET DIC="^ABMDCLM(DUZ(2),"_DA(2)_",23,"_DA(1)_",""P"","

 +9                        SET DIC("P")=$PIECE(^DD(9002274.3023,.18,0),U,2)

 +10                       SET DIC(0)="OLM"

 +11                       SET X=$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,23,ABMIEN,0)),U,14)

 +12                       SET DIC("DR")=".02////R"

 +13                       DO FILE^DICN

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

CLM27     ;

 +1        SET ABMIEN=0

 +2        FOR 

               SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMDFN,27,ABMIEN))

               IF +ABMIEN=0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,27,ABMIEN,0)),U,10)'=""

                       Begin DoDot:2

 +4                        IF $DATA(^ABMDCLM(DUZ(2),ABMDFN,27,ABMIEN,"P","B",$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,27,ABMIEN,0)),U,10)))

                               QUIT 

 +5                        KILL DIC,DA,X,Y,DR

 +6                        SET DA(2)=ABMDFN

 +7                        SET DA(1)=ABMIEN

 +8                        SET DIC="^ABMDCLM(DUZ(2),"_DA(2)_",27,"_DA(1)_",""P"","

 +9                        SET DIC("P")=$PIECE(^DD(9002274.3027,.18,0),U,2)

 +10                       SET DIC(0)="OLM"

 +11                       SET X=$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,27,ABMIEN,0)),U,10)

 +12                       SET DIC("DR")=".02////R"

 +13                       DO FILE^DICN

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

CLM35     ;

 +1        SET ABMIEN=0

 +2        FOR 

               SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMDFN,35,ABMIEN))

               IF +ABMIEN=0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,35,ABMIEN,0)),U,10)'=""

                       Begin DoDot:2

 +4                        IF $DATA(^ABMDCLM(DUZ(2),ABMDFN,35,ABMIEN,"P","B",$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,35,ABMIEN,0)),U,10)))

                               QUIT 

 +5                        KILL DIC,DA,X,Y,DR

 +6                        SET DA(2)=ABMDFN

 +7                        SET DA(1)=ABMIEN

 +8                        SET DIC="^ABMDCLM(DUZ(2),"_DA(2)_",35,"_DA(1)_",""P"","

 +9                        SET DIC("P")=$PIECE(^DD(9002274.3035,.18,0),U,2)

 +10                       SET DIC(0)="OLM"

 +11                       SET X=$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,35,ABMIEN,0)),U,10)

 +12                       SET DIC("DR")=".02////R"

 +13                       DO FILE^DICN

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

CLM37     ;

 +1        SET ABMIEN=0

 +2        FOR 

               SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMDFN,37,ABMIEN))

               IF +ABMIEN=0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,37,ABMIEN,0)),U,11)'=""

                       Begin DoDot:2

 +4                        IF $DATA(^ABMDCLM(DUZ(2),ABMDFN,37,ABMIEN,"P","B",$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,37,ABMIEN,0)),U,11)))

                               QUIT 

 +5                        KILL DIC,DA,X,Y,DR

 +6                        SET DA(2)=ABMDFN

 +7                        SET DA(1)=ABMIEN

 +8                        SET DIC="^ABMDCLM(DUZ(2),"_DA(2)_",37,"_DA(1)_",""P"","

 +9                        SET DIC("P")=$PIECE(^DD(9002274.3037,.18,0),U,2)

 +10                       SET DIC(0)="OLM"

 +11                       SET X=$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,37,ABMIEN,0)),U,11)

 +12                       SET DIC("DR")=".02////R"

 +13                       DO FILE^DICN

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

CLM39     ;

 +1        SET ABMIEN=0

 +2        FOR 

               SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMDFN,39,ABMIEN))

               IF +ABMIEN=0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,39,ABMIEN,0)),U,11)'=""

                       Begin DoDot:2

 +4                        IF $DATA(^ABMDCLM(DUZ(2),ABMDFN,39,ABMIEN,"P","B",$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,39,ABMIEN,0)),U,11)))

                               QUIT 

 +5                        KILL DIC,DA,X,Y,DR

 +6                        SET DA(2)=ABMDFN

 +7                        SET DA(1)=ABMIEN

 +8                        SET DIC="^ABMDCLM(DUZ(2),"_DA(2)_",39,"_DA(1)_",""P"","

 +9                        SET DIC("P")=$PIECE(^DD(9002274.3039,.18,0),U,2)

 +10                       SET DIC(0)="OLM"

 +11                       SET X=$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,39,ABMIEN,0)),U,11)

 +12                       SET DIC("DR")=".02////R"

 +13                       DO FILE^DICN

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

CLM43     ;

 +1        SET ABMIEN=0

 +2        FOR 

               SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMDFN,43,ABMIEN))

               IF +ABMIEN=0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,43,ABMIEN,0)),U,11)'=""

                       Begin DoDot:2

 +4                        IF $DATA(^ABMDCLM(DUZ(2),ABMDFN,43,ABMIEN,"P","B",$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,43,ABMIEN,0)),U,11)))

                               QUIT 

 +5                        KILL DIC,DA,X,Y,DR

 +6                        SET DA(2)=ABMDFN

 +7                        SET DA(1)=ABMIEN

 +8                        SET DIC="^ABMDCLM(DUZ(2),"_DA(2)_",43,"_DA(1)_",""P"","

 +9                        SET DIC("P")=$PIECE(^DD(9002274.3043,.18,0),U,2)

 +10                       SET DIC(0)="OLM"

 +11                       SET X=$PIECE($GET(^ABMDCLM(DUZ(2),ABMDFN,43,ABMIEN,0)),U,11)

 +12                       SET DIC("DR")=".02////R"

 +13                       DO FILE^DICN

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

BILL21    ;

 +1        SET ABMIEN=0

 +2        FOR 

               SET ABMIEN=$ORDER(^ABMDBILL(DUZ(2),ABMDFN,21,ABMIEN))

               IF +ABMIEN=0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,21,ABMIEN,0)),U,14)'=""

                       Begin DoDot:2

 +4                        IF $DATA(^ABMDBILL(DUZ(2),ABMDFN,21,ABMIEN,"P","B",$PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,21,ABMIEN,0)),U,14)))

                               QUIT 

 +5                        KILL DIC,DA,X,Y,DR

 +6                        SET DA(2)=ABMDFN

 +7                        SET DA(1)=ABMIEN

 +8                        SET DIC="^ABMDBILL(DUZ(2),"_DA(2)_",21,"_DA(1)_",""P"","

 +9                        SET DIC("P")=$PIECE(^DD(9002274.4021,.18,0),U,2)

 +10                       SET DIC(0)="OLM"

 +11                       SET X=$PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,21,ABMIEN,0)),U,14)

 +12                       SET DIC("DR")=".02////R"

 +13                       DO FILE^DICN

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

BILL23    ;

 +1        SET ABMIEN=0

 +2        FOR 

               SET ABMIEN=$ORDER(^ABMDBILL(DUZ(2),ABMDFN,23,ABMIEN))

               IF +ABMIEN=0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,23,ABMIEN,0)),U,23)'=""

                       Begin DoDot:2

 +4                        IF $DATA(^ABMDBILL(DUZ(2),ABMDFN,23,ABMIEN,"P","B",$PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,23,ABMIEN,0)),U,23)))

                               QUIT 

 +5                        KILL DIC,DA,X,Y,DR

 +6                        SET DA(2)=ABMDFN

 +7                        SET DA(1)=ABMIEN

 +8                        SET DIC="^ABMDBILL(DUZ(2),"_DA(2)_",23,"_DA(1)_",""P"","

 +9                        SET DIC("P")=$PIECE(^DD(9002274.4023,.18,0),U,2)

 +10                       SET DIC(0)="OLM"

 +11                       SET X=$PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,23,ABMIEN,0)),U,14)

 +12                       SET DIC("DR")=".02////R"

 +13                       DO FILE^DICN

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

BILL27    ;

 +1        SET ABMIEN=0

 +2        FOR 

               SET ABMIEN=$ORDER(^ABMDBILL(DUZ(2),ABMDFN,27,ABMIEN))

               IF +ABMIEN=0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,27,ABMIEN,0)),U,10)'=""

                       Begin DoDot:2

 +4                        IF $DATA(^ABMDBILL(DUZ(2),ABMDFN,27,ABMIEN,"P","B",$PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,27,ABMIEN,0)),U,10)))

                               QUIT 

 +5                        KILL DIC,DA,X,Y,DR

 +6                        SET DA(2)=ABMDFN

 +7                        SET DA(1)=ABMIEN

 +8                        SET DIC="^ABMDBILL(DUZ(2),"_DA(2)_",27,"_DA(1)_",""P"","

 +9                        SET DIC("P")=$PIECE(^DD(9002274.4027,.18,0),U,2)

 +10                       SET DIC(0)="OLM"

 +11                       SET X=$PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,27,ABMIEN,0)),U,10)

 +12                       SET DIC("DR")=".02////R"

 +13                       DO FILE^DICN

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

BILL35    ;

 +1        SET ABMIEN=0

 +2        FOR 

               SET ABMIEN=$ORDER(^ABMDBILL(DUZ(2),ABMDFN,35,ABMIEN))

               IF +ABMIEN=0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,35,ABMIEN,0)),U,10)'=""

                       Begin DoDot:2

 +4                        IF $DATA(^ABMDBILL(DUZ(2),ABMDFN,35,ABMIEN,"P","B",$PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,35,ABMIEN,0)),U,10)))

                               QUIT 

 +5                        KILL DIC,DA,X,Y,DR

 +6                        SET DA(2)=ABMDFN

 +7                        SET DA(1)=ABMIEN

 +8                        SET DIC="^ABMDBILL(DUZ(2),"_DA(2)_",35,"_DA(1)_",""P"","

 +9                        SET DIC("P")=$PIECE(^DD(9002274.4035,.18,0),U,2)

 +10                       SET DIC(0)="OLM"

 +11                       SET X=$PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,35,ABMIEN,0)),U,10)

 +12                       SET DIC("DR")=".02////R"

 +13                       DO FILE^DICN

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

BILL37    ;

 +1        SET ABMIEN=0

 +2        FOR 

               SET ABMIEN=$ORDER(^ABMDBILL(DUZ(2),ABMDFN,37,ABMIEN))

               IF +ABMIEN=0

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMDFN,37,ABMIEN,0)),U,11)'=""