Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMPPAD3

ABMPPAD3.m

Go to the documentation of this file.
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