APSPSIG.m

APSPSIG ; IHS/DSD/ENM - SIG INPUT TRANS 10-20-94 ;  [ 09/03/97   1:30 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

AA S APSPZW=$S($D(%APSITE):$P(%APSITE,U,4),$D(^APSPCTRL(PSOSITE,0)):$P(^(0),U,4),1:31),APSPZW=APSPZW-5 D:$D(X) BB K APSPZW ;IHS/DSD/ENM 08/01/96

 Q

BB S SIG="" 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]"" CC S SIG=SIG_$E(" ",Z0>1)_Z1

 Q

CC S Y=$O(^PS(51,"B",Z1,0)) Q:Y=""  S Z1=$P(^PS(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

APSPSIG   ; IHS/DSD/ENM - SIG INPUT TRANS 10-20-94 ;  [ 09/03/97   1:30 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

AA        ;IHS/DSD/ENM 08/01/96

           SET APSPZW=$SELECT($DATA(%APSITE):$PIECE(%APSITE,U,4),$DATA(^APSPCTRL(PSOSITE,0)):$PIECE(^(0),U,4),1:31)

           SET APSPZW=APSPZW-5

           IF $DATA(X)

               DO BB

           KILL APSPZW

 +1        QUIT 

BB         SET SIG=""

           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]""

                   DO CC

               SET SIG=SIG_$EXTRACT(" ",Z0>1)_Z1

 +1        QUIT 

CC         SET Y=$ORDER(^PS(51,"B",Z1,0))

           IF Y=""

               QUIT 

           SET Z1=$PIECE(^PS(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)

 +1        QUIT