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