AMQQAVB ; IHS/CMI/THL - GETS BLOOD QUANTUM ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
COMPB I AMQQNOCO>1 D COMPB2 Q
R !,"Blood Quantum: ",X:DTIME E S X=U
I X=U S AMQQQUIT="" Q
I X="" Q
I X?1."?" D HELPB G COMPB
D CK
I Y'=-1 S AMQQCOMP=X Q
W " ??",*7
G COMPB
;
CK I X?1.N1"/"1.N,$P(X,"/",2)>+X S Y=X Q
F %=1:1:4 S Z=$P("UNKNOWN^UNSPECIFIED^NONE^FULL",U,%) I $E(Z,1,$L(X))=X W $E(Z,$L(X)+1,99) S (X,Y)=Z G CKEXIT
S Y=-1
Q
CKEXIT I $E(X)="U",AMQQSYMB'="=" S Y=-1 Q
I AMQQSYMB=">",$E(X)="F" S Y=-1 Q
I AMQQSYMB="<",$E(X)="N" S Y=-1
Q
;
TRANS ; ENTRY POINT FROM AMQQATL
I X?1.N1"/"1.N S X=+X/$P(X,"/",2),X=$E(X,1,5)
S X=$S(X=+X:X,$E(X)="F":1,$E(X,1,3)="UNK":1.1,$E(X,1,3)="UNS":1.2,$E(X)="N":0,1:"")
Q
;
HELPB W !!,"Enter one of the following: 'FULL', 'NONE', 'UNKNOWN' or some fraction",!,"such as '1/2' or '5/8'.",!!
Q
;
COMPB2 R !,"Blood Quantum (lower limit): ",X:DTIME E S X=U
I X=U S AMQQQUIT="" Q
I X="" S X="NONE" W X
I X?1."?" D HELPB G COMPB2
I $E(X)="U" W " ??",*7 G COMPB2
D CK
I Y=-1 W " ??",*7 G COMPB2
S X(1)=X
G C21
C21 R !,"Blood Quantum (upper limit): ",X:DTIME E S X=U
I X=U S AMQQQUIT="" Q
I X="" S X="FULL" W X
I X?1."?" D HELPB G C21
I $E(X)="U" W " ??",*7 G C21
D CK
I Y=-1 W " ??",*7
S X(2)=X
S AMQQCOMP=X(1)_";"_X(2)
S X=X(1)
D TRANS
S X(1)=X
S X=X(2)
D TRANS
S X(2)=X
I X(2)<X(1) W " WHOOPS...TRY AGAIN",*7,*7,! S AMQQCOMP="" G COMPB2
Q
;
AMQQAVB ; IHS/CMI/THL - GETS BLOOD QUANTUM ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
COMPB IF AMQQNOCO>1
DO COMPB2
QUIT
+1 READ !,"Blood Quantum: ",X:DTIME
IF '$TEST
SET X=U
+2 IF X=U
SET AMQQQUIT=""
QUIT
+3 IF X=""
QUIT
+4 IF X?1."?"
DO HELPB
GOTO COMPB
+5 DO CK
+6 IF Y'=-1
SET AMQQCOMP=X
QUIT
+7 WRITE " ??",*7
+8 GOTO COMPB
+9 ;
CK IF X?1.N1"/"1.N
IF $PIECE(X,"/",2)>+X
SET Y=X
QUIT
+1 FOR %=1:1:4
SET Z=$PIECE("UNKNOWN^UNSPECIFIED^NONE^FULL",U,%)
IF $EXTRACT(Z,1,$LENGTH(X))=X
WRITE $EXTRACT(Z,$LENGTH(X)+1,99)
SET (X,Y)=Z
GOTO CKEXIT
+2 SET Y=-1
+3 QUIT
CKEXIT IF $EXTRACT(X)="U"
IF AMQQSYMB'="="
SET Y=-1
QUIT
+1 IF AMQQSYMB=">"
IF $EXTRACT(X)="F"
SET Y=-1
QUIT
+2 IF AMQQSYMB="<"
IF $EXTRACT(X)="N"
SET Y=-1
+3 QUIT
+4 ;
TRANS ; ENTRY POINT FROM AMQQATL
+1 IF X?1.N1"/"1.N
SET X=+X/$PIECE(X,"/",2)
SET X=$EXTRACT(X,1,5)
+2 SET X=$SELECT(X=+X:X,$EXTRACT(X)="F":1,$EXTRACT(X,1,3)="UNK":1.1,$EXTRACT(X,1,3)="UNS":1.2,$EXTRACT(X)="N":0,1:"")
+3 QUIT
+4 ;
HELPB WRITE !!,"Enter one of the following: 'FULL', 'NONE', 'UNKNOWN' or some fraction",!,"such as '1/2' or '5/8'.",!!
+1 QUIT
+2 ;
COMPB2 READ !,"Blood Quantum (lower limit): ",X:DTIME
IF '$TEST
SET X=U
+1 IF X=U
SET AMQQQUIT=""
QUIT
+2 IF X=""
SET X="NONE"
WRITE X
+3 IF X?1."?"
DO HELPB
GOTO COMPB2
+4 IF $EXTRACT(X)="U"
WRITE " ??",*7
GOTO COMPB2
+5 DO CK
+6 IF Y=-1
WRITE " ??",*7
GOTO COMPB2
+7 SET X(1)=X
+8 GOTO C21
C21 READ !,"Blood Quantum (upper limit): ",X:DTIME
IF '$TEST
SET X=U
+1 IF X=U
SET AMQQQUIT=""
QUIT
+2 IF X=""
SET X="FULL"
WRITE X
+3 IF X?1."?"
DO HELPB
GOTO C21
+4 IF $EXTRACT(X)="U"
WRITE " ??",*7
GOTO C21
+5 DO CK
+6 IF Y=-1
WRITE " ??",*7
+7 SET X(2)=X
+8 SET AMQQCOMP=X(1)_";"_X(2)
+9 SET X=X(1)
+10 DO TRANS
+11 SET X(1)=X
+12 SET X=X(2)
+13 DO TRANS
+14 SET X(2)=X
+15 IF X(2)<X(1)
WRITE " WHOOPS...TRY AGAIN",*7,*7,!
SET AMQQCOMP=""
GOTO COMPB2
+16 QUIT
+17 ;
