source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRBLSSN.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.5 KB
Line 
1LRBLSSN ;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
12END K %,A,B,C,L,N,Z Q
13CON S Z=$A(Z)-65\3+1 S:Z<0 Z=0 Q
14PCHK ;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
18STRIP 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
20PSUE 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
23PV 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
25NO 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
26DUP 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
Note: See TracBrowser for help on using the repository browser.