| 1 | LRBLSSN ;DALISC/FHS/DVR/AVAMC/REG - SSN SYNTAX CHECKER/EDIT ; 11/12/88 15:30 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | ;INPUT SCREEN FOR 65.5,.13 'G' X-REF
|
|---|
| 5 | K A I X'="P"&($L(X)<9) K X G END
|
|---|
| 6 | S A=X D STRIP I A'="P"&($L(A)<9) K X G END
|
|---|
| 7 | I A="P" D PSUE,PCHK S X=L_"P" G END
|
|---|
| 8 | I $E(A,10)="P" D PSUE S L=L_"P" S:A=L B=A D:'$D(B) PV D DUP G END
|
|---|
| 9 | I $L(A)>9,$E(A,10)'="P" K X G END
|
|---|
| 10 | I A'?9N K X G END
|
|---|
| 11 | G:$D(^LRE("G",A))&('$D(^LRE("G",A,DA))) NO S X=A
|
|---|
| 12 | END K %,A,B,C,L,N,Z Q
|
|---|
| 13 | CON S Z=$A(Z)-65\3+1 S:Z<0 Z=0 Q
|
|---|
| 14 | PCHK ;CHECK FOR DUPLICATE 'P' NUMBERS
|
|---|
| 15 | Q:$D(^LRE("G",L_"P",DA))
|
|---|
| 16 | 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")))
|
|---|
| 17 | Q
|
|---|
| 18 | STRIP I A'?.AN F %=1:1:$L(A) I $E(A,%)?1P S A=$E(A,0,%-1)_$E(A,%+1,99),%=%-1
|
|---|
| 19 | Q
|
|---|
| 20 | 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))
|
|---|
| 21 | 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)
|
|---|
| 22 | Q
|
|---|
| 23 | 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
|
|---|
| 24 | Q
|
|---|
| 25 | 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
|
|---|
| 26 | 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
|
|---|
| 27 | S:$D(X) X=A Q
|
|---|
