ACGPSTMP.m

ACGPSTMP ;;IHS/OIRM/DSD/THL,AEF - INPUT TRANSFOR FOR SIG FIELD;;;[ 03/27/2000   2:22 PM ]

 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16,2000

EN D EN1

EXIT K APSPZW,APSPSIG,Z1,Z0

 Q

EN1 S APSPZW=$S($D(%APSITE):$P(%APSITE,U,4),$D(^AUSYS(1,"PS",1,0)):$P(^(0),U,4),1:31),APSPZW=APSPZW-5 D:APSPZW

 .S APSPSIG=""

 .F Z0=1:1 Q:$P(X," ",Z0,99)=""  S Z1=$P(X," ",Z0) K:$L(Z1)>APSPZW X W:$L(Z1)>APSPZW !,?5,"MAX OF ",APSPZW," CHARACTERS ALLOWED BETWEEN SPACES." Q:$L(Z1)>APSPZW  D:Z1]""  S APSPSIG=APSPSIG_$E(" ",Z0>1)_Z1

 ..S Y=$O(^DIC(51,"B",Z1,0)) Q:'Y  S Z1=$P(^DIC(51,Y,0),U,2) Q:'$D(^(9))  S Y=$P(X," ",Z0-1),Y=$E(Y,$L(Y)) S:Y>1 Z1=^(9)

 Q

ACGPSTMP  ;;IHS/OIRM/DSD/THL,AEF - INPUT TRANSFOR FOR SIG FIELD;;;[ 03/27/2000   2:22 PM ]

 +1       ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16,2000

EN         DO EN1

EXIT       KILL APSPZW,APSPSIG,Z1,Z0

 +1        QUIT 

EN1        SET APSPZW=$SELECT($DATA(%APSITE):$PIECE(%APSITE,U,4),$DATA(^AUSYS(1,"PS",1,0)):$PIECE(^(0),U,4),1:31)

           SET APSPZW=APSPZW-5

           IF APSPZW

               Begin DoDot:1

 +1                SET APSPSIG=""

 +2                FOR Z0=1:1

                       IF $PIECE(X," ",Z0,99)=""

                           QUIT 

                       SET Z1=$PIECE(X," ",Z0)

                       IF $LENGTH(Z1)>APSPZW

                           KILL X

                       IF $LENGTH(Z1)>APSPZW

                           WRITE !,?5,"MAX OF ",APSPZW," CHARACTERS ALLOWED BETWEEN SPACES."

                       IF $LENGTH(Z1)>APSPZW

                           QUIT 

                       IF Z1]""

                           Begin DoDot:2

 +3                            SET Y=$ORDER(^DIC(51,"B",Z1,0))

                               IF 'Y

                                   QUIT 

                               SET Z1=$PIECE(^DIC(51,Y,0),U,2)

                               IF '$DATA(^(9))

                                   QUIT 

                               SET Y=$PIECE(X," ",Z0-1)

                               SET Y=$EXTRACT(Y,$LENGTH(Y))

                               IF Y>1

                                   SET Z1=^(9)

                           End DoDot:2

                       SET APSPSIG=APSPSIG_$EXTRACT(" ",Z0>1)_Z1

               End DoDot:1

 +4        QUIT