- 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 ;
