source: WorldVistAEHR/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFSA3.m@ 794

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1MPIFSA3 ;SF/CMC,DLR-STAND ALONE QUERY PART 2 ;MAY 13, 2003
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**28,31,35,43**;30 Apr 99
3 ;
4RDT(INDEX,HL,MSG) ;
5 N LASTNAME,FRSTNAME,SSN,BIRTHDAY,CMOR,NAME,ICN,POBC,POBS,PAST,HEREICN,HERESSN,MIDDLE,MNAME,SUFFIX,PREFIX,SEX,IEN,CMOR2,CLAIM,CASE,NOIS,CUSER,TFN,CMOR3,XXX,POW,MBIRTH,Y,LNGTH,SEQ1,SEQ,RDT,NXT,LNGTH2,LNGTH1,MPIREP,MPICOMP,TCASE
6 S MPICOMP=$E(HL("ECH"),1),MPIREP=$E(HL("ECH"),2)
7 S SEQ1=1,SEQ=0,X=0 F S X=$O(MSG(X)) Q:'X S LNGTH=$L(MSG(X),HL("FS")) D
8 . F Y=1:1:LNGTH S:Y'=1 SEQ=SEQ+1 D
9 .. S NXT=$P(MSG(X),HL("FS"),Y) D
10 ... I $L($G(RDT(SEQ)))=245 D Q
11 .... I $L(NXT_$G(RDT(SEQ,SEQ1)))>245 S LNGTH1=$L(RDT(SEQ,SEQ1)) S LNGTH2=245-LNGTH1,RDT(SEQ,SEQ1)=$G(RDT(SEQ,SEQ1))_$E(NXT,1,LNGTH2),LNGTH2=LNGTH2+1,NXT=$E(NXT,LNGTH2,$L(NXT)),SEQ1=SEQ1+1
12 .... I $L(NXT_$G(RDT(SEQ,SEQ1)))'>245 S RDT(SEQ,SEQ1)=$G(RDT(SEQ,SEQ1))_NXT
13 ... I $L(NXT_$G(RDT(SEQ)))>245 S LNGTH1=$L($G(RDT(SEQ))) S LNGTH2=245-LNGTH1,RDT(SEQ)=$G(RDT(SEQ))_$E(NXT,1,LNGTH2),LNGTH2=LNGTH2+1,NXT=$E(NXT,LNGTH2,$L(NXT)) S RDT(SEQ,SEQ1)=NXT
14 ... I $L(NXT_$G(RDT(SEQ)))'>245 S RDT(SEQ)=$G(RDT(SEQ))_NXT Q
15RDTAL ;
16 S FRSTNAME=RDT(6),LASTNAME=RDT(1),MIDDLE=RDT(9),SSN=RDT(2)
17 S SUFFIX=RDT(14),PREFIX=RDT(13)
18 S NAME=LASTNAME_","_FRSTNAME
19 I MIDDLE'="" S NAME=NAME_" "_MIDDLE
20 I SUFFIX'="" S NAME=NAME_" "_SUFFIX
21 I PREFIX'="" S NAME=NAME_" "_PREFIX
22 S ICN=RDT(5),CMOR=RDT(4),CMOR2=CMOR,CMOR3=CMOR
23 I $G(CMOR)'="" S IEN=$$LKUP^XUAF4(CMOR) I IEN'="" S CMOR2=$P($$NS^XUAF4(+IEN),"^")
24 I $G(SKIP)="Y" K SKIP Q
25 S BIRTHDAY=RDT(3)
26 I $G(LASTNAME)="" Q
27 I $G(BIRTHDAY)]"" S BIRTHDAY=$$FMDATE^HLFNC(BIRTHDAY),BIRTHDAY=$TR($$FMTE^XLFDT(BIRTHDAY,"5D"),"/","-")
28 S SEX=RDT(10),CLAIM=RDT(16),MNAME=RDT(15),POBC=RDT(11),POBS=RDT(12)
29 S PAST=RDT(8) I $G(PAST)]"" S PAST=$$FMDATE^HLFNC(PAST),PAST=$TR($$FMTE^XLFDT(PAST,"5D"),"/","-")
30 S CASE=RDT(17),NOIS=$P(CASE,"/",2),CUSER=$P(CASE,"/",3),TCASE=CASE,CASE=$P(CASE,"/")
31 S MBIRTH=RDT(19),POW=RDT(18)
32 I POW="N" S POW="No"
33 I POW="Y" S POW="Yes"
34TMP ;New pt. so incrementing index and resetting counter
35 K ^TMP("MPIFVQQ",$J,INDEX)
36 S ^TMP("MPIFVQQ",$J,INDEX,"DATA")=NAME_"^"_LASTNAME_"^"_SSN_"^"_BIRTHDAY_"^"_CMOR_"^"_ICN_"^"_FRSTNAME_"^^"_PAST_"^"_MIDDLE_"^"_SEX_"^"_POBC_"^"_POBS_"^"_PREFIX_"^"_SUFFIX_"^"_MNAME_"^"_CLAIM_"^"_TCASE_"^"_POW_"^"_MBIRTH
37 ;loop on TF's
38 ;I TF2'="" F XXX=1:1 S TTF2=$P(TF2,MPIREP,XXX) Q:TTF2="" S TFLL(INDEX,XXX)=TTF2
39 N LAST,SEQ,ORGLST,TFLL
40 I $D(RDT(7)),(RDT(7)'="^^~") N LAST,LASTN S SEQ=1 S LAST=$L(RDT(7),MPIREP) S LASTN=LAST-1 D
41 .N X F X=1:1:LAST-1 S TFLL(INDEX,X)=$P(RDT(7),MPIREP,X)
42 .I '$D(RDT(7,SEQ)) I $P(RDT(7),MPIREP,LAST)'="" S TFLL(INDEX,LAST)=$P($P(RDT(7),MPIREP,LAST),MPICOMP)
43 . N LOOP I $D(RDT(7,SEQ)) S LASTVAL=$P(RDT(7),MPIREP,LAST) S LOOP=LASTN+1 F Q:'$D(RDT(7,SEQ)) N LAST S LAST=$L(RDT(7,SEQ),MPIREP) D
44 ..N X F X=1:1:LAST-1 S TFLL(INDEX,(LOOP))=$S($D(LASTVAL):LASTVAL,1:"")_$P(RDT(7,SEQ),MPIREP,X) K LASTVAL S LOOP=LOOP+1
45 ..I '$D(RDT(7,SEQ)) I $P(RDT(7),MPIREP,LAST)'="" S TFLL(INDEX,(LASTN+LAST))=$P($P(RDT(7),MPIREP,LAST),MPICOMP) S LOOP=LOOP+1
46 ..I $D(RDT(7,SEQ)) S LASTVAL=$P(RDT(7,SEQ),MPIREP,LAST)
47 ..S SEQ=SEQ+1
48 ;loop on TFLL to build TF LIST nodes
49 S X=0 F S X=$O(TFLL(INDEX,X)) Q:'X S ^TMP("MPIFVQQ",$J,INDEX,"TF",X)=TFLL(INDEX,X)
50ALIAS ;loop on alias last name
51 N LAST,SEQ,ORGLST,AL
52 I $D(RDT(20)) N LAST S SEQ=1 S LAST=$L(RDT(20),MPIREP) D
53 .N X F X=1:1:LAST-1 S AL(INDEX,X)=$P(RDT(20),MPIREP,X)_","_$P($G(RDT(21)),MPIREP,X)_" "_$P($G(RDT(22)),MPIREP,X)_" "_$P($G(RDT(23)),MPIREP,X)_" "_$P($G(RDT(24)),MPIREP,X)
54 .I '$D(RDT(20,SEQ)) I $P(RDT(20),MPIREP,LAST)'="" S AL(INDEX,LAST)=$P(RDT(20),MPIREP,LAST)_","_$P($G(RDT(21)),MPIREP,LAST)_" "_$P($G(RDT(22)),MPIREP,LAST)_" "_$P($G(RDT(23)),MPIREP,LAST)_" "_$P($G(RDT(24)),MPIREP,LAST)
55 . I $D(RDT(20,SEQ)) S LASTVAL=$P(RDT(20),MPIREP,LAST) F Q:'$D(RDT(20,SEQ)) N LAST S LAST=$L(RDT(20,SEQ),MPIREP) D
56 ..N X F X=1:1:LAST-1 S AL(INDEX,X)=$S($D(LASTVAL):LASTVAL,1:"")_$P(RDT(20,SEQ),MPIREP,X)_","_$P($G(RDT(21)),MPIREP,X)_" "_$P($G(RDT(22)),MPIREP,X)_" "_$P($G(RDT(23)),MPIREP,X)_" "_$P($G(RDT(24)),MPIREP,X) K LASTVAL
57 ..I '$D(RDT(20,SEQ)) I $P(RDT(20),MPIREP,LAST)'="" S AL(INDEX,LAST)=$P($P(RDT(20),MPIREP,LAST),MPICOMP)_","_$P($G(RDT(21)),MPIREP,LAST)_" "_$P($G(RDT(22)),MPIREP,LAST)_" "_$P($G(RDT(23)),MPIREP,LAST)_" "_$P($G(RDT(24)),MPIREP,LAST)
58 ..I $D(RDT(20,SEQ)) S LASTVAL=$P(RDT(20,SEQ),MPIREP,LAST)
59 ..S SEQ=SEQ+1
60 S X=0 F S X=$O(AL(INDEX,X)) Q:'X S ^TMP("MPIFVQQ",$J,INDEX,"ALIAS",X)=AL(INDEX,X)
61 Q
Note: See TracBrowser for help on using the repository browser.