DGPMX61.m

DGPMX61 ; ;10/15/12

 S X=DE(14),DIC=DIE

 S DGPMDDF=9 D ^DGPMDD2

 S X=DE(14),DIC=DIE

 S DGPMDDF=9,DGPMDDT=0 D ^DGPMDDCN

 S X=DE(14),DIC=DIE

 I $D(^DGPM(+$P(^DGPM(DA,0),"^",24),0)),($P(^(0),"^",2)=1) S A1B2TAG="ADM1" D ^A1B2XFR

 S X=DE(14),DIC=DIE

 S Y=^DGPM(DA,0) I +Y,Y<DT S Y=$P(Y,U,2) I Y=6,X'=$P(Y,U,9) S DGHNYT=14 D ^DGPMGLC

 S X=DE(14),DIC=DIE

 D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DFN)

 S X=DE(14),DIIX=2_U_DIFLD D AUDIT^DIET

DGPMX61   ; ;10/15/12

 +1        SET X=DE(14)

           SET DIC=DIE

 +2        SET DGPMDDF=9

           DO ^DGPMDD2

 +3        SET X=DE(14)

           SET DIC=DIE

 +4        SET DGPMDDF=9

           SET DGPMDDT=0

           DO ^DGPMDDCN

 +5        SET X=DE(14)

           SET DIC=DIE

 +6        IF $DATA(^DGPM(+$PIECE(^DGPM(DA,0),"^",24),0))

               IF ($PIECE(^(0),"^",2)=1)

                   SET A1B2TAG="ADM1"

                   DO ^A1B2XFR

 +7        SET X=DE(14)

           SET DIC=DIE

 +8        SET Y=^DGPM(DA,0)

           IF +Y

               IF Y<DT

                   SET Y=$PIECE(Y,U,2)

                   IF Y=6

                       IF X'=$PIECE(Y,U,9)

                           SET DGHNYT=14

                           DO ^DGPMGLC

 +9        SET X=DE(14)

           SET DIC=DIE

 +10       IF ($TEXT(ADGRU^DGRUDD01)'="")

               DO ADGRU^DGRUDD01(DFN)

 +11       SET X=DE(14)

           SET DIIX=2_U_DIFLD

           DO AUDIT^DIET