SAMPLE OF M CODE WRITTEN BY GARY SHUMWAY

The following sample Caché (MUMPS) routines, ZGSPTVD and ZGSPTVDX, were written for a Hospital which was converting from Compucare's Affinity product to Meditech's Magic.  The routines abstracted data from the patient visit and demographic files and created a Caché global (^ZGSPTVD).  This global could then be listed (and captured for inclusion into an Excel spreadsheet) or converted into a UNIX file.  A rudimentary menu and on-line documentation were included in the routines.  ZGSPTVD is the primary abstracting routine.  Note: Data and names changed to protect confidentiality.

Routine:  ZGSPTVD  /  ZGSPTVDX

 
  ZGSPTVD  
  
ZGSPTVD ;ABSTRACT & OUTPUT PATIENT DEMOGRAPHIC & VISIT RECORDS FOR ___ HOSPITAL;12/07/2000;GSS
        ; See also ZGSPTVDX
        ;
        ; Use START^ZGSPTVD (or just call ZGSPTVD) for user selection of function.
        ; To job this routine, use entry JOB^ZGSPTVD, otherwise use ONLINE^ZGSPTVD
        ; To convert ^ZGSPTVD to a UNIX text file, use entry UNIX^ZGSPTVDX
        ; If this routine is Jobbed, then it can be stopped by setting ^ZGSPTOP=1
        ; To display records sequentially (after compiling them) use LISTREC^ZGSPTVD
        ; Use DOC^ZGSPTVD to list documentation regarding the functionality of ZGSPTVD.
        ;
        ; This routine creates the global ^ZGSPTVD of patient demographic and
        ; visit data based on MAXCT and START (obtained from function $$ASK^ZGSPTVDX).
        ;
        ; See DOC tag for output record format.
        ;
        ; Entry point for user selection of function
START   N IN
        W #!!,$P($T(ZGSPTVD),";",2)
        W !!?35,"User Menu"
        W !,"Select, by letter, one of the following options:"
        W !,"A - On-Line Abstraction (for sample records from database)"
        W !,"D - On-Line Documentation"
        W !,"J - Job the Abstraction (goes through entire database -takes a LONG time)"
        W !,"L - List records found from a previous abstraction"
        W !,"U - Create a UNIX text file from a previous abstraction"
        W !,"Q - Quit"
        R !!,"Option: ",IN S:$A(IN)>96 IN=$C($A(IN)-32)
        G START:IN=""!'$F("A\D\J\L\U\Q",IN)
        I IN="A" D ONLINE G START
        I IN="D" D DOC^ZGSPTVDX G START
        I IN="J" D JOB G QUIT
        I IN="L" D LISTREC^ZGSPTVDX G START
        I IN="U" D UNIX^ZGSPTVDX G QUIT
        QUIT Q
        ;
        ; Entry point for Jobbing this routine
JOB     S ONLINE=0 ;abstraction jobbed
        S MAXCT="A" ;go through all the ^PVZ records
        S START=0 ;start at the beginning of ^PVZ (the visit file)
        G BGN
        ;
        ; Entry point for on-line (user specification of parameters) entry
ONLINE  W #,$P($T(ZGSPTVD),";",2) ;display program header .. comment out to job
        S X=$$ASK^ZGSPTVDX Q:X="." ;get MAXCT and START from user
        S ONLINE=1 ;abstraction not jobbed
        S MAXCT=$P(X,"~") ;maximum number of records
        S START=$P(X,"~",2) ;visit starting nodal value
        W "...Working"
        G BGN
        ;
        ; Use JOB or ONLINE as entry points only!!!
BGN     S (PCT,RCT,TVCT,VCT)=0,T="~"
        S VIO=START-1
        K ^ZGSPTDX,^ZGSPTVD,^ZGSPTOP ;delete all previously compiled data...if any
        S ^ZGSPTVD=$H ;store starting time
        F S VIO=$O(^VZ(VIO)) Q:VIO=""!$G(^ZGSPTOP) D I MAXCT'="A" Q:VCT=MAXCT
        . ; Increment total visit count
        . S TVCT=TVCT+1
        . ; Indicate routine is abstracting by displaying dots
        . I TVCT#100=0 W "."
        . ; Get visit data
        . D GETVST Q:REC1=""
        . ; Get demographic data
        . D GETDG
        . ; Store patient demographic and visit record after removing any control characters
        . S RCT=RCT+1
        . S ^ZGSPTVD(RCT)=ROD_T_ROV
        . ; Increment visit counter
        . S VCT=VCT+1
        ; If going through entire database then get those patients without visit data
        I MAXCT="A" D NOVST
        ;Store routine completion date/time and visit count
        S $P(^ZGSPTVD,T,2)=$H_T_TVCT_T_VCT_T_PCT_T_RCT
        Q
        ;
        ; Include those patients w/o visits
NOVST   ; MNAME set to null as w/o visits there is no reference to a mother in the visit file
        S (MNAME,PIO)=""
        F S PIO=$O(^PZ(PIO)) Q:PIO=""!$G(^ZGSPTOP) D
        . ; Patient's record already output as part of a visit
        . Q:$G(^ZGSPTDX(PIO))'=""
        . ; Get patient demographic record to store
        . D GETDG
        . ; Store patient demographic record after removing any control characters
        . S RCT=RCT+1
        . S ^ZGSPTVD(RCT)=$$RMCTL(ROD)
        Q
        ;
        ; Get visit data from ^VZ based on VIO (internal visit index number)
GETVST  S ROV=""
        S REC1=$G(^VZ(VIO,1)) ;get primary record for this visit
        ; If no primary record then there's a problem and store VIO in ^ZGDPTVX
        I REC1="" S ^ZGSPTVX(VIO,1)="NO DATA" Q
        ; Get patient's internal index number
        S PIO=$P(REC1,T,1)
        ; Get admit date
        S %DN=$P(REC1,T,2) D 300^%DO S ADMITDT=$E(%DS,5,8)_$E(%DS,1,4)
        ; Get patient's account number
        S VISITACCTN=$P(REC1,T,12)
        ; Get service AKA patient location and patient type
        S PTLOC="" S:$P(REC1,T,13)'="" PTLOC=$P($G(^DCPSZ($P(REC1,T,13),1)),T,5)
        ; Get admitting physician
        ;S ADMITPHYS=$P(REC1,T,3)
        ; Get external ID of admitting physician
        ;S:ADMITPHYS'="" ADMITPHYS=$P($G(^DCPHZ(ADMITPHYS,1)),T,5)
        ; Get primary attending physician
        S PRIMPHYS=$P($G(^VZ(VIO,551,1,1)),T,2)
        ; Get external ID of primary attending physician
        S:PRIMPHYS'="" PRIMPHYS=$P($G(^DCPHZ(PRIMPHYS,1)),T,5)
        ; Get primary diagnosis internal ID
        S DIAGNOSIS=$P($G(^VZ(VIO,91)),T,11)
        ; Get IDC9 code - diagnosis description
        S:DIAGNOSIS'="" DIAGNOSIS=$P($G(^DCICZ(DIAGNOSIS,1)),T,1)_"-"_$P($G(^DCICZ(DIAGNOSIS,1)),T,3)
        ; Get discharge date
        S %DN=$P(REC1,T,4) D 300^%DO S DISCHGDT=$E(%DS,5,8)_$E(%DS,1,4)
        ; Get discharge disposition
        S DISCHGDISP=$P(REC1,T,5)
        S:DISCHGDISP'="" DISCHGDISP=$P($G(^ZSDVZ(DISCHGDISP,1)),T,2)
        ; _"-"_$P($G(^ZSDVZ(DISCHGDISP,1)),T,3) ;Discharge disposition description
        ; Get MRI Patient Flag..if flag=NO then visit registered in error and has been cancelled
        S MRIPTFLAG=$P(REC1,T,9)
        ; Get mother's internal visit number if a mother's ID is placed in child's visit record
        ; MNAME used to populate the demographic portion of the returned string
        ; This was done since mother's name originally pulled from demog of pt, not visit db
        S MNAME="",MIVN=$P($G(^VZ(VIO,71)),T,4)
        ; Get mother's name..if on record for that visit
        I MIVN'="" S MIPN=$P($G(^VZ(MIVN,1)),T) S:MIPN'="" MNAME=$P($G(^PZ(MIPN,1)),T,2)
        ; Create output record (including patient demographic data)
        S ROV=VIO_T_ADMITDT_T_VISITACCTN_T_PTLOC_T_PRIMPHYS_T_DIAGNOSIS_T_DISCHGDT_T_DISCHGDISP_T_MRIPTFLAG
        Q
        ;
        ; Get patient demographic record based on PIO (patient's ^PZ index number)
GETDG   ; If this patient's demographic data already captured then use that data
        S ROD=""
        I $G(^ZGSPTDX(PIO))'="" S ROD=^ZGSPTDX(PIO) Q
        ; Define node one record
        S R1=$G(^PZ(PIO,1))
        ; Get patient name
        S PTNAM=$P(R1,T,2)
        ; Get patient's social security number
        S SSN=$P(R1,T,6)
        ; Get DOB as mmddyyyy
        S %DN=$P(R1,T,3) D 300^%DO S DOB=$E(%DS,5,8)_$E(%DS,1,4)
        ; Get gender
        S SEX=$P(R1,T,4)
        ; Get patient's MRUN
        S MRUN=$P($G(^PZ(PIO,2)),T)
        ; Get patient's AKAs
        S AKANUM=0,AKAS=""
        F S AKANUM=$O(^PZ(PIO,504,AKANUM)) Q:AKANUM="" D
        . S AKA=$G(^PZ(PIO,504,AKANUM,1)) Q:AKA=PTNAM ;AKA same as patient's current name
        . S:AKANUM>1 AKAS=AKAS_"|" ;use '|' as multiple AKAs delimeter
        . S AKAS=AKAS_AKA
        ; Get the PIO (MERGDTO) then MRUN into which this chart has been merged
        S MERGDTO=$P($G(^PZ(PIO,31)),T,3)
        S:MERGDTO'="" MERGDTO=$G(^PZ(MERGDTO,2))
        ;I MERGDTO'="" W !,PIO," ",^PZ(PIO,2)," ",MERGDTO
        ; Create demographic record
        S ROD=PIO_T_MRUN_T_PTNAM_T_DOB_T_SEX_T_MNAME_T_AKAS_T_SSN_T_MERGDTO
        ; Create demographic cross reference file
        S ^ZGSPTDX(PIO)=ROD,PCT=PCT+1
        Q
        ;
        ; Remove any control characters from string.
RMCTL(S);
        N I,s
        S s=""
        F I=1:1:$L(S) I $A($E(S,I))>31 S s=s_$E(S,I)
        Q s
  
     

 
  ZGSPTVDX  
  
ZGSPTVDX     ;Sub-routines for ZGSPTVD;01/08/2001;GSS
        ;
        Q
        ;
        ; Ask number of records to compile & starting index number
ASK()   N
A       R !!,"Number of records to compile (#/A/.): ",PTCT
        I PTCT'=".",PTCT'?.N,PTCT'="A" W !,"Please enter a number, 'A' for All or '.' to Quit" G A
        I PTCT="." Q "."
B       W !,"The current range of patient visit index numbers is 1 to ",$O(^VZ("IE"),-1),"."
        R !,"Begin with what patient visit index (internal) number: ",IINDEX
        W !!,"Number of records to compile will be ",PTCT," and"
        W !,"the beginning index number will be ",IINDEX,", OK? " R OK
        I OK=""!'$F("Y\y",OK) W !,"Enter 'Y' or 'y' if OK...re-enter values" G A
        Q PTCT_"~"_IINDEX
        ;
        ; Output ^ZGSPTVD to a UNIX file
UNIX    N OK,RCT,UNIXFN,VIO
        D HEADER
        I $G(^ZGSPTVD)="" Q
        R !!,"Output the compiled data to which (new) UNIX file: ",UNIXFN
        I UNIXFN=""!(UNIXFN=".") G NOUNIX
        R !,"OK to create UNIX file now? ",OK
        I '$F("Y\y",OK) G NOUNIX
        W !,"...creating UNIX file ",UNIXFN
        O UNIXFN:("WNS"):3 E W "..unable to open ",UNIXFN,"..must be a new file" G UNIX
        S VIO=""
        F RCT=1:1 S VIO=$O(^ZGSPTVD(VIO)) Q:VIO="" U UNIXFN W ^ZGSPTVD(VIO),! U 0
        C UNIXFN
        U 0 W !,"UNIX file ",UNIXFN," created with ",RCT," records."
        Q
        ; Unix file not created
NOUNIX  W !,"UNIX file not created"
        Q
        ;
        ; Output records from ^ZGSPTVD in order compiled
LISTREC  N A
        D HEADER
        I $G(^ZGSPTVD)="" Q
        K
        S A=""
        F S A=$O(^ZGSPTVD(A)) Q:A="" W !!,^ZGSPTVD(A)
        Q
        ;
        ; Header information for data output
HEADER  I $G(^ZGSPTVD)="" W !!,"No compiled data in Caché file...please compile data first." Q
        W !!,"You are about to output the results from a previous compilation of patient"
        W !,"demographic and visit data."
        W !,"This data is from a compilation which started "
        W $ZD($P(^ZGSPTVD,"~")),!," and ended ",$ZD($P(^ZGSPTVD,"~",2))
        I $P(^ZGSPTVD,"~",2)="" W "...NOTE THAT THIS RUN WAS NOT COMPLETELY COMPILED!"
        W !,"The output contains data from a total of ",$P(^ZGSPTVD,"~",3)," patient visit records,"
        W !,$P(^ZGSPTVD,"~",5)," patient demographic records, and consists of a total of "
        W !,$P(^ZGSPTVD,"~",6)," records."
        Q
        ;
        ; On-line documentation regarding the functionality of ZGSPTVD
DOC     N IN,LINE,VERBIAGE
        S IN=""
        F LINE=0:1 S VERBIAGE=$P($T(DOCSTRT+LINE),";",2) Q:VERBIAGE="%%" D Q:IN="."
        . I LINE#22=0,LINE>0 W !,"Depress ENTER to continue or enter a period ('.') to quit: " R IN Q:IN="." W #
        . W !,VERBIAGE
        I IN'="." R !,"Extent of documentation..depress ENTER ",IN
        Q
        ;
DOCSTRT ;Output of Patient Demographic and Visit Records for The ___ Hospital
        ;
        ;The purpose of the ZGSPTVD routine is to sequentially go through HFH's
        ;Affinity System for patient visit and demographic records and abstract
        ;the pertinent fields for conversion.
        ;
        ;The first portion of the abstract goes through the patient visit file
        ;and abstracts the relevant fields from the visit record as well as the
        ;corresponding patient demographics file. The fields abstracted are
        ;then concatenated into one record for each patient visit.
        ;
        ;After going through the patient visit file, patients which are not
        ;represented in the foregoing (patients with no visits) have their
        ;relevant demographic fields concatenated to form a record.
        ;Note that the patient visit fields will not be populated as there
        ;is no data for those fields for those patients.
        ;
        ;During the abstract, a MUMPS/Cache file is created which contains the
        ;records formed during the abstraction. These records can then be
        ;output as a 'on-screen' Listing (option 'L' from User Menu). This
        ;'on-screen' listing can be captured for printing to a remote device
        ;or alternately, captured for inclusion into an Excel spreadsheet.
        ;Additionally, a UNIX file (option 'U' from User Menu) can be created.
        ;
        ;The record format for the output (Listing and UNIX file) is one string
        ;of 18 fields per record.
        ;
        ;Note: Primary field delimeter is the tilde '~' and the
        ; secondary delimeter is the pipe '|'.
        ;
        ;The record layout follows:
        ; Prim. Excel
        ; Field# Column Description
        ; 1 A *Patient internal ID number
        ; 2 B Patient's MRUN (Medical Record Unit Number)
        ; 3 C Patient's name (Last,First Middle)
        ; 4 D Patient's DOB (Date of Birth) as MMDDYYYY
        ; 5 E Patient's Gender (Sex) M=Male, F=Female
        ; 6 F Mother's name
        ; 7 G Aliases (AKAs) with multiple names separated by the
        ; secondary delimeter
        ; 8 H SSN (Social Security Number)
        ; 9 I This MRUN merged into this MRUN (if field valued)
        ; 10 J *Visit internal ID number
        ; 11 K Visit Admit Date
        ; 12 L Visit Account Number
        ; 13 M Patient Location/Type
        ; 14 N Primary Attending Physician Number
        ; 15 O Diagnosis (ICD-9)
        ; 16 P Discharge Date as MMDDYYYY
        ; 17 Q Discharge Disposition (number)
        ; 18 R MRI Patient Flag
        ;
        ;* - Fields for use by programmer for debugging (not required by hospital)
        ;
        ;That is, the field layout looks like the following:
        ; Pt Int#~MRUN~Name~DOB~Sex~Mother's Name~Alias1|Alias2|...|Aliasn~SSN~
        ; Merged to MRUN~Visit Int#~Visit Admit Date~Visit Acct#~Pt Location or type~
        ; Primary Attending Physician#~Diagnosis~Discharge Date~
        ; Discharge Disposition~MRI Patient Flag
        ;
        ;An example record follows (for display purposes, it has been wrapped after
        ; the Visit Internal ID):
        ;279610~504329~LAST,FIRST~01011974~M~~LAST,FIRST MI~000-00-0000~~17663190386~
        ;01011995~34977181~OPLAB~0351~V78.1-SCREEN-DEFIC ANEMIA NEC~11211995~01~Y
        ;%%;This line ends documentation..do not remove