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

From VistApedia
Jump to: navigation, search
(Added glossary link to Record~)
 
(14 intermediate revisions by 4 users not shown)
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.
+
Thanks [http://groups.google.com/group/hardhats/browse_thread/thread/8bb69fae657acf6d/ Alan] for the program.
 
 
--------------------------------------------------------------------------------
 
 
 
 
 
 
 
Here is the Full documentation of the very basic starter program for
 
selecting one patients file and printing there name and ssn.
 
About five VistA routines are included for reference.
 
 
 
===================================================
 
  
 +
<pre><nowiki>
 +
This program retrieves single patient [[record~|Record]] from VistA
  
 
USER>D ^%CD
 
USER>D ^%CD
 
+
 
Namespace: VISTA
 
Namespace: VISTA
 
You're in namespace VISTA
 
You're in namespace VISTA
 
Default directory is c:\cachesys\mgr\vista\
 
Default directory is c:\cachesys\mgr\vista\
 
VISTA>
 
VISTA>
 
+
VISTA>S DUZ=10000000020
+
VISTA>D ^NAM5SSN
 
+
VISTA>D ^XUP
+
"==========================================="
 
+
VISTA SELECT PATIENT PROCEDURE:
Setting up programmer environment
+
"==========================================="
This is a TEST account.
+
 
 
Terminal Type set to: C-VT320
 
 
 
Select OPTION NAME:
 
VISTA>
 
 
 
VISTA>D ^NAM3SSN
 
 
 
 
Select PATIENT NAME: ONE
 
Select PATIENT NAME: ONE
  1  ONE,IMAGEPATIENT        4-15-53    666061001    NO    NSC
+
  1  ONE,IMAGEPATIENT        4-15-53    666061001    NO    NSC VETERAN
VETERAN
+
  2  ONE,INPATIENT        3-9-45    666000801    NO    NSC VETERAN
 
+
  3  ONE,OUTPATIENT        3-9-45    666000601    NO    NSC VETERAN
  2  ONE,INPATIENT        3-9-45    666000801    NO    NSC VETERAN
+
  4  ONE,PATIENT        4-7-35    666000001    YES    SC VETERAN
 
+
  5  ONEHUNDRED,INPATIENT        3-9-45    666000900    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
 
ENTER '^' TO STOP, OR
CHOOSE 1-5: 4  ONE,PATIENT        4-7-35    666000001    YES    SC
+
CHOOSE 1-5: 4  ONE,PATIENT        4-7-35    666000001    YES    SC VETERAN
VETERAN
 
 
 
 
  Enrollment Priority: GROUP 3    Category: IN PROCESS    End Date:
 
  Enrollment Priority: GROUP 3    Category: IN PROCESS    End Date:
 +
 +
"==========================================="
 +
NAME5SSN SELECTED PATIENT DATA:
 +
"==========================================="
 +
 +
Name: ONE,PATIENT SSN: 666000001
 +
SEX: M DOB: APR 7,1935 ADDRESS: 1312 Ashton Place
  
 
+
CITY: Rowling STATE: WEST VIRGINIA ZIP: 99998
Name: ONE,PATIENT  SSN: 666000001
+
PHONE: 222-555-8235
 
+
 +
"==========================================="
 +
 
VISTA>
 
VISTA>
 
+
"======================================================================="
 
+
FILE OUTPUT
NAM3SSN ; Lab 9; TEST VISTA SELECT PATIENT NAME: W NAME & SSN; AHR;
+
"======================================================================="
09/14/2009
+
      ;
+
Name^ONE,PATIENT^SSN^666000001^SEX^M^DOB^APR 7,1935^ADDRESS^1312 Ashton Place^CITY^Rowling^STATE^WEST VIRGINIA^ZIP^99998PHONE^222-555-8235^
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
      ; FROM:
+
"========================================================================"
      ; DGPHIST ;WASH/ERC - PURPLE HEART REQUEST HISTORY ;23 AUG 00 ;
+
      ; 5.3;Registration;**343**,Aug 13, 1993
+
- Show quoted text -
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
NAM5SSN ; Lab 9 M1; VISTA SELECT PATIENT NAME: W NAME & SSN; AHR; 09/28/2009
      ;
+
;
EN ;Entry point
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ;
+
;
      N DGDFN,DGPAT,DGNAM,DGSSN
+
; Setting up a VistA environment
      I DTIME="" S DTIME=30 ; added 1 line; TIMEOUT 4 READ set if ^XUP not
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
run
+
;
      S DGDFN=$$GETDFN()
+
;USER>D ^%CD
      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,
 
2001;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"",
 
3,+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
 
1988
 
      ;;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")'?
 
1A.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
 
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
 
      ;
 
      ;
 
      ;
 
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
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
+
; Namespace: VISTA
 +
; You're in namespace VISTA
 +
; Default directory is c:\cachesys\mgr\vista\
 
;
 
;
;Optional input: DPTNOFZY='1' to suppress fuzzy lookups implemented
+
; VISTA>S DUZ=10000000020
; by patch DG*5.3*244
 
 
;
 
;
EN ; -- Entry point
+
; VISTA>D ^XUP
N DIE,DR
+
 
K DPTX,DPTDFN,DPTSAVX I $D(DIC(0)) G QK:DIC(0)["I"!(DIC(0)'["A"&('$D
+
; Setting up programmer environment
(X)))
+
; This is a TEST account.
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),
 
1:"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
+
; Terminal Type set to: C-VT320
I DIC(0)["A" D G QK:'$T!($E(DPTX)["^")!(DPTX="")
 
.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
+
; Select OPTION NAME:
D DO^DIC1
+
; VISTA>
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
 
4 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
+
; VISTA>D ^NAM5SSN
I DIC(0)["L" D ^DPTLK2 S Y=DPTDFN G ASKPAT:DIC(0)["A"&(Y<0)&('$G
 
(DTOUT)),QK1
 
 
;
 
;
CHKDFN ; --
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
S:'$D(DPTDFN) DPTDFN=-1 I DPTDFN'>0!('$D(DPTS(+DPTDFN))) W:DIC(0)["Q"
 
*7," ??" G ASKPAT:DIC(0)["A",QK
 
I DIC(0)["E" D W $S('$D(DPTSEL)&('$D(DIVP)):$P(DPTS(DPTDFN),U,2)_" "_$P
 
(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
+
; Assuming you want field #9 from File #2, the name of the field is retrieved
I '$G(DICR),DPTDFN>0,DIC(0)["E",$$BS5^DPTLK5(+DPTDFN) D G ASKPAT:DIC(0)
+
; with the MUMPS expression
["A"&(%'=1),QK:DPTDFN<0
+
; WRITE $PIECE(^DD(2,9,0),"^",1),!
.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)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
["A"&(DPTDFN<0),QK:DPTDFN<0
 
S DPTX=DPTX_$P(DPTS(DPTDFN),U,2),DPTDFN=DPTDFN_U_$P(^DPT(DPTDFN,0),U)
 
 
;
 
;
Q ; --
+
; observe the difference between
S Y=$S('$D(DPTDFN):-1,'$D(DPTS(+DPTDFN)):-1,1:DPTDFN),X=$S($D(DPTX)&
+
; field number and global subscript location:
(+Y>0):DPTX,$D(DPTSAVX):DPTSAVX,$D(DPTX):DPTX,1:"")
 
I Y>0 S:DIC(0)'["F" ^DISV($S($D(DUZ)#2:DUZ,1:0),"^DPT(")=+Y S:DIC(0)
 
["Z" Y(0)=^DPT(+Y,0),Y(0,0)=$P(^(0),U,1)
 
;DG*600
 
;I DIC(0)["E",$P($G(^DPT(+Y,0)),U,21) W *7,!,"Warning : You have
 
selected a test patient."
 
I DIC(0)["E",$$TESTPAT^VADPT(+Y) W *7,!,"WARNING : You may have
 
selected a test patient."
 
I DIC(0)["E",$$BADADR^DGUTL3(+Y) W *7,!,"WARNING : ** This patient has
 
been flagged with a Bad Address Indicator."
 
I DIC(0)["E",$$VAADV^DPTLK3(+Y) W *7,!,"** Patient is VA ADVANTAGE."
 
;DG*485
 
I $D(^DPT("AXFFP",1,+Y)) D FFP^DPTLK5
 
;Display enrollment information
 
I Y>0,DIC(0)["E" D ENR
 
 
;
 
;
;Call Combat Vet check
+
; Select DATA DICTIONARY UTILITY OPTION: LIST FILE ATTRIBUTES
I Y>0,DIC(0)["E" D CV
+
; 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
 
;
 
;
; check whether to display Means Test Required message
+
; Below is the section on address. Note:
D
+
; Field Label, Number, and Global Subscript Location
.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",
 
1:"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 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~|Record]] Number
 +
; (IEN)
 +
;
 +
; NUMBER: 5 NAME: STATE
 +
; [[APPLICATION~|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)
 +
;
 +
; FileMan Internal to External Date
 +
; X ^DD("DD"): Internal to External Date
 +
; Introduction to Date/Time Formats: %DT
 +
; This introduction pertains to this and the %DT calls. %DT is used to validate date/time input and convert it to VA FileMan's conventional internal format: "YYYMMDD.HHMMSS", where:
 +
;  YYY is number of years since 1700 (hence always 3 digits)
 +
;  MM is month number (00-12)
 +
;  DD is day number (00-31)
 +
;  HH is hour number (00-23)
 +
;  MM is minute number (01-59)
 +
;  SS is the seconds number (01-59)
 +
; This format allows for representation of imprecise dates like JULY '78 or 1978 (which would be equivalent to 2780700 and 2780000, respectively). Dates are always returned as a canonic number (no trailing zeroes after the decimal).
 +
; There are two ways to convert a date from internal YYYMMDD format to external format€�this call and DD^%DT. (This is the reverse of what %DT does.) Simply set the variable Y equal to the internal date and execute ^DD("DD").
 +
; Example
 +
; >S Y=2690720.163 X ^DD("DD") W Y
 +
; JUL 20,1969@1630
 +
; This results in Y being equal to JUL 20,1969@16:30. (No space before the 4-digit year.)
 +
; Input Variable
 +
; Y
 +
; (Required) This contains the internal date to be converted. If this has five or six decimal places, seconds will automatically be returned.
 +
; Output Variable
 +
; Y
 +
; Y is returned as the external form of the date.
 +
; See also DT^DIO2, which takes an internal date in the variable Y and writes out its external form.
 +
; March 1999 VA FileMan V. 22.0 Programmer Manual 1-5
 +
;Revised December 2007
 +
;
 +
S Y=DOB X ^DD("DD")
 +
S DOB=Y
 +
;
 +
; MUMPS DATE, DOES NOT APPLY; S ZDOB=$ZDATE(DOB)
  
Here is the short version of my basic program with little
+
;
documentation.
+
S ADDRESS=$P(^DPT(DGDFN,.11),"^",1)
I will be using this version to use method 1 to solve this problem,
+
;
by adding field numbers maunually and maully writting them to the
+
S CITY=$P(^DPT(DGDFN,.11),"^",4)
screen
+
;
or a text. the other version later.
+
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: ",DOB," ADDRESS: ",ADDRESS
  
=========================================================
+
W !,"CITY: ",CITY," STATE: ",ZSTATE," ZIP: ",ZIP
- Show quoted text -
+
W !,"PHONE: ", PHONE,!
 
+
W !,"===========================================",!
USER>D ^%CD
+
;
 
+
;
Namespace: VISTA
+
; To write to an external file name:
You're in namespace VISTA
+
;
Default directory is c:\cachesys\mgr\vista\
+
set externalfilename="C:\Documents and Settings\robinson\My Documents\HOMEWORK\MUMPS\Lab 09\out_file.txt"
VISTA>
+
open externalfilename:("NRW")
 
+
use externalfilename
VISTA>S DUZ=10000000020
+
;
 
+
; write to the selected file
VISTA>D ^XUP
+
; write a text file with the format: Field Id Name^Field Data^
 
+
;
Setting up programmer environment
+
W "Name^",DGNAM,"^SSN^",DGSSN,"^" ; Line I have written
This is a TEST account.
+
W "SEX^",SEX,"^DOB^",DOB,"^ADDRESS^",ADDRESS,"^"
 
 
Terminal Type set to: C-VT320
 
 
 
Select OPTION NAME:
 
VISTA>
 
 
 
VISTA>D ^NAM3SSN
 
 
 
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:
 
 
 
 
 
Name: ONE,PATIENT  SSN: 666000001
 
 
 
VISTA>
 
 
 
 
 
 
 
NAM5SSN ; Lab 9; TEST VISTA SELECT PATIENT NAME: W NAME & SSN; AHR;
 
09/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
 
  
      I DTIME="" S DTIME=30 ; added 1 line; TIMEOUT 4 READ set if ^XUP not
+
</nowiki></pre>
run
 
 
 
      S DGDFN=$$GETDFN()
 
      Q:DGDFN'>0
 
      ;
 
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
- Show quoted text -
 
      ; --->>> 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
 
      ;
 
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
      ; 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"",
 
3,+Y))"
 
      ; D ^DIC
 
      ; Q:$D(DTOUT)!($D(DUOUT)) 0
 
      ; Q:Y<0 0
 
      ; 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
 
      ;
 
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
      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
 
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
 

Latest revision as of 00:23, 22 March 2012

Thanks Alan for the program.

This program retrieves single patient [[record~|Record]] from VistA

USER>D ^%CD
 
Namespace: VISTA
You're in namespace VISTA
Default directory is c:\cachesys\mgr\vista\
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: APR 7,1935 ADDRESS: 1312 Ashton Place

CITY: Rowling STATE: WEST VIRGINIA ZIP: 99998
PHONE: 222-555-8235
 
"==========================================="
 
VISTA>
"======================================================================="
FILE OUTPUT
"======================================================================="
 
Name^ONE,PATIENT^SSN^666000001^SEX^M^DOB^APR 7,1935^ADDRESS^1312 Ashton Place^CITY^Rowling^STATE^WEST VIRGINIA^ZIP^99998PHONE^222-555-8235^
 
"========================================================================"
 
- Show quoted text -
 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~|Record]] Number
; (IEN)
;
; NUMBER: 5 NAME: STATE
; [[APPLICATION~|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)
;
; FileMan Internal to External Date
; X ^DD("DD"): Internal to External Date
; Introduction to Date/Time Formats: %DT
; This introduction pertains to this and the %DT calls. %DT is used to validate date/time input and convert it to VA FileMan's conventional internal format: "YYYMMDD.HHMMSS", where:
;  YYY is number of years since 1700 (hence always 3 digits)
;  MM is month number (00-12)
;  DD is day number (00-31)
;  HH is hour number (00-23)
;  MM is minute number (01-59)
;  SS is the seconds number (01-59)
; This format allows for representation of imprecise dates like JULY '78 or 1978 (which would be equivalent to 2780700 and 2780000, respectively). Dates are always returned as a canonic number (no trailing zeroes after the decimal).
; There are two ways to convert a date from internal YYYMMDD format to external format€�this call and DD^%DT. (This is the reverse of what %DT does.) Simply set the variable Y equal to the internal date and execute ^DD("DD").
; Example
; >S Y=2690720.163 X ^DD("DD") W Y
; JUL 20,1969@1630
; This results in Y being equal to JUL 20,1969@16:30. (No space before the 4-digit year.)
; Input Variable
; Y
; (Required) This contains the internal date to be converted. If this has five or six decimal places, seconds will automatically be returned.
; Output Variable
; Y
; Y is returned as the external form of the date.
; See also DT^DIO2, which takes an internal date in the variable Y and writes out its external form.
; March 1999 VA FileMan V. 22.0 Programmer Manual 1-5
;Revised December 2007
;
S Y=DOB X ^DD("DD")
S DOB=Y
;
; MUMPS DATE, DOES NOT APPLY; S ZDOB=$ZDATE(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: ",DOB," 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^",DOB,"^ADDRESS^",ADDRESS,"^"