ADGT161.m

ADGT161 ; ;04/14/04

 S X=DG(DQ),DIC=DIE

 S ^DGPM("B",$E(X,1,30),DA)=""

 S X=DG(DQ),DIC=DIE

 S DGPMDDF=1 D ^DGPMDD1

 S X=DG(DQ),DIC=DIE

 X ^DD(405,.01,1,3,1.3) I X S X=DIV X ^DD(405,.01,1,3,89.2) S X=$P(Y(101),U,1) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIV X ^DD(405,.01,1,3,1.4)

 S X=DG(DQ),DIC=DIE

 S:$P(^DGPM(DA,0),U,22)="" $P(^(0),U,22)=0

 S X=DG(DQ),DIC=DIE

 K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=$S('$D(^DGPM(+$P(^DGPM(DA,0),U,24),0)):0,1:X'=+^(0)) I X S X=DIV S Y(1)=$S($D(^DGPM(D0,0)):^(0),1:"") S X=$P(Y(1),U,24),X=X S DIU=X K Y S X="" X ^DD(405,.01,1,5,1.4)

 S X=DG(DQ),DIC=DIE

 S:$P(^DGPM(DA,0),U,3) ^DGPM("ADFN"_$P(^(0),U,3),X,DA)=""

 S X=DG(DQ),DIC=DIE

 S Y=$P(^DGPM(DA,0),U,2) I Y,Y'=4,Y'=5,X,X<DT S DGHNYT=$S(Y=1:$S($D(DGIDX):3,1:1),Y=2:$S($D(DGIDX):6,1:4),Y=3:$S($D(DGIDX):9,1:7),1:15) D ^DGPMGLC K DGIDX

 S X=DG(DQ),DIC=DIE

 I "^1^3^"[("^"_$P(^DGPM(DA,0),"^",2)_"^") S A1B2TAG="ADM" D ^A1B2XFR

 I $D(DE(2))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET

ADGT161   ; ;04/14/04

 +1        SET X=DG(DQ)

           SET DIC=DIE

 +2        SET ^DGPM("B",$EXTRACT(X,1,30),DA)=""

 +3        SET X=DG(DQ)

           SET DIC=DIE

 +4        SET DGPMDDF=1

           DO ^DGPMDD1

 +5        SET X=DG(DQ)

           SET DIC=DIE

 +6        XECUTE ^DD(405,.01,1,3,1.3)

           IF X

               SET X=DIV

               XECUTE ^DD(405,.01,1,3,89.2)

               SET X=$PIECE(Y(101),U,1)

               SET D0=I(0,0)

               SET DIU=X

               KILL Y

               SET X=DIV

               SET X=DIV

               XECUTE ^DD(405,.01,1,3,1.4)

 +7        SET X=DG(DQ)

           SET DIC=DIE

 +8        IF $PIECE(^DGPM(DA,0),U,22)=""

               SET $PIECE(^(0),U,22)=0

 +9        SET X=DG(DQ)

           SET DIC=DIE

 +10       KILL DIV

           SET DIV=X

           SET D0=DA

           SET DIV(0)=D0

           SET Y(0)=X

           SET X=$SELECT('$DATA(^DGPM(+$PIECE(^DGPM(DA,0),U,24),0)):0,1:X'=+^(0))

           IF X

               SET X=DIV

               SET Y(1)=$SELECT($DATA(^DGPM(D0,0)):^(0),1:"")

               SET X=$PIECE(Y(1),U,24)

               SET X=X

               SET DIU=X

               KILL Y

               SET X=""

               XECUTE ^DD(405,.01,1,5,1.4)

 +11       SET X=DG(DQ)

           SET DIC=DIE

 +12       IF $PIECE(^DGPM(DA,0),U,3)

               SET ^DGPM("ADFN"_$PIECE(^(0),U,3),X,DA)=""

 +13       SET X=DG(DQ)

           SET DIC=DIE

 +14       SET Y=$PIECE(^DGPM(DA,0),U,2)

           IF Y

               IF Y'=4

                   IF Y'=5

                       IF X

                           IF X<DT

                               SET DGHNYT=$SELECT(Y=1:$SELECT($DATA(DGIDX):3,1:1),Y=2:$SELECT($DATA(DGIDX):6,1:4),Y=3:$SELECT($DATA(DGIDX):9,1:7),1:15)

                               DO ^DGPMGLC

                               KILL DGIDX

 +15       SET X=DG(DQ)

           SET DIC=DIE

 +16       IF "^1^3^"[("^"_$PIECE(^DGPM(DA,0),"^",2)_"^")

               SET A1B2TAG="ADM"

               DO ^A1B2XFR

 +17       IF $DATA(DE(2))'[0!(^DD(DP,DIFLD,"AUDIT")'="e")

               SET X=DG(DQ)

               SET DIIX=3_U_DIFLD

               DO AUDIT^DIET