Routine: DG53198P

DG53198P ;ALB/JDS REINDEX FILE 408.22

 ;;5.3;Registration;**198**;Aug 13, 1993

 N A S A=$$NEWCP^XPDUTL("DGAMT","POST^DG53198P",0)

POST ;Return from checkpoint

 N DA,DGDA,DIK,XXX,XPDIDTOT S DGDA=+$$PARCP^XPDUTL("DGAMT") I 'DGDA K ^DGMT(408.22,"AMT")

 D MES^XPDUTL("Reindexing INCOME RELATION cross reference")

 S XPDIDTOT=+$P($G(^DGMT(408.22,0)),U,3)

 S DIK="^DGMT(408.22,",DIK(1)=".01^AMT1"

 F  S DGDA=$O(^DGMT(408.22,DGDA)) Q:'DGDA  S XXX=$P($G(^(DGDA,0)),U) I $L(XXX) S DA=DGDA D EN1^DIK I '(DA#50) D UPDATE^XPDID(DA) S XXX=$$UPCP^XPDUTL("DGAMT",DA)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53198P   569     printed  Apr 09, 2024@21:40:54                                                                                                                                                                                                     Page 2

DG53198P  ;ALB/JDS REINDEX FILE 408.22

 +1       ;;5.3;Registration;**198**;Aug 13, 1993

 +2        NEW A

           SET A=$$NEWCP^XPDUTL("DGAMT","POST^DG53198P",0)

 +3        QUIT

POST      ;Return from checkpoint

 +1        NEW DA,DGDA,DIK,XXX,XPDIDTOT

           SET DGDA=+$$PARCP^XPDUTL("DGAMT")

           IF 'DGDA

               KILL ^DGMT(408.22,"AMT")

 +2        DO MES^XPDUTL("Reindexing INCOME RELATION cross reference")

 +3        SET XPDIDTOT=+$PIECE($GET(^DGMT(408.22,0)),U,3)

 +4        SET DIK="^DGMT(408.22,"

           SET DIK(1)=".01^AMT1"

 +5        FOR

               SET DGDA=$ORDER(^DGMT(408.22,DGDA))

               if 'DGDA

                   QUIT

               SET XXX=$PIECE($GET(^(DGDA,0)),U)

               IF $LENGTH(XXX)

                   SET DA=DGDA

                   DO EN1^DIK

                   IF '(DA#50)

                       DO UPDATE^XPDID(DA)

                       SET XXX=$$UPCP^XPDUTL("DGAMT",DA)

 +6        QUIT

DG53198P.m