PSBVT1.m

PSBVT1 ;BIRMINGHAM/BSR-BCMA ORDER VARIABLES UTILITY ;Mar 2004

 ;;3.0;BAR CODE MED ADMIN;;Mar 2004

 ;

PSBDCHK1(PSBSCHV)                   ;

 I PSBSCHV="" Q 0

 I PSBSCHV["PRN" Q 0

 S PSBYEA1="1"

 I PSBSCHV["@" S PSBSCHV=$P(PSBSCHV,"@")

 I $L(PSBSCHV)<2 Q 0

 F S=1:1:7 Q:$P(PSBSCHV,"-",S)=""  I $$PSBDCHK($P(PSBSCHV,"-",S))=0 S PSBYEA1=0  Q

 Q PSBYEA1

 ;     

PSBDCHK(PSBSCHV1)              ;

 S PSBYEA=0

 S PSBRDOW="SUNDAYS^MONDAYS^TUESDAYS^WEDNESDAYS^THURSDAYS^FRIDAYS^SATURDAYS"

 F I=1:1:7 D

 .S X=$P(PSBRDOW,"^",I),X1=$L(X),X2=$P(PSBSCHV1,"-",1),X3=$L(X2)  I X3<2 Q

 .I $E(X,1,X3)=X2 S PSBYEA=1

 Q PSBYEA

PSBVT1    ;BIRMINGHAM/BSR-BCMA ORDER VARIABLES UTILITY ;Mar 2004

 +1       ;;3.0;BAR CODE MED ADMIN;;Mar 2004

 +2       ;

PSBDCHK1(PSBSCHV) ;

 +1        IF PSBSCHV=""

               QUIT 0

 +2        IF PSBSCHV["PRN"

               QUIT 0

 +3        SET PSBYEA1="1"

 +4        IF PSBSCHV["@"

               SET PSBSCHV=$PIECE(PSBSCHV,"@")

 +5        IF $LENGTH(PSBSCHV)<2

               QUIT 0

 +6        FOR S=1:1:7

               IF $PIECE(PSBSCHV,"-",S)=""

                   QUIT 

               IF $$PSBDCHK($PIECE(PSBSCHV,"-",S))=0

                   SET PSBYEA1=0

                   QUIT 

 +7        QUIT PSBYEA1

 +8       ;     

PSBDCHK(PSBSCHV1) ;

 +1        SET PSBYEA=0

 +2        SET PSBRDOW="SUNDAYS^MONDAYS^TUESDAYS^WEDNESDAYS^THURSDAYS^FRIDAYS^SATURDAYS"

 +3        FOR I=1:1:7

               Begin DoDot:1

 +4                SET X=$PIECE(PSBRDOW,"^",I)

                   SET X1=$LENGTH(X)

                   SET X2=$PIECE(PSBSCHV1,"-",1)

                   SET X3=$LENGTH(X2)

                   IF X3<2

                       QUIT 

 +5                IF $EXTRACT(X,1,X3)=X2

                       SET PSBYEA=1

               End DoDot:1

 +6        QUIT PSBYEA