ABMPPAD3.m

ABMPPAD3 ; IHS/SD/SDR - COB page merge duplicate SAR entries; 

 ;;2.6;IHS 3P BILLING SYSTEM;**19**;NOV 12, 2009;Build 300

 ;IHS/SD/SDR - 2.6*19 - HEAT168248 - New routine to merge same SARs into one entry.

 ;

 K ABMTPP,ABMTI,ABMTSAR,ABMTREAL

 S ABMTI=0

 F  S ABMTI=$O(ABMPP(ABMTI)) Q:'ABMTI  D

 .S ABMTT=0

 .F  S ABMTT=$O(ABMPP(ABMTI,"A",ABMTT)) Q:'ABMTT  D

 ..S ABMTSAR=$P($G(ABMPP(ABMTI,"A",ABMTT)),U,4)

 ..I $G(ABMTSAR)="" Q  ;no SAR

 ..I $D(ABMTPP(ABMTSAR)) D

 ...S ABMTREAL=$O(ABMTPP(ABMTSAR,0))

 ...S $P(ABMPP(ABMTI,"A",ABMTREAL),U)=$P(ABMPP(ABMTI,"A",ABMTREAL),U)+$P(ABMPP(ABMTI,"A",ABMTT),U)

 ...K ABMPP(ABMTI,"A",ABMTT)

 ..I '$D(ABMTPP(ABMTSAR)) S ABMTPP(ABMTSAR,ABMTT)=""

 K ABMTPP,ABMTI,ABMTSAR,ABMTREAL

 M ABMTPP=ABMPP

 K ABMPP

 S ABMCNT=1

 S ABMTI=0

 F  S ABMTI=$O(ABMTPP(ABMTI)) Q:'ABMTI  D

 .S ABMTTTYP=""

 .F  S ABMTTTYP=$O(ABMTPP(ABMTI,ABMTTTYP)) Q:ABMTTTYP=""  D

 ..S ABMTT=0

 ..F  S ABMTT=$O(ABMTPP(ABMTI,ABMTTTYP,ABMTT)) Q:'ABMTT  D

 ...S ABMPP(ABMTI,ABMTTTYP,ABMCNT)=$G(ABMTPP(ABMTI,ABMTTTYP,ABMTT))

 ...S ABMCNT=ABMCNT+1

 K ABMTPP,ABMTI,ABMTSAR,ABMTREAL,ABMTTTYP,ABMCNT,ABMTT

 Q

ABMPPAD3  ; IHS/SD/SDR - COB page merge duplicate SAR entries; 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**19**;NOV 12, 2009;Build 300

 +2       ;IHS/SD/SDR - 2.6*19 - HEAT168248 - New routine to merge same SARs into one entry.

 +3       ;

 +4        KILL ABMTPP,ABMTI,ABMTSAR,ABMTREAL

 +5        SET ABMTI=0

 +6        FOR 

               SET ABMTI=$ORDER(ABMPP(ABMTI))

               IF 'ABMTI

                   QUIT 

               Begin DoDot:1

 +7                SET ABMTT=0

 +8                FOR 

                       SET ABMTT=$ORDER(ABMPP(ABMTI,"A",ABMTT))

                       IF 'ABMTT

                           QUIT 

                       Begin DoDot:2

 +9                        SET ABMTSAR=$PIECE($GET(ABMPP(ABMTI,"A",ABMTT)),U,4)

 +10      ;no SAR

                           IF $GET(ABMTSAR)=""

                               QUIT 

 +11                       IF $DATA(ABMTPP(ABMTSAR))

                               Begin DoDot:3

 +12                               SET ABMTREAL=$ORDER(ABMTPP(ABMTSAR,0))

 +13                               SET $PIECE(ABMPP(ABMTI,"A",ABMTREAL),U)=$PIECE(ABMPP(ABMTI,"A",ABMTREAL),U)+$PIECE(ABMPP(ABMTI,"A",ABMTT),U)

 +14                               KILL ABMPP(ABMTI,"A",ABMTT)

                               End DoDot:3

 +15                       IF '$DATA(ABMTPP(ABMTSAR))

                               SET ABMTPP(ABMTSAR,ABMTT)=""

                       End DoDot:2

               End DoDot:1

 +16       KILL ABMTPP,ABMTI,ABMTSAR,ABMTREAL

 +17       MERGE ABMTPP=ABMPP

 +18       KILL ABMPP

 +19       SET ABMCNT=1

 +20       SET ABMTI=0

 +21       FOR 

               SET ABMTI=$ORDER(ABMTPP(ABMTI))

               IF 'ABMTI

                   QUIT 

               Begin DoDot:1

 +22               SET ABMTTTYP=""

 +23               FOR 

                       SET ABMTTTYP=$ORDER(ABMTPP(ABMTI,ABMTTTYP))

                       IF ABMTTTYP=""

                           QUIT 

                       Begin DoDot:2

 +24                       SET ABMTT=0

 +25                       FOR 

                               SET ABMTT=$ORDER(ABMTPP(ABMTI,ABMTTTYP,ABMTT))

                               IF 'ABMTT

                                   QUIT 

                               Begin DoDot:3

 +26                               SET ABMPP(ABMTI,ABMTTTYP,ABMCNT)=$GET(ABMTPP(ABMTI,ABMTTTYP,ABMTT))

 +27                               SET ABMCNT=ABMCNT+1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +28       KILL ABMTPP,ABMTI,ABMTSAR,ABMTREAL,ABMTTTYP,ABMCNT,ABMTT

 +29       QUIT