Difference between revisions of "Single Patient Record Back-up"

Revision as of 03:24, 4 November 2009

FINISHED PROGRAM FOR RETRIEVING ONE PATIENT DATA METHOD #1:

1 ==================================================
2 ===============================
3 ===============================
4 ===============================
5 ===============================
6 ===============================
7 ============================================================
8 ====
9 ============================================================

==================================================

USER>D ^%CD

Namespace: VISTA You're in namespace VISTA Default directory is c:\cachesys\mgr\vista\ VISTA>

VISTA>S DUZ=10000000020

VISTA>D ^XUP

Setting up programmer environment This is a TEST account.

Terminal Type set to: C-VT320

Select OPTION NAME: VISTA>

VISTA>D ^NAM5SSN

===============================

VISTA SELECT PATIENT PROCEDURE:

===============================

Select PATIENT NAME: ONE

  1   ONE,IMAGEPATIENT        4-15-53    666061001     NO     NSC

VETERAN

  2   ONE,INPATIENT        3-9-45    666000801     NO     NSC VETERAN

  3   ONE,OUTPATIENT        3-9-45    666000601     NO     NSC

VETERAN

  4   ONE,PATIENT        4-7-35    666000001     YES     SC VETERAN

  5   ONEHUNDRED,INPATIENT        3-9-45    666000900     NO     NSC

VETERAN

ENTER '^' TO STOP, OR CHOOSE 1-5: 4 ONE,PATIENT 4-7-35 666000001 YES SC VETERAN

Enrollment Priority: GROUP 3    Category: IN PROCESS    End Date:

===============================

NAME5SSN SELECTED PATIENT DATA:

===============================

Name: ONE,PATIENT SSN: 666000001 SEX: M DOB: 03/12/8276 ADDRESS: 1312 Ashton Place CITY: Rowling STATE: WEST VIRGINIA ZIP: 99998 PHONE: 222-555-8235

===============================

VISTA>

============================================================

OUTPUT.TXT:

====

Name^ONE,PATIENT^SSN^666000001^SEX^M^DOB^03/12/8276^ADDRESS^1312 Ashton Place^CITY^Rowling^STATE^WEST VIRGINIA^ZIP^99998PHONE^222-555-8235^

============================================================

NAM5SSN ; Lab 9 M1; VISTA SELECT PATIENT NAME: W NAME & SSN; AHR;

09/28/2009


Setting up a VistA environment


USER>D ^%CD

Namespace: VISTA
You're in namespace VISTA
Default directory is c: \cachesys\mgr\vista\

VISTA>S DUZ=10000000020

VISTA>D ^XUP

Setting up programmer environment
This is a TEST account.

Terminal Type set to: C-VT320

Select OPTION NAME
VISTA>

VISTA>D ^NAM5SSN


Assuming you want field #9 from File #2, the name of the field is

retrieved

with the MUMPS expression
WRITE $PIECE(^DD(2,9,0),"^",1),!


observe the difference between
field number and global subscript location

Select DATA DICTIONARY UTILITY OPTION: LIST FILE ATTRIBUTES
START WITH WHAT FILE: PATIENT//
GO TO WHAT FILE: PATIENT//
Select SUB-FILE
Select LISTING FORMAT: STANDARD// CUSTOM-TAILORED
SORT BY: LABEL// NUMBER
START WITH NUMBER: FIRST//
WITHIN NUMBER, SORT BY
FIRST PRINT ATTRIBUTE: LABEL
THEN PRINT ATTRIBUTE: NUMBER
THEN PRINT ATTRIBUTE: GLOBAL SUBSCRIPT LOCATION
THEN PRINT ATTRIBUTE
Heading (S/C): FIELD SEARCH//
DEVICE: 0;80;999 TELNET
PATIENT FILE FIELD SEARCH SEP 24,2009 22: 01 PAGE 1
LABEL NUMBER GLOBAL
SUBSCRIPT LOCATION

Below is the section on address. Note
Field Label, Number, and Global Subscript Location

-----


NAME .01 0;1
SEX .02 0;2
DATE OF BIRTH .03 0;3
AGE .033 ;
MARITAL STATUS .05 0;5
RACE .06 0;6
OCCUPATION .07 0;7
RELIGIOUS PREFERENCE .08 0;8
DUPLICATE STATUS .081 0;18
PATIENT MERGED TO .082 0;19
CHECK FOR DUPLICATE .083 0;20
SOCIAL SECURITY NUMBER .09 0;9


STREET ADDRESS [LINE 1] .111 .11;1
ZIP+4 .1112 .11;12
STREET ADDRESS [LINE 2] .112 .11;2
STREET ADDRESS [LINE 3] .113 .11;3
CITY .114 .11;4
STATE .115 .11;5
ZIP CODE .116 .11;6
COUNTY .117 .11;7
ADDRESS CHANGE DT/TM .118 .11;13
ADDRESS CHANGE SOURCE .119 .11;14

Thus the first line of the address is in piece 1 of subscript " .11"
Like so: $P(^DPT(patientnum,.11),"^",1)
And CITY is in piece 4
$P(^DPT(patnumber,.11),"^",4)


Addressing this bit of MUMPS code

S ZSTATE=$P(^DD(5,STATE,0),"^",1)

this says (in MUMPS-ish English)

create a local variable for this process only named ZSTATE
with the value found by reading the local variable STATE
and using it as a FileMan Field Number.
Use this FileMan Field Number to find the FileMan Field Name
by looking it up in the Data Dictionary of the File #5.
(not stated, but known by me, File #5 is the VistA STATE File)
The Field Name is found by retrieving the "Zeroth" node of the
Data Dictionary, and then processing it by removing the first piece
of the string stored in that zeroth node value, which is itself a
string of characters, using a "^" (caret character) as a delimiter.

This does NOT do what you have been saying you want to do.

If you want to look up the name of a state using the index for that
state (the internal entry number of that entry in the STATE File)
you must look in the global used for the STATE File.

If you use the internal entry number of the state as if it were a

field

number, you will get the wrong information.

If you want to get the value of a particular state, you must find

out the

global root for the STATE File. I happen to know that the global

root

for the STATE File is "^DIC(5," I know this because I use the

FileMan

inquire option to find it.

Select OPTION: INQUIRE TO FILE ENTRIES

OUTPUT FROM WHAT FILE: STATE// FILE
Select FILE: STATE
ANOTHER ONE
STANDARD CAPTIONED OUTPUT? Yes// (Yes)
Include COMPUTED fields: (N/Y/R/B): NO// BOTH Computed Fields and

Record Number

(IEN)

NUMBER: 5 NAME: STATE
APPLICATION GROUP: VA
DESCRIPTION: This file contains the name of the state (or outlying

area) as

issued by the Department of Veterans Affairs and issued in M-1, Part

I,

Appendix B. These entries should remain as distributed and should

not be

edited or updated unless done via a software upgrade or under

direction of VA

Central Office.
GLOBAL NAME (c): ^DIC(5, ENTRIES (c): 82
DD ACCESS (c): # WR ACCESS (c): #
DEL ACCESS (c): # LAYGO ACCESS (c): #
VERSION (c): 5.3 COMPILED CROSS-REFERENCES (c): NO

After I find out the global root for the STATE File, I have to get

the

value for the NAME
of the STATE. I happen to know this is in the Zeroth node and the
first piece using
"^" as a delimiter.

So the code should be

SET ZSTATE=$P(^DIC(5,STATE,0),"^",1)

FROM
DGPHIST ;WASH/ERC - PURPLE HEART REQUEST HISTORY ;23 AUG 00 ;
5.3;Registration;**343**,Aug 13, 1993

EN ;Entry point N DGDFN,DGPAT,DGNAM,DGSSN N SEX,DOB,ADDRESS,CITY,STATE,ZIP,PHONE


I DTIME="" S DTIME=30 ; added 1 line; TIMEOUT 4 READ set if ^XUP not

run S DTIME=9999

W !,"===========================================" W !,"VISTA SELECT PATIENT PROCEDURE: ",! W "===========================================",!

S DGDFN=$$GETDFN() Q:DGDFN'>0

S DGNAM=$$NAME(DGDFN)

S DGSSN=$$SSN(DGDFN)

S SEX=$P($G(^DPT(DGDFN,0)),"^",2)

S DOB=$P($G(^DPT(DGDFN,0)),"^",3) S ZDOB=$ZDATETIME(DOB)

S ADDRESS=$P(^DPT(DGDFN,.11),"^",1)

S CITY=$P(^DPT(DGDFN,.11),"^",4)

S STATE=$P(^DPT(DGDFN,.11),"^",5) SET ZSTATE=$P(^DIC(5,STATE,0),"^",1)

S ZIP=$P(^DPT(DGDFN,.11),"^",6)

S PHONE=$P(^DPT(DGDFN,.13),"^",1)


cell .13;10
S CELLPHONE=$P(^DPT(DGDFN,.13),"^",10)
e-mail address .13;3
S EMAIL=$P(^DPT(DGDFN,.13),"^",3)

W !,"===========================================",! W !,"NAME5SSN SELECTED PATIENT DATA: " W !,"===========================================",! W !,"Name: ",DGNAM," SSN: ",DGSSN W !,"SEX: ",SEX," DOB: ",ZDOB," ADDRESS: ",ADDRESS W !,"CITY: ",CITY," STATE: ",ZSTATE," ZIP: ",ZIP W !,"PHONE: ", PHONE,! W !,"===========================================",!



To write to an external file name

set externalfilename="C:\Documents and Settings\robinson\My Documents \HOMEWORK\MUMPS\Lab 09\out_file.txt" open externalfilename:("NRW") use externalfilename


write to the selected file
write a text file with the format: Field Id Name^Field Data^

W "Name^",DGNAM,"^SSN^",DGSSN,"^" ; Line I have written W "SEX^",SEX,"^DOB^",ZDOB,"^ADDRESS^",ADDRESS,"^" W "CITY^",CITY,"^STATE^",ZSTATE,"^ZIP^",ZIP W "PHONE^", PHONE,"^"

close externalfilename



W !,"WHOLE GLOBAL: ",$G(^DPT(DGDFN,0))

FROM
VAFCMS01 ;BP-CIOFO/JRP - ADMISSION RETRANSMISSION;8/3/1998 ;
5.3;Registration;**209**;Aug 13, 1993

GETDFN() ;Get pointer to PATIENT file (#2)

Input: None
Output: DFN - Pointer to PATIENT file (#2)
-1 - No entry selected

N DIC,X,Y,DTOUT,DUOUT S DIC="^DPT(" S DIC(0)="AEMNQZ" D ^DIC Q +Y


FROM
DGENPTA ;ALB/CJM - Patient API - Retrieve Data; 13 JUN 1997

5.3;Registration;**121,122,147**;08/13/93

SSN(DFN) ;

Description: Function returns the patient's SSN, or "" on failure.

Q:'DFN "" Q $P($G(^DPT(DFN,0)),"^",9)

NAME(DFN) ;

Description: Function returns the patient's NAME, or "" on failure.

Q:'DFN "" Q $P($G(^DPT(DFN,0)),"^")

QUIT ; END NAM2SSN


VERY IMPORTANT EXAMPLE OF PATIENT LOOKUP MAIN ROUTINE

DPTLK ;ALB/RMO,RTK - MAS Patient Look-up Main Routine ; 3/22/05

4:19pm

5.3;Registration;**32,72,93,73,136,157,197,232,265,277,223,327,244,513,528,541,576,600,485,633,629,647**;Aug 13, 1993


mods made for magstripe read 12/96 - JFP

Optional input: DPTNOFZY='1' to suppress fuzzy lookups implemented
by patch DG*5.3*244

Difference between revisions of "Single Patient Record Back-up"

Revision as of 03:24, 4 November 2009

Contents

==================================================

===============================

===============================

===============================

===============================

===============================

============================================================

====

============================================================

Navigation menu

Views

Personal tools

Navigation

Search

Tools

@@ Line 1: / Line 1: @@
-A method to obtain single patient record from VistA - Thanks to [http://mail.google.com/mail/#label/hardhats-HMS/123bfb854f948072/ Alan] for the solution.
+FINISHED PROGRAM FOR RETRIEVING ONE PATIENT DATA METHOD #1:
---------------------------------------------------------------------------------
-Here is the full documentation of the very basic starter program for
-selecting one patient's file and printing their name and ssn.
-About five VistA routines are included for reference.
-<pre>
-===================================================
+==============================================================
 USER>D ^%CD
@@ Line 32: / Line 22: @@
 VISTA>
-VISTA>D ^NAM3SSN
+VISTA>D ^NAM5SSN
+===========================================
+VISTA SELECT PATIENT PROCEDURE:
+===========================================
 Select PATIENT NAME: ONE
    ONE,IMAGEPATIENT        4-15-53    666061001     NO     NSC
 VETERAN
    ONE,INPATIENT        3-9-45    666000801     NO     NSC VETERAN
    ONE,OUTPATIENT        3-9-45    666000601     NO     NSC
 VETERAN
    ONE,PATIENT        4-7-35    666000001     YES     SC VETERAN
    ONEHUNDRED,INPATIENT        3-9-45    666000900     NO     NSC
 VETERAN
@@ Line 54: / Line 48: @@
   Enrollment Priority: GROUP 3    Category: IN PROCESS    End Date:
+===========================================
+NAME5SSN SELECTED PATIENT DATA:
+===========================================
+Name: ONE,PATIENT SSN: 666000001
+SEX: M DOB: 03/12/8276 ADDRESS: 1312 Ashton Place
+CITY: Rowling STATE: WEST VIRGINIA ZIP: 99998
+PHONE: 222-555-8235
-Name: ONE,PATIENT   SSN: 666000001
+===========================================
 VISTA>
+========================================================================
+OUTPUT.TXT:
+================
+Name^ONE,PATIENT^SSN^666000001^SEX^M^DOB^03/12/8276^ADDRESS^1312
+Ashton Place^CITY^Rowling^STATE^WEST
+VIRGINIA^ZIP^99998PHONE^222-555-8235^
+========================================================================
-NAM3SSN ; Lab 9; TEST VISTA SELECT PATIENT NAME: W NAME & SSN; AHR;
+ NAM5SSN ; Lab 9 M1; VISTA SELECT PATIENT NAME: W NAME & SSN; AHR;
-/14/2009
+/28/2009
-       ;
+;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ; FROM:
+;
-       ; DGPHIST ;WASH/ERC - PURPLE HEART REQUEST HISTORY ;23 AUG 00 ;
+; Setting up a VistA environment
-       ; 5.3;Registration;**343**,Aug 13, 1993
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
-       ;
+;USER>D ^%CD
-EN ;Entry point
+;
-       ;
+; Namespace: VISTA
-       N DGDFN,DGPAT,DGNAM,DGSSN
+; You're in namespace VISTA
-       I DTIME="" S DTIME=30 ; added 1 line; TIMEOUT 4 READ set if ^XUP not
+; Default directory is c:\cachesys\mgr\vista\
-run
-       S DGDFN=$$GETDFN()
-       Q:DGDFN'>0
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;Searching for GETDFN() in *.*
-       ;
-       ; ALL THREE EXAMPLES OF GETDFN() ARE INCLUDED FOR REFERENCE
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;DGPHIST.int(9): S DGDFN=$$GETDFN()
-       ;DGPHIST.int(22): GETDFN() ;Ask the user to select patient
-       ;EASECPC.int(36): GETDFN() ; Get the veteran's DFN
-       ;NAM3SSN.int(11): S DGDFN=$$GETDFN()
-       ;NAM3SSN.int(30): ; THIS NEXT GETDFN() NOT IN USE INCLUDED FOR
-REFERENCE
-       ;NAM3SSN.int(36): ;GETDFN() ;Ask the user to select patient
-       ;NAM3SSN.int(54): GETDFN() ;Get pointer to PATIENT file (#2)
-       ;NAM3SSN.mac(11): S DGDFN=$$GETDFN()
-       ;NAM3SSN.mac(30): ; THIS NEXT GETDFN() NOT IN USE INCLUDED FOR
-REFERENCE
-       ;NAM3SSN.mac(36): ;GETDFN() ;Ask the user to select patient
-       ;NAM3SSN.mac(54): GETDFN() ;Get pointer to PATIENT file (#2)
-       ;VAFCMS01.int(10): S DFN=$$GETDFN()
-       ;VAFCMS01.int(18): GETDFN() ;Get pointer to PATIENT file (#2)
-       ;VAFCMS01.int(225): S DFN=$$GETDFN()
-       ;Found 14 occurrence/s in 5 file/s.
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ; --->>> taking out the $$GETPAT(DGDFN) code because it is not
-simple.
-       ;
-       ;S DGPAT=$$GETPAT(DGDFN)
-       ;Q:$P(DGPAT,U)=""
-       ;S DGNAM=$P(DGPAT,U),DGSSN=$P(DGPAT,U,2)
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
-       S DGNAM=$$NAME(DGDFN)
-       ;
-       S DGSSN=$$SSN(DGDFN)
-       ;
-       W !!,"Name: ",DGNAM," ","SSN: ",DGSSN,! ; Only line I have written
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
-       ; THIS CODE IS BEING USED
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ; FROM:
-       ; DGPHIST ;WASH/ERC - PURPLE HEART REQUEST HISTORY
-       ;23 AUG 00 ;;5.3;Registration;**343**,Aug 13, 1993
-       ;
-       ; this code commented out for reference to the entry point above.
-GETDFN() ;Ask the user to select patient
-       ;
-       ; Input: none
-       ;
-       ; Output: DFN
-       ;
-       N DIC,X,Y
-       S DIC="^DPT(",DIC(0)="AEMQ"
-       D ^DIC
-       Q $S(+Y>0:+Y,1:0)
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ; FROM:
-       ; VAFCMS01 ;BP-CIOFO/JRP - ADMISSION RETRANSMISSION;8/3/1998 ;
-       ; 5.3;Registration;**209**;Aug 13, 1993
-       ;
-       ; THIS NEXT GETDFN() NOT IN USE INCLUDED FOR REFERENCE
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
-       ; GETDFN() ;Get pointer to PATIENT file (#2)
-       ; Input : None
-       ;Output : DFN - Pointer to PATIENT file (#2)
-       ; -1 - No entry selected
-       ;
-       ; N DIC,X,Y,DTOUT,DUOUT
-       ; S DIC="^DPT("
-       ; S DIC(0)="AEMNQZ"
-       ; D ^DIC
-       ; Q +Y
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
-       ;EASECPC ;ALB/PHH,CKN,LBD,AMA,SCK - LTC Copayment Report; 29-AUG-2001
-       ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,19,24,34,40,79**;Mar 15,
-;Build 3
-       ;
-       ; This routine prints a report of calculated LTC copayments for a
-veteran.
-       ; It is called by menu option EASEC LTC COPAY PRINT
-       ;
-       ; EN N DFN,EASRPT,EASADM,EASRDT,MAXRT,DGMTI,DGMTDT
-       ; Select which report to print (1=Institutional (IP); 2=Non-
-Institutional (OP))
-       ; S EASRPT=$$RPT Q:'EASRPT
-       ; Select Patient
-       ; S DFN=$$GETDFN Q:'DFN
-       ; S EASADM=""
-       ; Get the LTC admission date (if EASRPT=1)
-       ; I EASRPT=1 S EASADM=$$ADMDT Q:'EASADM
-       ; E S EASADM="" ;EAS*1.0*79
-       ; Get start date for report
-       ; S EASRDT=$$RPTDT Q:'EASRDT
-       ;EAS*1.0*79 - moved from 4 lines up, and added EASADM as a parameter
-       ;Set EASADM to the report date for Non-Institutional (OP) reports
-       ; I EASRPT=2 S EASADM=EASRDT
-       ; Get most recent LTC Copay Test for patient and set up LTC variables
-       ; I '$$GETLTC(DFN,EASADM) Q
-       ; Run the report
-       ; D QUE
-       ; Q
-       ; RPT() ; Select which report to print
-       ; Input: None
-       ; Output: Y - Report Type (1=Institutional (IP); 2=Non-Institutional
-(OP); 0=Quit)
-       ; N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
-       ; W !!,"Report of Calculated Long Term Care Copayments"
-       ; W !,"=============================================="
-       ; S DIR(0)="S^1:Institutional (Inpatient);2:Non-Institutional
-(Outpatient)"
-       ; S DIR("A")="Enter 1 or 2"
-       ; D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
-       ; Q Y
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ; GETDFN() ; Get the veteran's DFN
-       ; N DIC,DTOUT,DUOUT,X,Y
-       ; W !
-       ; S DIC="^DPT(",DIC(0)="AEMZQ",DIC("S")="I $D(^DGMT(408.31,""AID"",
-,+Y))"
-       ; D ^DIC
-       ; Q:$D(DTOUT)!($D(DUOUT)) 0
-       ; Q:Y<0 0
-       ; Q +Y
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
-       ; MORE ROUTINE ....
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
-       ; FROM:
-       ; DGENPTA ;ALB/CJM - Patient API - Retrieve Data; 13 JUN 1997
-       ;;5.3;Registration;**121,122,147**;08/13/93
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
-SSN(DFN) ;
-       ;Description: Function returns the patient's SSN, or "" on failure.
-       ;
-       Q:'DFN ""
-       Q $P($G(^DPT(DFN,0)),"^",9)
-       ;
-NAME(DFN) ;
-       ;Description: Function returns the patient's NAME, or "" on failure.
-       ;
-       Q:'DFN ""
-       Q $P($G(^DPT(DFN,0)),"^")
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
-       QUIT ; END NAM2SSN
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       QUIT ; MAKE SURE ENDING HERE
-       ;
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
-       ;GETPAT(DFN) ;
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;Searching for GETPAT(DFN) in *.*
-       ;
-       ;DGPHIST.int(33): GETPAT(DFN) ; get patient name and ssn
-       ;NAM3SSN.int(89): ;GETPAT(DFN) ;
-       ;NAM3SSN.int(106): ; EXTERNAL PROCEDURE USED BY GETPAT(DFN) INCLUDED
-FOR REFERENCE
-       ;NAM3SSN.mac(89): ;GETPAT(DFN) ;
-       ;NAM3SSN.mac(106): ; EXTERNAL PROCEDURE USED BY GETPAT(DFN) INCLUDED
-FOR REFERENCE
-       ;PSOTPCLP.int(130): D GETPAT(DFN)
-       ;PSOTPCLP.int(148): GETPAT(DFN) ;GET PATIENT DATA
-       ;Found 7 occurrence/s in 4 file/s.
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
-       ; Input: DFN - patient IEN
-       ;
-       ; Output:
-       ; Function value: patient name^SSN
-       ;
-       ;N VADM,DGNAM,DGSSN
-       ;S (DGNAM,DGSSN)=""
-       ;I $G(DFN)>0 D
-       ;. D ^VADPT ; CALLS THIS EXTERNAL PROCEDURE
-       ;. S DGNAM=VADM(1)
-       ;. S DGSSN=$P(VADM(2),U,2)
-       ;Q DGNAM_"^"_DGSSN
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
-       ; EXTERNAL PROCEDURE USED BY GETPAT(DFN) INCLUDED FOR REFERENCE
-       ;
-       ;VADPT ;ALB/MRL/MJK - RETURN PATIENT VARIABLE ARRAYS [DRIVER];07 DEC
-       ;;5.3;Registration;**193,343,389,415,489,498**;Aug 13, 1993
-       ;DFN = Patient IFN [if not passed entire array returned as null]
-       ;
-       ;DEM ;Demographic Variables
-       ;S VAN=1,VAN(1)=12,VAV="VADM" D ^VADPT0 Q
-       ;
-       ;OPD ;Other Patient Data
-       ;S VAN=2,VAN(1)=7,VAV="VAPD" D ^VADPT0 Q
-       ;
-       ;ADD ;Current Address
-       ;S VAN=3,VAN(1)=22,VAV="VAPA" D ^VADPT0 Q
-       ;
-       ;OAD ;Other Patient Variables
-       ;S VAN=4,VAN(1)=11,VAV="VAOA" D ^VADPT0 Q
-       ;
-       ;INP ;Inpatient Data [pre-version 5]
-       ;N VAINDTT S VAN=5,VAN(1)=11,VAV="VAIN",VAINDTT=$G(VAINDT) N VAINDT
-S:VAINDTT VAINDT=$$DATIM(VAINDTT) D ^VADPT0 Q
-       ;
-       ;IN5 ;Inpatient Data [v5.0 and above]
-       ;N VAINDTT S VAN=6,VAN(1)=19,VAV=$S('$D(VAIP("V")):"VAIP",VAIP("V")'?
-A.E:"VAIP",1:VAIP("V")),VAINDTT=$G(VAIP("D")) S:$L(VAINDTT) VAIP("D")
-=VAINDTT S:VAINDTT VAIP("D")=$$DATIM(VAINDTT) D ^VADPT0 S:$L(VAINDTT)
-VAIP("D")=VAINDTT Q
-       ;
-       ;ELIG ;Eligibility Information
-       ;S VAN=7,VAN(1)=9,VAV="VAEL" D ^VADPT0 Q
-       ;
-       ;MB ;Monetary Benefits
-       ;S VAN=8,VAN(1)=9,VAV="VAMB" D ^VADPT0 Q
-       ;
-       ;SVC ;Service Information
-       ;S VAN=9,VAN(1)=9,VAV="VASV" D ^VADPT0 Q
-       ;
-       ;REG ;Registration data
-       ;S VAN=10,VAV="VARP" D ^VADPT0 Q
-       ;
-       ;SDE ;Enrollment Information
-       ;S VAN=11,VAV="VAEN" D ^VADPT0 Q
-       ;
-       ;SDA ;Appointment Information
-       ;S VAN=12,VAV="VASD" D ^VADPT0 Q
-       ;
-       ;PID ;Patient Id
-       ;S VAN=13,VAV="VA" D ^VADPT0 Q
-       ;
-       ;TESTPAT(DFN) ;Test patient ? Returns 0 (No) or 1 (Yes)
-       ;S DFN=+$G(DFN) I 'DFN Q 0
-       ;I $D(^DPT("ATEST",DFN)) Q 1
-       ;N NODE S NODE=$G(^DPT(DFN,0))
-       ;I $P(NODE,"^",21)=1 Q 1
-       ;I $E($P(NODE,"^",9),1,5)="00000" Q 1
-       ;Q 0
-       ;
-       ;V5 S X=$S($D(^DG(43,1,"VERSION")):+^("VERSION"),1:""),VADPT("V")=$S
-(X<5:0,1:1) K X Q
-       ;OERR ;
-       ;1 S VATAG=1 D MULT Q
-       ;2 S VATAG=2 D MULT Q
-       ;3 S VATAG=3 D MULT Q
-       ;4 S VATAG=4 D MULT Q
-       ;5 S VATAG=5 D MULT Q
-       ;6 S VATAG=6 D MULT Q
-       ;7 S VATAG=7 D MULT Q
-       ;8 S VATAG=8 D MULT Q
-       ;9 S VATAG=9 D MULT Q
-       ;10 S VATAG=10 D MULT Q
-       ;51 S VATAG=11 D MULT Q
-       ;52 S VATAG=12 D MULT Q
-       ;53 S VATAG=13 D MULT Q
-       ;ALL S VATAG=14 D MULT Q
-       ;A5 S VATAG=15 D MULT Q
-       ;SEL Q:$O(VARRAY(0))']"" S VATAG=0,VATAG(2)=$P($T(TAG),";;",2)
-       ;F VATAG(1)=0:0 S VATAG=$O(VARRAY(VATAG)) Q:VATAG="" I VATAG(2)
-[("^"_VATAG_"^") S VARRAY(VATAG)=1,VAROOT=$S($D(VAROOT(VATAG)):VAROOT
-(VATAG),1:"") D @VATAG
-       ;G Q
-       ;
-       ;MULT S VATAG=$P($T(TG+VATAG),";;",2)
-       ;F VATAG(1)=1:1 S VATAG(2)=$P(VATAG,"^",VATAG(1)) Q:VATAG(2)="" S
-VAROOT=$S($D(VAROOT(VATAG(2))):VAROOT(VATAG(2)),1:"") D @(VATAG(2))
-       ;Q S VAROOT="" K:$D(VAROOT)'=11 VAROOT K VATAG Q
-       ;
-       ;KVA K VA
-       ;KVAR D KVAR^VADPT0 K:$D(VAIP("V")) @(VAIP("V")) K
-I,X,Y,VARRAY,VADM,VAPD,VADPT,VAOA,VASV,VAEL,VAMB,VARP,VAEN,VASD,VAIN,VAIP,VAPA,VAHOW,VAINDT,VAERR,^UTILITY
-("VADPT",$J),VA200,VATEST Q
-       ;DATIM(DATIM) ;If time not specified see if movement on that date
-       ;Q:DATIM'?7N DATIM
-       ;N A,B S A=$O(^DGPM("ADFN"_DFN,DATIM)),B=+$O(^(+A,0))
-       ;I 'A Q DATIM
-       ;I $P($G(^DGPM(+B,0)),"^",2)=3 Q DATIM ;Next movement is discharge
-       ;F Q:"^4^5^7^"'[(U_$P($G(^DGPM(+B,0)),"^",2)) S A=$O(^DGPM
-("ADFN"_DFN,A)),B=+$O(^(+A,0)) I $E(A,1,7)'=DATIM Q
-       ;I 'A Q DATIM
-       ;I $E(A,1,7)'=DATIM Q DATIM
-       ;Q A
-       ;
-       ;TG ;
-       ;;DEM^INP
-       ;;DEM^ELIG
-       ;;ELIG^INP
-       ;;DEM^ADD
-       ;;ADD^INP
-       ;;DEM^ELIG^ADD
-       ;;ELIG^SVC
-       ;;ELIG^SVC^MB
-       ;;DEM^REG^SDE^SDA
-       ;;SDE^SDA
-       ;;DEM^IN5
-       ;;ELIG^IN5
-       ;;ADD^IN5
-       ;;DEM^OPD^INP^ADD^ELIG^SVC^OAD^MB^REG^SDE^SDA
-       ;;DEM^OPD^IN5^ADD^ELIG^SVC^OAD^MB^REG^SDE^SDA
-       ;
-       ;TAG ;;^DEM^OPD^INP^IN5^ADD^OAD^ELIG^SVC^MB^REG^SDE^SDA^
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
-       ; VERY IMPORTANT EXAMPLE OF PATIENT LOOKUP MAIN ROUTINE
-       ;
-       ; DPTLK ;ALB/RMO,RTK - MAS Patient Look-up Main Routine ; 3/22/05
-:19pm
-       ;;
-.3;Registration;**32,72,93,73,136,157,197,232,265,277,223,327,244,513,528,541,576,600,485,633,629,647**;Aug
-, 1993
-       ;
-        ; mods made for magstripe read 12/96 - JFP
-       ;
-       ;Optional input: DPTNOFZY='1' to suppress fuzzy lookups implemented
-       ; by patch DG*5.3*244
-       ;
-       ;
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-DPTLK ;ALB/RMO,RTK - MAS Patient Look-up Main Routine ; 3/22/05 4:19pm
-;;
-.3;Registration;**32,72,93,73,136,157,197,232,265,277,223,327,244,513,528,541,576,600,485,633,629,647**;Aug
-, 1993
 ;
-; mods made for magstripe read 12/96 - JFP
+; VISTA>S DUZ=10000000020
 ;
-;Optional input: DPTNOFZY='1' to suppress fuzzy lookups implemented
+; VISTA>D ^XUP
-; by patch DG*5.3*244
+; Setting up programmer environment
+; This is a TEST account.
 ;
-EN ; -- Entry point
+; Terminal Type set to: C-VT320
-N DIE,DR
-K DPTX,DPTDFN,DPTSAVX I $D(DIC(0)) G QK:DIC(0)["I"!(DIC(0)'["A"&('$D
-(X)))
-I '$D(^DD("VERSION")) W !!?3,"Unable to proceed. Fileman version node
-^DD(""VERSION"") is undefined." G QK
-I '$D(^DPT(0))!(^DD("VERSION")<17.2) W !!?3,"Unable to proceed. ",$S
-('$D(^DPT(0)):"0th node of ^DPT missing",^DD("VERSION")<17.2:"Fileman
-version must be at least 17.2",1:""),"." G QK
-EN2 K DO,DUOUT,DTOUT S U="^",DIC="^DPT(",DIC(0)=$S($D(DIC(0)):DIC(0),
-:"AELMQ") S:DIC(0)'["A" (DPTX,DPTSAVX)=X
-S DPTSZ=1000 I $D(^DD("OS"))#2 S DPTSZ=$S(+$P(^DD("OS",^("OS"),0),U,2):
-$P(^(0),U,2),1:DPTSZ)
 ;
-ASKPAT ; -- Prompt for patient
+; Select OPTION NAME:
-I DIC(0)["A" D G QK:'$T!($E(DPTX)["^")!(DPTX="")
+; VISTA>
-.K DTOUT,DUOUT
-.W !,$S($D(DIC("A")):DIC("A"),1:"Select PATIENT NAME: ") W:$D(DIC
-("B")) DIC("B"),"// "
-.R X:DTIME
-.S DPTX=X S:'$T DTOUT=1 S:$T&(DPTX="")&($D(DIC("B"))) DPTX=DIC("B")
-S:DPTX["^"&($E(DPTX)'="%") DUOUT=1
-; -- Check for the IATA magnetic stripe input
-N MAG,GCHK
-S MAG=0
-I $E(DPTX)="%"!($E(DPTX)=";"),DPTX["?" S MAG=1,(X,DPTX)=$$IATA(DPTX)
 ;
-CHKPAT ; -- Custom Patient Lookup
+; VISTA>D ^NAM5SSN
-D DO^DIC1
-S DIC("W")=$S($D(DIC("W")):DIC("W"),1:"")
-K DPTIFNS,DPTS,DPTSEL
-S DPTCNT=0
-; -- Check input for format an length
-G CHKDFN:DPTX?1A!(DPTX'?.ANP)!($L(DPTX)>30)
-; -- Check for null response or abort
-I DPTX=""!(DPTX["^") G ASKPAT:DIC(0)["A",QK
-; -- Check for question mark
-I DPTX["?" D G ASKPAT:DIC(0)["A",QK
-.S D="B"
-.S DZ=$S(DPTX?1"?":"",1:"??")
-.G CHKPAT1:DZ="??"
-.N %
-.W !,?1,"Answer with PATIENT NAME, or SOCIAL SECURITY NUMBER, or last
-digits",!,?4,"of SOCIAL SECURITY NUMBER, or first initial of"
-.W " last name with last",!,?4,"4 digits of SOCIAL SECURITY NUMBER"
-.W !,?1,"Do you want the entire ",+$P($G(^DPT(0)),"^",4),"-Entry
-PATIENT List" S %=0 D YN^DICN
-.Q:%'=1
-.S DZ="??"
-CHKPAT1 .S X=DPTX
-.D DQ^DICQ
-; -- Check for space bar, return
-I DPTX=" " D G CHKDFN
-.S Y=$S('($D(DUZ)#2):-1,$D(^DISV(DUZ,"^DPT(")):^("^DPT("),1:-1)
-.D SETDPT^DPTLK1:Y>0
-.S DPTDFN=$S($D(DPTS(Y)):Y,1:-1)
-; -- Check for DFN look up
-I $E(DPTX)="`" D G CHKDFN
-.S Y=$S($D(^DPT(+$P(DPTX,"`",2),0)):+$P(DPTX,"`",2),1:-1)
-.D SETDPT^DPTLK1:Y>0
-.S DPTDFN=$S($D(DPTS(Y)):Y,1:-1)
-; -- Puts input in correct format
-G CHKDFN:DPTX=""
-; -- Force new entry
-I $E(DPTX)="""",$E(DPTX,$L(DPTX))="""" G NOPAT
-; -- Check for index lookups
-D ^DPTLK1 G QK:$D(DTOUT)!($D(DUOUT)&(DIC(0)'["A")),ASKPAT:$D
-(DUOUT),CHKPAT:DPTDFN<0,CHKDFN:DPTDFN>0 I DIC(0)["N",$D(^DPT(DPTX,0))
-S Y=X D SETDPT^DPTLK1 S DPTDFN=$S($D(DPTS(Y)):Y,1:-1) G CHKDFN
-MAG ; -- No patient found, check for mag stripe input, create stub
-I 'MAG G NOPAT
-; -- Check for ADT option(s) only
-N DGOPT
-S DGOPT=$P($G(XQY0),"^",2)
-I DGOPT'="Load/Edit Patient Data",DGOPT'="Register a Patient" D G EN2
-.W !," ...Patient not in database, use ADT options to load patient" D
-Q1
-; -- Prompt for creation of stub
-S DIR(0)="Y",DIR("B")="NO",DIR("A")="Patient not found...Create stub
-entry: "
-S GCHK=$D(^TMP("DGVIC"))
-D ^DIR
-K DIR
-I 'Y D Q1 G EN2
-; -- Parse IATA fields
-D FIELDS(IATA)
-; -- Check for Duplicates
-D EP2^DPTLK3
-I DPTDFN<0 D Q1 G EN2
-; -- Creates Stub entry in patient file
-S Y=$$FILE^DPTLK4(DGFLDS)
-I $P(Y,"^",3)'=1 W !,"Could not add patient to patient file" D QK1 Q
-D QK1
-Q
 ;
-NOPAT ; -- No patient found, ask to add new
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-I DIC(0)["L" D ^DPTLK2 S Y=DPTDFN G ASKPAT:DIC(0)["A"&(Y<0)&('$G
-(DTOUT)),QK1
 ;
-CHKDFN ; --
+; Assuming you want field #9 from File #2, the name of the field is
-S:'$D(DPTDFN) DPTDFN=-1 I DPTDFN'>0!('$D(DPTS(+DPTDFN))) W:DIC(0)["Q"
+retrieved
-*7," ??" G ASKPAT:DIC(0)["A",QK
+; with the MUMPS expression
-I DIC(0)["E" D W $S('$D(DPTSEL)&('$D(DIVP)):$P(DPTS(DPTDFN),U,2)_" "_$P
+; WRITE $PIECE(^DD(2,9,0),"^",1),!
-(DPTS(DPTDFN),U)_" ",$D(^DPT(DPTDFN,0)):" "_$P(^(0),U)_" ",1:"") S
-Y=DPTDFN X:$D(^DPT(DPTDFN,0)) "N DDS X DIC(""W"")"
-.I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY
 ;
-; check for other patients in "BS5" xref on Patient file
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-I '$G(DICR),DPTDFN>0,DIC(0)["E",$$BS5^DPTLK5(+DPTDFN) D G ASKPAT:DIC(0)
-["A"&(%'=1),QK:DPTDFN<0
-.N DPTZERO,DPTLSNME,DPTSSN S DPTZERO=$G(^DPT(+DPTDFN,0)),DPTLSNME=$P($P
-(DPTZERO,U),","),DPTSSN=$E($P(DPTZERO,U,9),6,9)
-.W $C(7),!!,"There is more than one patient whose last name is
-'",DPTLSNME,"' and"
-.W !,"whose social security number ends with '",DPTSSN,"'."
-.W !,"Are you sure you wish to continue (Y/N)" S %=0 D YN^DICN
-.I %'=1 S DPTDFN=-1
 ;
-I '$G(DICR),DPTDFN>0 S Y=DPTDFN D ^DGSEC S DPTDFN=Y G ASKPAT:DIC(0)
+; observe the difference between
-["A"&(DPTDFN<0),QK:DPTDFN<0
+; field number and global subscript location:
-S DPTX=DPTX_$P(DPTS(DPTDFN),U,2),DPTDFN=DPTDFN_U_$P(^DPT(DPTDFN,0),U)
 ;
-Q ; --
+; Select DATA DICTIONARY UTILITY OPTION: LIST FILE ATTRIBUTES
-S Y=$S('$D(DPTDFN):-1,'$D(DPTS(+DPTDFN)):-1,1:DPTDFN),X=$S($D(DPTX)&
+; START WITH WHAT FILE: PATIENT//
-(+Y>0):DPTX,$D(DPTSAVX):DPTSAVX,$D(DPTX):DPTX,1:"")
+; GO TO WHAT FILE: PATIENT//
-I Y>0 S:DIC(0)'["F" ^DISV($S($D(DUZ)#2:DUZ,1:0),"^DPT(")=+Y S:DIC(0)
+; Select SUB-FILE:
-["Z" Y(0)=^DPT(+Y,0),Y(0,0)=$P(^(0),U,1)
+; Select LISTING FORMAT: STANDARD// CUSTOM-TAILORED
-;DG*600
+; SORT BY: LABEL// NUMBER
-;I DIC(0)["E",$P($G(^DPT(+Y,0)),U,21) W *7,!,"Warning : You have
+; START WITH NUMBER: FIRST//
-selected a test patient."
+; WITHIN NUMBER, SORT BY:
-I DIC(0)["E",$$TESTPAT^VADPT(+Y) W *7,!,"WARNING : You may have
+; FIRST PRINT ATTRIBUTE: LABEL
-selected a test patient."
+; THEN PRINT ATTRIBUTE: NUMBER
-I DIC(0)["E",$$BADADR^DGUTL3(+Y) W *7,!,"WARNING : ** This patient has
+; THEN PRINT ATTRIBUTE: GLOBAL SUBSCRIPT LOCATION
-been flagged with a Bad Address Indicator."
+; THEN PRINT ATTRIBUTE:
-I DIC(0)["E",$$VAADV^DPTLK3(+Y) W *7,!,"** Patient is VA ADVANTAGE."
+; Heading (S/C): FIELD SEARCH//
-;DG*485
+; DEVICE: 0;80;999 TELNET
-I $D(^DPT("AXFFP",1,+Y)) D FFP^DPTLK5
+; PATIENT FILE FIELD SEARCH SEP 24,2009 22:01 PAGE 1
-;Display enrollment information
+; LABEL NUMBER GLOBAL
-I Y>0,DIC(0)["E" D ENR
+; SUBSCRIPT LOCATION
 ;
-;Call Combat Vet check
+; Below is the section on address. Note:
-I Y>0,DIC(0)["E" D CV
+; Field Label, Number, and Global Subscript Location
 ;
-; check whether to display Means Test Required message
-D
-.N DPTDIV
-.I '$G(DUZ(2)) Q
-.I Y>0,DIC(0)["E" S DPTDIV=$$DMT^DPTLK5(+Y,DUZ(2)) I DPTDIV D
-..W $C(7),!!,"MEANS TEST REQUIRED"
-..W !,?3,$P($G(^DG(40.8,DPTDIV,"MT")),U,2)
-..H 2
 ;
-Q1 ; -- Clean up variables
+--------------------------------------------------------------------------------
-K D,DIC("W"),DO,DPTCNT,DPTDFN,DPTIFNS,DPTIX,DPTS
-K DPTSAVX,DPTSEL,DPTSZ,DPTX
 ;
-K:$D(IATA) IATA
+; NAME .01 0;1
-K:$D(DGFLDS) @DGFLDS,DGFLDS
+; SEX .02 0;2
-Q
+; DATE OF BIRTH .03 0;3
+; AGE .033 ;
+; MARITAL STATUS .05 0;5
+; RACE .06 0;6
+; OCCUPATION .07 0;7
+; RELIGIOUS PREFERENCE .08 0;8
+; DUPLICATE STATUS .081 0;18
+; PATIENT MERGED TO .082 0;19
+; CHECK FOR DUPLICATE .083 0;20
+; SOCIAL SECURITY NUMBER .09 0;9
 ;
-QK K:'$D(DPTNOFZK) DPTNOFZY G Q
 ;
-QK1 K:'$D(DPTNOFZK) DPTNOFZY G Q1
+; STREET ADDRESS [LINE 1] .111 .11;1
+; ZIP+4 .1112 .11;12
+; STREET ADDRESS [LINE 2] .112 .11;2
+; STREET ADDRESS [LINE 3] .113 .11;3
+; CITY .114 .11;4
+; STATE .115 .11;5
+; ZIP CODE .116 .11;6
+; COUNTY .117 .11;7
+; ADDRESS CHANGE DT/TM .118 .11;13
+; ADDRESS CHANGE SOURCE .119 .11;14
 ;
-IX ; --
+; Thus the first line of the address is in piece 1 of subscript " .11"
-I $D(D),$D(^DD(2,0,"IX",D)),($E(D)'="A") S DPTIX=D
+; Like so: $P(^DPT(patientnum,.11),"^",1)
-G DPTLK
+; And CITY is in piece 4:
+; $P(^DPT(patnumber,.11),"^",4)
 ;
-IATA(X) ; --
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;This function pulls off ssn from the IATA track
 ;
-;Input: X - what was read in
+; Addressing this bit of MUMPS code:
-;Output: SSN - social security number
-; Q - quit
 ;
-; Track Start Sent End Sent Field Separator
+; S ZSTATE=$P(^DD(5,STATE,0),"^",1)
-; ----- ---------- -------- ---------------
-; IATA (alphanum) % ? { (Note: VA used ^)
-; ABA (numeric) ; ? =
 ;
-;N IATA
+; this says (in MUMPS-ish English)
-S (IATA)=""
-I $E(X)'="%" Q X ; no start sentinel
-I X'["?" Q "Q"
-; -- Extract data from track
-S IATA=$$TRACK(X,"%","?")
-; -- checks for no data
-I IATA="" Q "Q"
-; -- Returns SSN
-I IATA'="" Q $P(IATA,"^")
-Q "Q"
 ;
-TRACK(X,START,END) ; find track where start/end are sentinels
+; create a local variable for this process only named ZSTATE
+; with the value found by reading the local variable STATE
+; and using it as a FileMan Field Number.
+; Use this FileMan Field Number to find the FileMan Field Name
+; by looking it up in the Data Dictionary of the File #5.
+; (not stated, but known by me, File #5 is the VistA STATE File)
+; The Field Name is found by retrieving the "Zeroth" node of the
+; Data Dictionary, and then processing it by removing the first piece
+; of the string stored in that zeroth node value, which is itself a
+; string of characters, using a "^" (caret character) as a delimiter.
 ;
-Q $P($P($G(X),START,2),END,1)
+; This does NOT do what you have been saying you want to do.
 ;
-FIELDS(IATA) ; -- Sets fields
+; If you want to look up the name of a state using the index for that
-Q:'$D(IATA)
+; state (the internal entry number of that entry in the STATE File)
-N CNT,FIELD
+; you must look in the global used for the STATE File.
-S DGFLDS="^TMP(""DGVIC"","_$J_")",CNT=1
-K @DGFLDS
-F S FIELD=$P($G(IATA),"^",CNT) Q:FIELD="" D
-.S @DGFLDS@(CNT)=FIELD
-.S CNT=CNT+1
-; -- Define fields for duplicate checker
-S DPTX=$G(@DGFLDS@(2)) ;NAME
-S DPTIDS(.03)=$G(@DGFLDS@(3)) ;DOB
-S DPTIDS(.09)=$G(@DGFLDS@(1)) ;SSN
-Q
-ENR ;Display Enrollment information after patient selection
-N DGENCAT,DGENDFN,DGENR,DGEGTIEN,DGEGT
-I '$$GET^DGENA($$FINDCUR^DGENA(+DPTDFN),.DGENR) Q
-S DGENCAT=$$CATEGORY^DGENA4(+DPTDFN)
-S DGENCAT=$$EXTERNAL^DILFD(27.15,.02,"",DGENCAT)
-W !?1,"Enrollment Priority: ",$S($G(DGENR("PRIORITY")):$$EXT^DGENU
-("PRIORITY",DGENR("PRIORITY")),1:""),$S($G(DGENR("SUBGRP"))="":"",1:$
-$EXT^DGENU("SUBGRP",$G(DGENR("SUBGRP"))))
-W ?33,"Category: ",DGENCAT
-W ?57,"End Date: ",$S($G(DGENR("END")):$$FMTE^XLFDT(DGENR
-("END"),"5DZ"),1:""),!
-;If patient is NOT ELIGIBLE, display Enrollment Status (Ineligible
-Project Phase I)
-I $G(DGENR("STATUS"))=10!($G(DGENR("STATUS"))=19)!($G(DGENR("STATUS"))
-=20) D
-. W ?1,"Enrollment Status: ",$S($G(DGENR("STATUS")):$$EXT^DGENU
-("STATUS",DGENR("STATUS")),1:"") ;H 5
-;check for Combat Veteran Eligibility, if elig do not display EGT info
-I $$CVEDT^DGCV(+DPTDFN) Q
-;Get Enrollment Group Threshold Priority and Subgroup
-S DGEGTIEN=$$FINDCUR^DGENEGT
-S DGEGT=$$GET^DGENEGT(DGEGTIEN,.DGEGT)
-Q:$G(DGENR("PRIORITY"))=""!($G(DGEGT("PRIORITY"))="")
-;Compare Patient's Enrollment Priority to Enrollment Group Threshold
-I '$$ABOVE^DGENEGT1(+DPTDFN,DGENR("PRIORITY"),$G(DGENR("SUBGRP")),DGEGT
-("PRIORITY"),DGEGT("SUBGRP")) D
-.N X,IORVOFF,IORVON
-.S X="IORVOFF;IORVON"
-.D ENDR^%ZISS
-.W !?32 W:$D(IORVON) IORVON W "*** WARNING ***" W:$D(IORVOFF) IORVOFF
-.I DGENR("END")'="" W !?14 W:$D(IORVON) IORVON W "*** PATIENT
-ENROLLMENT END",$S(DT>+DGENR("END"):"ED",1:"S")," EFFECTIVE ",$
-$FMTE^XLFDT(DGENR("END"),"5DZ")," ***" W:$D(IORVOFF) IORVOFF Q
-.W !?5 W:$D(IORVON) IORVON W "*** PATIENT ENROLLMENT ENDING.
-ENROLLMENT END DATE IS NOT KNOWN. ***" W:$D(IORVOFF) IORVOFF
-Q
-CV ;check for Combat Vet status
-N DGCV
-S DGCV=$$CVEDT^DGCV(+DPTDFN)
-I $P(DGCV,U)=1 D Q
-. I '$$GET^DGENA($$FINDCUR^DGENA(+DPTDFN),.DGENR) W !
-. W ?3,"Combat Vet Status: "_$S($P(DGCV,U,3)=1:"ELIGIBLE",
-:"EXPIRED"),?57,"End Date: "_$$FMTE^XLFDT($P(DGCV,U,2),"5DZ")
-----------------------------------------------------------------------------
+; If you use the internal entry number of the state as if it were a
-</pre>
+field
+; number, you will get the wrong information.
-Here is the short version of my basic program with little
+; If you want to get the value of a particular state, you must find
-documentation.
+out the
-I will be using this version to use method 1 to solve this problem,
+; global root for the STATE File. I happen to know that the global
-by adding field numbers manually and manually writing them to the
+root
-screen or a text file. The other version later.
+; for the STATE File is "^DIC(5," I know this because I use the
-<pre>
+FileMan
-=========================================================
+; inquire option to find it.
+;
-USER>D ^%CD
+; Select OPTION: INQUIRE TO FILE ENTRIES
+;
-Namespace: VISTA
+; OUTPUT FROM WHAT FILE: STATE// FILE
-You're in namespace VISTA
+; Select FILE: STATE
-Default directory is c:\cachesys\mgr\vista\
+; ANOTHER ONE:
-VISTA>
+; STANDARD CAPTIONED OUTPUT? Yes// (Yes)
+; Include COMPUTED fields: (N/Y/R/B): NO// BOTH Computed Fields and
-VISTA>S DUZ=10000000020
+Record Number
+; (IEN)
-VISTA>D ^XUP
+;
+; NUMBER: 5 NAME: STATE
-Setting up programmer environment
+; APPLICATION GROUP: VA
-This is a TEST account.
+; DESCRIPTION: This file contains the name of the state (or outlying
+area) as
-Terminal Type set to: C-VT320
+; issued by the Department of Veterans Affairs and issued in M-1, Part
+I,
-Select OPTION NAME:
+; Appendix B. These entries should remain as distributed and should
-VISTA>
+not be
+; edited or updated unless done via a software upgrade or under
-VISTA>D ^NAM3SSN
+direction of VA
+; Central Office.
-Select PATIENT NAME: ONE
+; GLOBAL NAME (c): ^DIC(5, ENTRIES (c): 82
-   ONE,IMAGEPATIENT        4-15-53    666061001     NO     NSC
+; DD ACCESS (c): # WR ACCESS (c): #
-VETERAN
+; DEL ACCESS (c): # LAYGO ACCESS (c): #
+; VERSION (c): 5.3 COMPILED CROSS-REFERENCES (c): NO
-   ONE,INPATIENT        3-9-45    666000801     NO     NSC VETERAN
+;
+; After I find out the global root for the STATE File, I have to get
-   ONE,OUTPATIENT        3-9-45    666000601     NO     NSC
+the
-VETERAN
+; value for the NAME
+; of the STATE. I happen to know this is in the Zeroth node and the
-   ONE,PATIENT        4-7-35    666000001     YES     SC VETERAN
+; first piece using
+; "^" as a delimiter.
-   ONEHUNDRED,INPATIENT        3-9-45    666000900     NO     NSC
+;
-VETERAN
+; So the code should be
+;
-ENTER '^' TO STOP, OR
+; SET ZSTATE=$P(^DIC(5,STATE,0),"^",1)
-CHOOSE 1-5: 4  ONE,PATIENT        4-7-35    666000001     YES     SC
+;
-VETERAN
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
- Enrollment Priority: GROUP 3    Category: IN PROCESS    End Date:
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; FROM:
+; DGPHIST ;WASH/ERC - PURPLE HEART REQUEST HISTORY ;23 AUG 00 ;
-Name: ONE,PATIENT   SSN: 666000001
+; 5.3;Registration;**343**,Aug 13, 1993
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-VISTA>
+;
-NAM5SSN ; Lab 9; TEST VISTA SELECT PATIENT NAME: W NAME & SSN; AHR;
-/20/2009
-       ;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ; FROM:
-       ; DGPHIST ;WASH/ERC - PURPLE HEART REQUEST HISTORY ;23 AUG 00 ;
-       ; 5.3;Registration;**343**,Aug 13, 1993
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
 EN ;Entry point
-       N DGDFN,DGPAT,DGNAM,DGSSN
+N DGDFN,DGPAT,DGNAM,DGSSN
+N SEX,DOB,ADDRESS,CITY,STATE,ZIP,PHONE
-       I DTIME="" S DTIME=30 ; added 1 line; TIMEOUT 4 READ set if ^XUP not
+;
+;I DTIME="" S DTIME=30 ; added 1 line; TIMEOUT 4 READ set if ^XUP not
 run
+S DTIME=9999
-       S DGDFN=$$GETDFN()
+;
-       Q:DGDFN'>0
+W !,"==========================================="
-       ;
+W !,"VISTA SELECT PATIENT PROCEDURE: ",!
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+W "===========================================",!
-- Show quoted text -
+;
-       ; --->>> taking out the $$GETPAT(DGDFN) code because it is not
+S DGDFN=$$GETDFN()
-simple.
+Q:DGDFN'>0
-       ;
+;
-       ;S DGPAT=$$GETPAT(DGDFN)
+S DGNAM=$$NAME(DGDFN)
-       ;Q:$P(DGPAT,U)=""
+;
-       ;S DGNAM=$P(DGPAT,U),DGSSN=$P(DGPAT,U,2)
+S DGSSN=$$SSN(DGDFN)
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
-       ;
+S SEX=$P($G(^DPT(DGDFN,0)),"^",2)
-       S DGNAM=$$NAME(DGDFN)
+;
-       ;
+;
-       S DGSSN=$$SSN(DGDFN)
+S DOB=$P($G(^DPT(DGDFN,0)),"^",3)
-       ;
+S ZDOB=$ZDATETIME(DOB)
-       W !!,"Name: ",DGNAM," ","SSN: ",DGSSN,! ; Only line I have written
+;
-       ;
+S ADDRESS=$P(^DPT(DGDFN,.11),"^",1)
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
-       ;
+S CITY=$P(^DPT(DGDFN,.11),"^",4)
-       ; THIS CODE IS BEING USED
+;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+S STATE=$P(^DPT(DGDFN,.11),"^",5)
-       ; FROM:
+SET ZSTATE=$P(^DIC(5,STATE,0),"^",1)
-       ; DGPHIST ;WASH/ERC - PURPLE HEART REQUEST HISTORY
+;
-       ;23 AUG 00 ;;5.3;Registration;**343**,Aug 13, 1993
+S ZIP=$P(^DPT(DGDFN,.11),"^",6)
-       ;
+;
-       ; this code commented out for reference to the entry point above.
+S PHONE=$P(^DPT(DGDFN,.13),"^",1)
-GETDFN() ;Ask the user to select patient
+;
-       ;
+; cell .13;10
-       ; Input: none
+; S CELLPHONE=$P(^DPT(DGDFN,.13),"^",10)
-       ;
+; e-mail address .13;3
-       ; Output: DFN
+; S EMAIL=$P(^DPT(DGDFN,.13),"^",3)
-       ;
+;
-       N DIC,X,Y
+W !,"===========================================",!
-       S DIC="^DPT(",DIC(0)="AEMQ"
+W !,"NAME5SSN SELECTED PATIENT DATA: "
-       D ^DIC
+W !,"===========================================",!
-       Q $S(+Y>0:+Y,1:0)
+W !,"Name: ",DGNAM," SSN: ",DGSSN
-       ;
+W !,"SEX: ",SEX," DOB: ",ZDOB," ADDRESS: ",ADDRESS
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+W !,"CITY: ",CITY," STATE: ",ZSTATE," ZIP: ",ZIP
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+W !,"PHONE: ", PHONE,!
-       ; FROM:
+W !,"===========================================",!
-       ; VAFCMS01 ;BP-CIOFO/JRP - ADMISSION RETRANSMISSION;8/3/1998 ;
+;
-       ; 5.3;Registration;**209**;Aug 13, 1993
+;
-       ;
+; To write to an external file name:
-       ; THIS NEXT GETDFN() NOT IN USE INCLUDED FOR REFERENCE
+;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+set externalfilename="C:\Documents and Settings\robinson\My Documents
-       ;
+\HOMEWORK\MUMPS\Lab 09\out_file.txt"
-       ; GETDFN() ;Get pointer to PATIENT file (#2)
+open externalfilename:("NRW")
-       ; Input : None
+use externalfilename
-       ;Output : DFN - Pointer to PATIENT file (#2)
+;
-       ; -1 - No entry selected
+; write to the selected file
-       ;
+; write a text file with the format: Field Id Name^Field Data^
-       ; N DIC,X,Y,DTOUT,DUOUT
+;
-       ; S DIC="^DPT("
+W "Name^",DGNAM,"^SSN^",DGSSN,"^" ; Line I have written
-       ; S DIC(0)="AEMNQZ"
+W "SEX^",SEX,"^DOB^",ZDOB,"^ADDRESS^",ADDRESS,"^"
-       ; D ^DIC
+W "CITY^",CITY,"^STATE^",ZSTATE,"^ZIP^",ZIP
-       ; Q +Y
+W "PHONE^", PHONE,"^"
-       ;
+;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+close externalfilename
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
-       ; GETDFN() ; Get the veteran's DFN
+;
-       ; N DIC,DTOUT,DUOUT,X,Y
+;W !,"WHOLE GLOBAL: ",$G(^DPT(DGDFN,0))
-       ; W !
+;
-       ; S DIC="^DPT(",DIC(0)="AEMZQ",DIC("S")="I $D(^DGMT(408.31,""AID"",
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-,+Y))"
+; FROM:
-       ; D ^DIC
+; VAFCMS01 ;BP-CIOFO/JRP - ADMISSION RETRANSMISSION;8/3/1998 ;
-       ; Q:$D(DTOUT)!($D(DUOUT)) 0
+; 5.3;Registration;**209**;Aug 13, 1993
-       ; Q:Y<0 0
+;
-       ; Q +Y
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
-       ;
+GETDFN() ;Get pointer to PATIENT file (#2)
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Input : None
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;Output : DFN - Pointer to PATIENT file (#2)
-       ;
+; -1 - No entry selected
-       ; FROM:
+;
-       ; DGENPTA ;ALB/CJM - Patient API - Retrieve Data; 13 JUN 1997
+N DIC,X,Y,DTOUT,DUOUT
-       ;;5.3;Registration;**121,122,147**;08/13/93
+S DIC="^DPT("
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+S DIC(0)="AEMNQZ"
-       ;
+D ^DIC
+Q +Y
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; FROM:
+; DGENPTA ;ALB/CJM - Patient API - Retrieve Data; 13 JUN 1997
+;;5.3;Registration;**121,122,147**;08/13/93
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
 SSN(DFN) ;
-       ;Description: Function returns the patient's SSN, or "" on failure.
+;Description: Function returns the patient's SSN, or "" on failure.
-       ;
+;
-       Q:'DFN ""
+Q:'DFN ""
-       Q $P($G(^DPT(DFN,0)),"^",9)
+Q $P($G(^DPT(DFN,0)),"^",9)
-       ;
+;
 NAME(DFN) ;
-       ;Description: Function returns the patient's NAME, or "" on failure.
+;Description: Function returns the patient's NAME, or "" on failure.
-       ;
+;
-       Q:'DFN ""
+Q:'DFN ""
-       Q $P($G(^DPT(DFN,0)),"^")
+Q $P($G(^DPT(DFN,0)),"^")
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;
+;
-       QUIT ; END NAM2SSN
+QUIT ; END NAM2SSN
-       ;
+;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-       QUIT ; MAKE SURE ENDING HERE
+;
-       ;
+; VERY IMPORTANT EXAMPLE OF PATIENT LOOKUP MAIN ROUTINE
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
-       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; DPTLK ;ALB/RMO,RTK - MAS Patient Look-up Main Routine ; 3/22/05
-       ;
-       ; VERY IMPORTANT EXAMPLE OF PATIENT LOOKUP MAIN ROUTINE
-       ;
-       ; DPTLK ;ALB/RMO,RTK - MAS Patient Look-up Main Routine ; 3/22/05
 :19pm
-       ;;
+;;
 .3;Registration;**32,72,93,73,136,157,197,232,265,277,223,327,244,513,528,541,576,600,485,633,629,647**;Aug
 , 1993
-       ;
+;
-        ; mods made for magstripe read 12/96 - JFP
+; mods made for magstripe read 12/96 - JFP
-       ;
+;
-       ;Optional input: DPTNOFZY='1' to suppress fuzzy lookups implemented
+;Optional input: DPTNOFZY='1' to suppress fuzzy lookups implemented
-       ; by patch DG*5.3*244
+; by patch DG*5.3*244
-</pre>
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;