APCDFCTC.m

APCDFCTC ; IHS/CMI/LAB - UPDATE TRAN CODE TRACKING FILE ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 L +^XTMP("APCDZTCT",DT):20 E  W !!,"CANNOT LOCK TRAN CODE TRACKING GLOBAL!",! D EXIT Q

 S DIC="^APCDTCT(",DIC(0)="L",X=DT,DLAYGO=9001001.8 D ^DIC K DIC

 I Y=-1 W !!,"TRAN CODE TRACKING FAILED -- NOTIFY PROGRAMMER!",! D EXIT Q

 K DIU,DIV,DA,DIE,DLAYGO,DIC

 NEW CNT,% S CNT=0,%=0 F  S %=$O(^AUPNVTC("AD",APCDFV,%)) Q:%'=+%  S CNT=CNT+1

 I $D(^APCDTCT(+Y,11,"B",APCDFV)) S DA=$O(^APCDTCT(+Y,11,"B",APCDFV,0)),$P(^APCDTCT(+Y,11,DA,0),U,3)=CNT G EXIT

 S DA=+Y,DR="1101///""`"_APCDFV_"""",DIE="^APCDTCT(",DR(2,9001001.81101)=".02////^S X=DUZ;.03///"_CNT

 D ^DIE

 I $D(Y) W !!,"TRAN CODE TRACKING ERROR--notify programmer!",$C(7)

EXIT ;

 L -^XTMP("APCDZTCT",DT)

 K DIE,DR,DIC,DIU,DIV,X,Y,DA,DLAYGO

 Q

APCDFCTC  ; IHS/CMI/LAB - UPDATE TRAN CODE TRACKING FILE ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3        LOCK +^XTMP("APCDZTCT",DT):20

          IF '$TEST

               WRITE !!,"CANNOT LOCK TRAN CODE TRACKING GLOBAL!",!

               DO EXIT

               QUIT 

 +4        SET DIC="^APCDTCT("

           SET DIC(0)="L"

           SET X=DT

           SET DLAYGO=9001001.8

           DO ^DIC

           KILL DIC

 +5        IF Y=-1

               WRITE !!,"TRAN CODE TRACKING FAILED -- NOTIFY PROGRAMMER!",!

               DO EXIT

               QUIT 

 +6        KILL DIU,DIV,DA,DIE,DLAYGO,DIC

 +7        NEW CNT,%

           SET CNT=0

           SET %=0

           FOR 

               SET %=$ORDER(^AUPNVTC("AD",APCDFV,%))

               IF %'=+%

                   QUIT 

               SET CNT=CNT+1

 +8        IF $DATA(^APCDTCT(+Y,11,"B",APCDFV))

               SET DA=$ORDER(^APCDTCT(+Y,11,"B",APCDFV,0))

               SET $PIECE(^APCDTCT(+Y,11,DA,0),U,3)=CNT

               GOTO EXIT

 +9        SET DA=+Y

           SET DR="1101///""`"_APCDFV_""""

           SET DIE="^APCDTCT("

           SET DR(2,9001001.81101)=".02////^S X=DUZ;.03///"_CNT

 +10       DO ^DIE

 +11       IF $DATA(Y)

               WRITE !!,"TRAN CODE TRACKING ERROR--notify programmer!",$CHAR(7)

EXIT      ;

 +1        LOCK -^XTMP("APCDZTCT",DT)

 +2        KILL DIE,DR,DIC,DIU,DIV,X,Y,DA,DLAYGO

 +3        QUIT