source: WorldVistAEHR/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFSAQ.m@ 701

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1MPIFSAQ ;SF/CMC-STAND ALONE QUERY ;JAN 12, 1998
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**1,3,8,13,17,21,23,28,35**;30 Apr 99
3 ;
4VTQ(MPIVAR) ;
5 D VTQ^MPIFSA2(.MPIVAR)
6 Q
7 ;
8INTACTV ;Interactive standalone query - Display Only patient doesn't have to be in Patient file
9 S FLG=0 K DIR,X,Y S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is Patient in the PATIENT file " D ^DIR
10 G:(Y'=1)&(Y'=0) END
11 I Y=1 S FLG=1 D PAT(.MPIVAR)
12 I Y'=1,'$D(MPIVAR) D NOPAT(.MPIVAR)
13 I '$D(MPIVAR("DFN"))&(FLG'=0) G END
14 I +$G(MPIVAR("DOB"))'>0 W !,"DOB is missing - Required field" G END
15 D VTQ^MPIFSA2(.MPIVAR) K DIR,X,Y,MPIVAR,FLG
16 Q
17END K DIR,X,Y,MPIVAR,DIRUT,DTOUT,DUOUT
18 Q
19CLEAN(NAM) ;NAM is the name to be cleaned up, Returned from this function is a clean name
20 N YY,I
21 I NAM?.E1L.E F I=1:1:$L(NAM) S:$E(NAM,I)?1L NAM=$E(NAM,0,I-1)_$C($A(NAM,I)-32)_$E(NAM,I+1,$L(NAM)) ; only uppercase
22 F YY=", "," " F Q:'$F(NAM,YY) S NAM=$E(NAM,1,($F(NAM,YY)-2))_$E(NAM,$F(NAM,YY),$L(NAM)) ; no space after comma and no double spaces
23 F Q:$E(NAM,$L(NAM))'=" " S NAM=$E(NAM,1,$L(NAM)-1) ; no space at the end
24 Q NAM
25PAT(MPIVAR) ;patient is in local Patient file
26PATA N DIC,X,Y,DIQ,DR,DA,MPIFAR,DFN,DTOUT,DUOUT
27 S DIC="^DPT(",DIC(0)="AEQZM",DIC("A")="Patient Name: " D ^DIC
28 G:$D(DTOUT)!($D(DUOUT))!(Y="^")!(X="") END
29 I +Y=-1 W !,"Patient not found. Try Again" G PATA
30 S (DFN,MPIVAR("DFN"))=+Y,MPIVAR("NM")=$P(Y(0),"^"),DIQ="MPIFAR",DR=".09;.03;.02",DIC="^DPT(",DA=+Y,DIQ(0)="I" D EN^DIQ1 K DA
31 S MPIVAR("DOB")=$G(MPIFAR(2,DFN,.03,"I")),MPIVAR("SSN")=$G(MPIFAR(2,DFN,.09,"I")) I MPIVAR("SSN")["P" S MPIVAR("SSN")=""
32 S MPIVAR("SEX")=$G(MPIFAR(2,DFN,.02,"I"))
33 Q
34NOPAT(MPIVAR) ; patient is not in the local Patient file
35NAME N DTOUT,DUOUT,DIR,X,Y,%
36 S DIR(0)="FU^::",DIR("A")="PATIENT NAME (last,first middle)" D ^DIR
37 G:$D(DTOUT)!($D(DUOUT))!(Y="^") END
38 I (Y="")!($L(Y)>45)!($L(Y)<3) W !,"Name should be Last,first middle and at least 3 characters and no more than 30" G NAME
39 I (Y?1P.E)!(Y'?1U.ANP)!(Y'[",")!(Y[":")!(Y[";") W !,"Name should be Last,first middle and at least 3 characters and no more than 30" G NAME
40 I Y'?.UNP F %=1:1:$L(Y) I $E(Y,%)?1L S Y=$E(Y,0,%-1)_$C($A(Y,%)-32)_$E(Y,%+1,999)
41 S MPIVAR("NM")=$$CLEAN(Y)
42DOB K DIR,X,Y S DIR(0)="DU^::AE",DIR("A")="Date of Birth" D ^DIR
43 G:$D(DTOUT)!($D(DUOUT)) END
44 S MPIVAR("DOB")=Y
45SSN ; ssn is optional
46 K DIR,X,Y S DIR(0)="FUO^9:9:",DIR("A")="9 Digit SSN (No Dashes)" D ^DIR
47 G:$D(DTOUT)!($D(DUOUT)) END
48 I Y'="",Y'?9N W !,"SSN should be 9 numbers" G SSN
49 S MPIVAR("SSN")=Y
50 Q
51SEG(SEGMENT,PIECE,CODE) ;Return segment from MPIDC array and kill node
52 N MPINODE,MPIDATA,MPIDONE,MPIC,HOLD K MPIDONE
53 I '$D(MPIC) S MPIC=$E(HL("ECH"))
54 S MPINODE=0
55 F S MPINODE=$O(MPIDC(MPINODE)) Q:MPINODE=""!($D(MPIDONE)) D
56 .S MPIDATA=MPIDC(MPINODE)
57 .I ($P(MPIDATA,HL("FS"),1)=SEGMENT)&($P($P(MPIDATA,HL("FS"),PIECE),MPIC,1)=CODE) S MPIDONE=1 S HOLD(MPINODE)="" D
58 ..I SEGMENT="RDT" F S MPINODE=$O(MPIDC(MPINODE)) Q:MPINODE="" Q:MPIDC(+MPINODE)="" S MPIDATA=MPIDATA_MPIDC(MPINODE),HOLD(MPINODE)=""
59 I $D(MPIDONE) S MPINODE=0 F S MPINODE=$O(HOLD(MPINODE)) Q:MPINODE="" K MPIDC(MPINODE)
60 Q:$D(MPIDONE) $G(MPIDATA)
61 Q ""
Note: See TracBrowser for help on using the repository browser.