source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRDECSS.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1IMRDECSS ;HCIOFO/FAI-DECODE SSN ENCRYPTION;07/05/00 4:21
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
3BEGIN ;
4 D START,SEARCH
5KILL K ^TMP($J),IMRSSN,IMRX,IMRDOB,IMRNAME,IMRSSN1,X1,IMRDFN
6 Q
7START W !! K DIR S DIR(0)="F^9:13^",DIR("A")="Enter Coded SSN" D ^DIR K DIR S IMRCDSSN=Y
8 Q:$G(IMRCDSSN)["^"
9 W !!,"I will now search the database to decode the SSN... please wait",!
10 F IMRJ=0:0 S IMRJ=$O(^IMR(158,IMRJ)),IMRCAT="" Q:IMRJ'>0 S X=+^(IMRJ,0) D ^IMRXOR S (IMRDFN,IMRFN)=X,(FN,DFN,D0,DA)=IMRFN,IMRCAT=$P($G(^IMR(158,IMRJ,0)),U,42) D IMRREF
11 Q
12IMRREF ; store and reference immunology decoding
13 D DEM^VADPT
14 S IMRNAME=VADM(1),IMRSSN1=$P(VADM(2),U),IMRDOB1=$P(VADM(3),U)
15 K DFN,VA,VADM
16 S X=IMRDFN D ^IMRXOR S IMRX=X,X=+IMRSSN1 D ^IMRXOR
17 S IMRSSN=X_$S(IMRSSN1["P":"P",1:""),X=$E(IMRDOB1,1,5)_"00" D ^IMRXOR
18 S IMRDOB=X
19 S X=IMRDOB1,X1=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
20 S:$G(IMRX)'="" ^TMP($J,IMRSSN,IMRX)=IMRDOB_"^"_IMRNAME_"^"_IMRSSN1_"^"_X1_"^"_IMRDFN
21 Q
22SEARCH Q:$G(IMRCDSSN)["^"
23 S (IMRX,IMRDOB,IMRNAME,IMRSSN1,X1,IMRDFN)=""
24 S IMRX="" F S IMRX=$O(^TMP($J,IMRCDSSN,IMRX)) Q:IMRSSN="" G DISP
25 Q
26DISP ; Display patient info
27 I $G(IMRX)="" W !,"The coded number you entered is either not listed in your local ICR",!,"or was typed incorrectly. Please check that you entered the coded SSN",!,"correctly. *** NO TRANSLATION FOUND FOR THIS PATIENT ***" Q
28 S REC=^TMP($J,IMRCDSSN,IMRX),IMRDOB=$P(REC,U,1),IMRNAME=$P(REC,U,2),IMRSSN1=$P(REC,U,3),X1=$P(REC,U,4),IMRDFN=$P(REC,U,5)
29 W !!?12,"Coded SSN: ",IMRCDSSN
30 W !?12,"Name: ",IMRNAME
31 W !?12,"SSN: ",IMRSSN1
32 W !?12,"Date of Birth: ",X1
33 W !?12,"Patient's id in the Immunology Case Study file: ",IMRX
34 W !?12,"Coded Date of Birth: ",IMRDOB
35 W !?12,"Patient's number in the Patient file: ",IMRDFN
36 G BEGIN
37 Q
Note: See TracBrowser for help on using the repository browser.