VistA-WorldVistAEHR/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBVT1.m

20 lines
606 B
Mathematica

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