LRBLSSN.m

LRBLSSN ; IHS/DIR/FJE - SSN SYNTAX CHECKER/EDIT 11/12/88 15:30 ;

 ;;5.2;LR;;NOV 01, 1997

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 ;INPUT SCREEN FOR 65.5,.13 'G' X-REF

 ;IHS/ANMC/CLS 11/1/95 blood donor file

 K A I X'="P"&($L(X)<9) K X G END

 S A=X D STRIP I A'="P"&($L(A)<9) K X G END

 I A="P" D PSUE,PCHK S X=L_"P" G END

 I $E(A,10)="P" D PSUE S L=L_"P" S:A=L B=A D:'$D(B) PV D DUP G END

 I $L(A)>9,$E(A,10)'="P" K X G END

 I A'?9N K X G END

 G:$D(^LRE("G",A))&('$D(^LRE("G",A,DA))) NO S X=A

END K %,A,B,C,L,N,Z Q

CON S Z=$A(Z)-65\3+1 S:Z<0 Z=0 Q

PCHK ;CHECK FOR DUPLICATE 'P' NUMBERS

 Q:$D(^LRE("G",L_"P",DA))

 Q:'$D(^LRE("G",L_"P"))  F A=0:0 S L=L+1 Q:$D(^LRE("G",L_"P",DA))!'($D(^LRE("G",L_"P")))

 Q

STRIP I A'?.AN F %=1:1:$L(A) I $E(A,%)?1P S A=$E(A,0,%-1)_$E(A,%+1,99),%=%-1

 Q

PSUE S L=^LRE(DA,0),C=$P(L,"^",3),N=$P(L,"^"),L(1)=$E($P(N," ",2)),L(3)=$E(N),L(2)=$E($P(N,",",2))

 S Z=L(1) D CON S L(1)=Z,Z=L(2) D CON S L(2)=Z,Z=L(3) D CON S L(3)=Z,L=L(2)_L(1)_L(3)_$E(C,4,7)_$E(C,2,3)

 Q

PV I '$D(^LRE("G",A,DA)) W !!?10,$C(7),"Not a proper Pseudo SSN.  Enter 9 numbers followed by 'P'",!?15,"or you may enter a 'P'." K X Q

 Q

NO S N(1)=+$O(^LRE("G",A,0)),N=$S($D(^LRE(N(1),0)):$P(^(0),U),1:"Error in Data Base ") W !?10,"This SSN is assigned to ",N,!?15,"Donor #:",N(1),! K X G END

DUP I $D(^LRE("G",A))&'($D(^LRE("G",A,DA))) S N(1)=+$O(^LRE("G",A,0)),N=$P(^LRE(N(1),0),U) W !!?10,"Duplicate Pseudo Number  -- ALREADY AS ASSIGNED TO ",N,!?15,"Donor # :",N(1),! K X Q

 S:$D(X) X=A Q

LRBLSSN   ; IHS/DIR/FJE - SSN SYNTAX CHECKER/EDIT 11/12/88 15:30 ;

 +1       ;;5.2;LR;;NOV 01, 1997

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4       ;INPUT SCREEN FOR 65.5,.13 'G' X-REF

 +5       ;IHS/ANMC/CLS 11/1/95 blood donor file

 +6        KILL A

           IF X'="P"&($LENGTH(X)<9)

               KILL X

               GOTO END

 +7        SET A=X

           DO STRIP

           IF A'="P"&($LENGTH(A)<9)

               KILL X

               GOTO END

 +8        IF A="P"

               DO PSUE

               DO PCHK

               SET X=L_"P"

               GOTO END

 +9        IF $EXTRACT(A,10)="P"

               DO PSUE

               SET L=L_"P"

               IF A=L

                   SET B=A

               IF '$DATA(B)

                   DO PV

               DO DUP

               GOTO END

 +10       IF $LENGTH(A)>9

               IF $EXTRACT(A,10)'="P"

                   KILL X

                   GOTO END

 +11       IF A'?9N

               KILL X

               GOTO END

 +12       IF $DATA(^LRE("G",A))&('$DATA(^LRE("G",A,DA)))

               GOTO NO

           SET X=A

END        KILL %,A,B,C,L,N,Z

           QUIT 

CON        SET Z=$ASCII(Z)-65\3+1

           IF Z<0

               SET Z=0

           QUIT 

PCHK      ;CHECK FOR DUPLICATE 'P' NUMBERS

 +1        IF $DATA(^LRE("G",L_"P",DA))

               QUIT 

 +2        IF '$DATA(^LRE("G",L_"P"))

               QUIT 

           FOR A=0:0

               SET L=L+1

               IF $DATA(^LRE("G",L_"P",DA))!'($DATA(^LRE("G",L_"P")))

                   QUIT 

 +3        QUIT 

STRIP      IF A'?.AN

               FOR %=1:1:$LENGTH(A)

                   IF $EXTRACT(A,%)?1P

                       SET A=$EXTRACT(A,0,%-1)_$EXTRACT(A,%+1,99)

                       SET %=%-1

 +1        QUIT 

PSUE       SET L=^LRE(DA,0)

           SET C=$PIECE(L,"^",3)

           SET N=$PIECE(L,"^")

           SET L(1)=$EXTRACT($PIECE(N," ",2))

           SET L(3)=$EXTRACT(N)

           SET L(2)=$EXTRACT($PIECE(N,",",2))

 +1        SET Z=L(1)

           DO CON

           SET L(1)=Z

           SET Z=L(2)

           DO CON

           SET L(2)=Z

           SET Z=L(3)

           DO CON

           SET L(3)=Z

           SET L=L(2)_L(1)_L(3)_$EXTRACT(C,4,7)_$EXTRACT(C,2,3)

 +2        QUIT 

PV         IF '$DATA(^LRE("G",A,DA))

               WRITE !!?10,$CHAR(7),"Not a proper Pseudo SSN.  Enter 9 numbers followed by 'P'",!?15,"or you may enter a 'P'."

               KILL X

               QUIT 

 +1        QUIT 

NO         SET N(1)=+$ORDER(^LRE("G",A,0))

           SET N=$SELECT($DATA(^LRE(N(1),0)):$PIECE(^(0),U),1:"Error in Data Base ")

           WRITE !?10,"This SSN is assigned to ",N,!?15,"Donor #:",N(1),!

           KILL X

           GOTO END

DUP        IF $DATA(^LRE("G",A))&'($DATA(^LRE("G",A,DA)))

               SET N(1)=+$ORDER(^LRE("G",A,0))

               SET N=$PIECE(^LRE(N(1),0),U)

               WRITE !!?10,"Duplicate Pseudo Number  -- ALREADY AS ASSIGNED TO ",N,!?15,"Donor # :",N(1),!

               KILL X

               QUIT 

 +1        IF $DATA(X)

               SET X=A

           QUIT