source: VWGUIRegistration/tag/2.0/VWREG_03202017_OrigInstall.KID

KIDS Distribution saved on Mar 20, 2017@11:54:03
Original install for new sites
**KIDS**:VWREG_03202017_ORIGINALINSTALL*1.0*0^

**INSTALL NAME**
VWREG_03202017_ORIGINALINSTALL*1.0*0
"BLD",8572,0)
VWREG_03202017_ORIGINALINSTALL*1.0*0^^0^3170320^n
"BLD",8572,1,0)
^^15^15^3170320^
"BLD",8572,1,1,0)
Hi,
"BLD",8572,1,2,0)
This is an original install, meaning if you have not installed this
"BLD",8572,1,3,0)
application, this IS the one to install.
"BLD",8572,1,4,0)
NOTE: This whole application is still Alpha level and any feedback
"BLD",8572,1,5,0)
      is greatly appreciated.
"BLD",8572,1,6,0)
It contains
"BLD",8572,1,7,0)
  5 Files
"BLD",8572,1,8,0)
  6 Input Templates (for optional use or study)
"BLD",8572,1,9,0)
  8 Routines (VWREG*)
"BLD",8572,1,10,0)
  2 Options
"BLD",8572,1,11,0)
  3 Parameter Definitions
"BLD",8572,1,12,0)
 19 Remote Procedures
"BLD",8572,1,13,0)
The external zip file will contain the help , tech manuals, and
"BLD",8572,1,14,0)
licensing plus a contact for trouble shooting, errors, etc.
"BLD",8572,1,15,0)
Feel free to keep me posted: jbellco65@gmail.com
"BLD",8572,4,0)
^9.64PA^64850004^5
"BLD",8572,4,2,0)
2
"BLD",8572,4,2,2,0)
^9.641^2^1
"BLD",8572,4,2,2,2,0)
PATIENT  (File-top level)
"BLD",8572,4,2,2,2,1,0)
^9.6411^540001.1^1
"BLD",8572,4,2,2,2,1,540001.1,0)
HEALTH RECORD NUMBER
"BLD",8572,4,2,222)
y^y^p^^^^n^^n
"BLD",8572,4,2,224)

"BLD",8572,4,64850001,0)
64850001
"BLD",8572,4,64850001,222)
y^n^f^^n^^y^m^y
"BLD",8572,4,64850002,0)
64850002
"BLD",8572,4,64850002,222)
y^n^f^^y^^y^m^n
"BLD",8572,4,64850003,0)
64850003
"BLD",8572,4,64850003,222)
y^n^f^^y^^y^m^n
"BLD",8572,4,64850004,0)
64850004
"BLD",8572,4,64850004,222)
y^n^f^^y^^y^m^n
"BLD",8572,4,"APDD",2,2)

"BLD",8572,4,"APDD",2,2,540001.1)

"BLD",8572,4,"B",2,2)

"BLD",8572,4,"B",64850001,64850001)

"BLD",8572,4,"B",64850002,64850002)

"BLD",8572,4,"B",64850003,64850003)

"BLD",8572,4,"B",64850004,64850004)

"BLD",8572,6.3)
1
"BLD",8572,"INI")
PI^VWREGIT2
"BLD",8572,"KRN",0)
^9.67PA^779.2^20
"BLD",8572,"KRN",.4,0)
.4
"BLD",8572,"KRN",.401,0)
.401
"BLD",8572,"KRN",.402,0)
.402
"BLD",8572,"KRN",.402,"NM",0)
^9.68A^6^6
"BLD",8572,"KRN",.402,"NM",1,0)
VW ADDRESS     FILE #2^2^0
"BLD",8572,"KRN",.402,"NM",2,0)
VW EMERG. CONTACT     FILE #2^2^0
"BLD",8572,"KRN",.402,"NM",3,0)
VW NEXT OF KIN     FILE #2^2^0
"BLD",8572,"KRN",.402,"NM",4,0)
VW PT REGISTRATION    FILE #2^2^0
"BLD",8572,"KRN",.402,"NM",5,0)
VW REPORTED DEATH     FILE #2^2^0
"BLD",8572,"KRN",.402,"NM",6,0)
VW WESTVIRGINIA TEST    FILE #2^2^0
"BLD",8572,"KRN",.402,"NM","B","VW ADDRESS     FILE #2",1)

"BLD",8572,"KRN",.402,"NM","B","VW EMERG. CONTACT     FILE #2",2)

"BLD",8572,"KRN",.402,"NM","B","VW NEXT OF KIN     FILE #2",3)

"BLD",8572,"KRN",.402,"NM","B","VW PT REGISTRATION    FILE #2",4)

"BLD",8572,"KRN",.402,"NM","B","VW REPORTED DEATH     FILE #2",5)

"BLD",8572,"KRN",.402,"NM","B","VW WESTVIRGINIA TEST    FILE #2",6)

"BLD",8572,"KRN",.403,0)
.403
"BLD",8572,"KRN",.5,0)
.5
"BLD",8572,"KRN",.84,0)
.84
"BLD",8572,"KRN",3.6,0)
3.6
"BLD",8572,"KRN",3.8,0)
3.8
"BLD",8572,"KRN",3.8,"NM",0)
^9.68A^1^1
"BLD",8572,"KRN",3.8,"NM",1,0)
VW REG ERROR REPORT^^0
"BLD",8572,"KRN",3.8,"NM","B","VW REG ERROR REPORT",1)

"BLD",8572,"KRN",9.2,0)
9.2
"BLD",8572,"KRN",9.8,0)
9.8
"BLD",8572,"KRN",9.8,"NM",0)
^9.68A^8^8
"BLD",8572,"KRN",9.8,"NM",1,0)
VWREGIT^^0^B34467909
"BLD",8572,"KRN",9.8,"NM",2,0)
VWREGIT2^^0^B7008432
"BLD",8572,"KRN",9.8,"NM",3,0)
VWREGIT3^^0^B4498
"BLD",8572,"KRN",9.8,"NM",4,0)
VWREGITP^^0^B5382212
"BLD",8572,"KRN",9.8,"NM",5,0)
VWREGITS^^0^B15352111
"BLD",8572,"KRN",9.8,"NM",6,0)
VWREGITT^^0^B38020021
"BLD",8572,"KRN",9.8,"NM",7,0)
VWREGITU^^0^B34064749
"BLD",8572,"KRN",9.8,"NM",8,0)
VWREGITX^^0^B96032773
"BLD",8572,"KRN",9.8,"NM","B","VWREGIT",1)

"BLD",8572,"KRN",9.8,"NM","B","VWREGIT2",2)

"BLD",8572,"KRN",9.8,"NM","B","VWREGIT3",3)

"BLD",8572,"KRN",9.8,"NM","B","VWREGITP",4)

"BLD",8572,"KRN",9.8,"NM","B","VWREGITS",5)

"BLD",8572,"KRN",9.8,"NM","B","VWREGITT",6)

"BLD",8572,"KRN",9.8,"NM","B","VWREGITU",7)

"BLD",8572,"KRN",9.8,"NM","B","VWREGITX",8)

"BLD",8572,"KRN",19,0)
19
"BLD",8572,"KRN",19,"NM",0)
^9.68A^2^2
"BLD",8572,"KRN",19,"NM",1,0)
VW PATIENT REGISTRATION^^0
"BLD",8572,"KRN",19,"NM",2,0)
VW REG IT CONTROL^^0
"BLD",8572,"KRN",19,"NM","B","VW PATIENT REGISTRATION",1)

"BLD",8572,"KRN",19,"NM","B","VW REG IT CONTROL",2)

"BLD",8572,"KRN",19.1,0)
19.1
"BLD",8572,"KRN",101,0)
101
"BLD",8572,"KRN",409.61,0)
409.61
"BLD",8572,"KRN",771,0)
771
"BLD",8572,"KRN",779.2,0)
779.2
"BLD",8572,"KRN",870,0)
870
"BLD",8572,"KRN",8989.51,0)
8989.51
"BLD",8572,"KRN",8989.51,"NM",0)
^9.68A^3^3
"BLD",8572,"KRN",8989.51,"NM",1,0)
VW GUI REG TEMPLATE DIRECTORY^^0
"BLD",8572,"KRN",8989.51,"NM",2,0)
VW REG DEFAULT STATE^^0
"BLD",8572,"KRN",8989.51,"NM",3,0)
VW REG RDNPT^^0
"BLD",8572,"KRN",8989.51,"NM","B","VW GUI REG TEMPLATE DIRECTORY",1)

"BLD",8572,"KRN",8989.51,"NM","B","VW REG DEFAULT STATE",2)

"BLD",8572,"KRN",8989.51,"NM","B","VW REG RDNPT",3)

"BLD",8572,"KRN",8989.52,0)
8989.52
"BLD",8572,"KRN",8994,0)
8994
"BLD",8572,"KRN",8994,"NM",0)
^9.68A^20^19
"BLD",8572,"KRN",8994,"NM",1,0)
VW REG AHF^^0
"BLD",8572,"KRN",8994,"NM",2,0)
VW REG ALIST^^0
"BLD",8572,"KRN",8994,"NM",3,0)
VW REG EGF^^0
"BLD",8572,"KRN",8994,"NM",4,0)
VW REG FGNA^^0
"BLD",8572,"KRN",8994,"NM",5,0)
VW REG FLD BY GRP^^0
"BLD",8572,"KRN",8994,"NM",6,0)
VW REG GPD^^0
"BLD",8572,"KRN",8994,"NM",7,0)
VW REG GPDM^^0
"BLD",8572,"KRN",8994,"NM",8,0)
VW REG GRP LIST^^0
"BLD",8572,"KRN",8994,"NM",9,0)
VW REG MAIN^^0
"BLD",8572,"KRN",8994,"NM",10,0)
VW REG MF^^0
"BLD",8572,"KRN",8994,"NM",11,0)
VW REG MISC^^0
"BLD",8572,"KRN",8994,"NM",12,0)
VW REG NEW PT^^0
"BLD",8572,"KRN",8994,"NM",13,0)
VW REG PARTIAL PT LIST^^0
"BLD",8572,"KRN",8994,"NM",14,0)
VW REG PF^^0
"BLD",8572,"KRN",8994,"NM",15,0)
VW REG RTF^^0
"BLD",8572,"KRN",8994,"NM",16,0)
VW REG SAVE^^0
"BLD",8572,"KRN",8994,"NM",18,0)
VW REG SPI^^0
"BLD",8572,"KRN",8994,"NM",19,0)
VW REG TEMPLATE^^0
"BLD",8572,"KRN",8994,"NM",20,0)
VW REG ZIP^^0
"BLD",8572,"KRN",8994,"NM","B","VW REG AHF",1)

"BLD",8572,"KRN",8994,"NM","B","VW REG ALIST",2)

"BLD",8572,"KRN",8994,"NM","B","VW REG EGF",3)

"BLD",8572,"KRN",8994,"NM","B","VW REG FGNA",4)

"BLD",8572,"KRN",8994,"NM","B","VW REG FLD BY GRP",5)

"BLD",8572,"KRN",8994,"NM","B","VW REG GPD",6)

"BLD",8572,"KRN",8994,"NM","B","VW REG GPDM",7)

"BLD",8572,"KRN",8994,"NM","B","VW REG GRP LIST",8)

"BLD",8572,"KRN",8994,"NM","B","VW REG MAIN",9)

"BLD",8572,"KRN",8994,"NM","B","VW REG MF",10)

"BLD",8572,"KRN",8994,"NM","B","VW REG MISC",11)

"BLD",8572,"KRN",8994,"NM","B","VW REG NEW PT",12)

"BLD",8572,"KRN",8994,"NM","B","VW REG PARTIAL PT LIST",13)

"BLD",8572,"KRN",8994,"NM","B","VW REG PF",14)

"BLD",8572,"KRN",8994,"NM","B","VW REG RTF",15)

"BLD",8572,"KRN",8994,"NM","B","VW REG SAVE",16)

"BLD",8572,"KRN",8994,"NM","B","VW REG SPI",18)

"BLD",8572,"KRN",8994,"NM","B","VW REG TEMPLATE",19)

"BLD",8572,"KRN",8994,"NM","B","VW REG ZIP",20)

"BLD",8572,"KRN","B",.4,.4)

"BLD",8572,"KRN","B",.401,.401)

"BLD",8572,"KRN","B",.402,.402)

"BLD",8572,"KRN","B",.403,.403)

"BLD",8572,"KRN","B",.5,.5)

"BLD",8572,"KRN","B",.84,.84)

"BLD",8572,"KRN","B",3.6,3.6)

"BLD",8572,"KRN","B",3.8,3.8)

"BLD",8572,"KRN","B",9.2,9.2)

"BLD",8572,"KRN","B",9.8,9.8)

"BLD",8572,"KRN","B",19,19)

"BLD",8572,"KRN","B",19.1,19.1)

"BLD",8572,"KRN","B",101,101)

"BLD",8572,"KRN","B",409.61,409.61)

"BLD",8572,"KRN","B",771,771)

"BLD",8572,"KRN","B",779.2,779.2)

"BLD",8572,"KRN","B",870,870)

"BLD",8572,"KRN","B",8989.51,8989.51)

"BLD",8572,"KRN","B",8989.52,8989.52)

"BLD",8572,"KRN","B",8994,8994)

"BLD",8572,"QDEF")
^^^^NO^^^^NO^^NO
"BLD",8572,"QUES",0)
^9.62^^
"BLD",8572,"REQB",0)
^9.611^^
"DATA",64850001,.081,0)
DUPLICATE STATUS^SX^0:NO UNRESOLVED DUPLICATES;1:CHECK DUPLICATE RECORDS FILE;^0;18
"DATA",64850001,.082,0)
PATIENT MERGED TO^P2'^DPT(^0;19
"DATA",64850001,.083,0)
CHECK FOR DUPLICATE^S^1:YES;^0;20
"DATA",64850001,.09,0)
SOCIAL SECURITY NUMBER^FXa^^0;9
"DATA",64850001,.0906,0)
PSEUDO SSN REASON^S^R:REFUSED TO PROVIDE;S:SSN UNKNOWN/FOLLOW-UP REQUIRED;N:NO SSN ASSIGNED;^SSN;1
"DATA",64850001,.0907,0)
SSN VERIFICATION STATUS^S^4:VERIFIED;2:INVALID;^SSN;2
"DATA",64850001,.096,0)
WHO ENTERED PATIENT^P200'I^VA(200,^0;15
"DATA",64850001,.097,0)
DATE ENTERED INTO FILE^DI^^0;16
"DATA",64850001,.098,0)
HOW WAS PATIENT ENTERED?^S^1:10-10T REGISTRATION;^0;17
"DATA",64850001,.1,0)
WARD LOCATION^FX^^.1;E1,30
"DATA",64850001,.101,0)
ROOM-BED^F^^.101;1
"DATA",64850001,.102,0)
CURRENT MOVEMENT^*P405'^DGPM(^.102;1
"DATA",64850001,.103,0)
TREATING SPECIALTY^P45.7'^DIC(45.7,^.103;1
"DATA",64850001,.104,0)
PROVIDER^*P200'^VA(200,^.104;1
"DATA",64850001,.1041,0)
ATTENDING PHYSICIAN^*P200'^VA(200,^.1041;1
"DATA",64850001,.105,0)
CURRENT ADMISSION^*P405'^DGPM(^.105;1
"DATA",64850001,.106,0)
LAST DMMS EPISODE NUMBER^NJ5,0^^.106;1
"DATA",64850001,.108,0)
CURRENT ROOM^P405.4'^DG(405.4,^.108;1
"DATA",64850001,.109,0)
EXCLUDE FROM FACILITY DIR^S^0:NO;1:YES;^.109;1
"DATA",64850001,.118,0)
ADDRESS CHANGE DT/TM^D^^.11;13
"DATA",64850001,.119,0)
ADDRESS CHANGE SOURCE^S^HEC:HEC;VAMC:VAMC;HBSC:HBSC;NCOA:NCOA;BVA:BVA;VAINS:VAINS;USPS:USPS;LACS:LACS;VOA:VOA;^.11;14
"DATA",64850001,.12,0)
ADDRESS CHANGE SITE^P4'^DIC(4,^.11;15
"DATA",64850001,.121,0)
BAD ADDRESS INDICATOR^*S^1:UNDELIVERABLE;2:HOMELESS;3:OTHER;4:ADDRESS NOT FOUND;^.11;16
"DATA",64850001,.12105,0)
TEMPORARY ADDRESS ACTIVE?^RSX^Y:YES;N:NO;^.121;9
"DATA",64850001,.122,0)
ADDRESS CHANGE USER^P200'^VA(200,^.11;17
"DATA",64850001,.1311,0)
CELLULAR NUMBER CHANGE SOURCE^S^HEC:HEC;VAMC:VAMC;HBSC:HBSC;VOA:VOA;^.13;10
"DATA",64850001,.13111,0)
CELLULAR NUMBER CHANGE SITE^P4'^DIC(4,^.13;11
"DATA",64850001,.132,0)
PHONE NUMBER [WORK]^Fa^^.13;2
"DATA",64850001,.135,0)
PAGER NUMBER^FX^^.13;5
"DATA",64850001,.136,0)
EMAIL ADDRESS CHANGE DT/TM^D^^.13;6
"DATA",64850001,.137,0)
EMAIL ADDRESS CHANGE SOURCE^S^HEC:HEC;VAMC:VAMC;HBSC:HBSC;VOA:VOA;^.13;7
"DATA",64850001,.138,0)
EMAIL ADDRESS CHANGE SITE^P4'^DIC(4,^.13;8
"DATA",64850001,.139,0)
CELLULAR NUMBER CHANGE DT/TM^D^^.13;9
"DATA",64850001,.14,0)
CURRENT MEANS TEST STATUS^P408.32'I^DG(408.32,^0;14
"DATA",64850001,.141,0)
CONFIDENTIAL ADDRESS CATEGORY^2.141S^^.14;0
"DATA",64850001,.14112,0)
CONFIDENTIAL ADDR CHANGE DT/TM^DX^^.141;12
"DATA",64850001,.14113,0)
CONFIDENTIAL ADDR CHANGE SITE^P4'^DIC(4,^.141;13
"DATA",64850001,.152,0)
INELIGIBLE DATE^DX^^.15;2
"DATA",64850001,.153,0)
MISSING PERSON DATE^DX^^.15;3
"DATA",64850001,.16,0)
MISSING OR INELIGIBLE^2.16A^^.16;0
"DATA",64850001,.1651,0)
INELIGIBLE TWX SOURCE^RSX^1:VAMC;2:REGIONAL OFFICE;3:RPC;^INE;1
"DATA",64850001,.1653,0)
INELIGIBLE TWX CITY^FX^^INE;3
"DATA",64850001,.1654,0)
INELIGIBLE TWX STATE^P5'X^DIC(5,^INE;4
"DATA",64850001,.1656,0)
INELIGIBLE VARO DECISION^FX^^INE;6
"DATA",64850001,.1657,0)
MISSING PERSON TWX SOURCE^S^1:VAMC;2:REGIONAL OFFICE;3:RPC;^INE;7
"DATA",64850001,.1658,0)
MISSING PERSON TWX CITY^F^^INE;8
"DATA",64850001,.1659,0)
MISSING PERSON TWX STATE^P5'^DIC(5,^INE;9
"DATA",64850001,.172,0)
FEE HOSPITAL I.D.^S^I:ISSUED;C:CANCELLED;^.17;2
"DATA",64850001,.181,0)
EMERGENCY RESPONSE INDICATOR^S^K:HURRICANE KATRINA;^.18;1
"DATA",64850001,.21012,0)
PRIMARY NOK CHANGE DATE/TIME^DX^^.212;1
"DATA",64850001,.211012,0)
SECONDARY NOK CHANGE DATE/TIME^DX^^.212;2
"DATA",64850001,.301,0)
SERVICE CONNECTED?^SXa^Y:YES;N:NO;^.3;1
"DATA",64850001,.3012,0)
SC AWARD DATE^DX^^.3;12
"DATA",64850001,.3013,0)
P&T EFFECTIVE DATE^DX^^.3;13
"DATA",64850001,.3014,0)
EFF. DATE COMBINED SC% EVAL.^DX^^.3;14
"DATA",64850001,.302,0)
SERVICE CONNECTED PERCENTAGE^NJ3,0Xa^^.3;2
"DATA",64850001,.3025,0)
RECEIVING VA DISABILITY?^SX^Y:YES;N:NO;U:UNKNOWN;^.3;11
"DATA",64850001,.303,0)
AMOUNT OF VA DISABILITY^NJ7,0X^^.3;3
"DATA",64850001,.304,0)
P&T^SX^Y:YES;N:NO;^.3;4
"DATA",64850001,.305,0)
UNEMPLOYABLE^S^Y:YES;N:NO;^.3;5
"DATA",64850001,.306,0)
MONETARY BEN. VERIFY DATE^DX^^.3;6
"DATA",64850001,.307,0)
INELIGIBLE REASON^FX^^.3;7
"DATA",64850001,.309,0)
AGENCY/ALLIED COUNTRY^*P35'X^DIC(35,^.3;9
"DATA",64850001,.31,0)
*CATEGORY OF BENEFICIARY^P45.82'X^DIC(45.82,^.3;10
"DATA",64850001,.31116,0)
DATE OF RETIREMENT^DX^^.311;16
"DATA",64850001,.313,0)
CLAIM NUMBER^FXOa^^.31;3
"DATA",64850001,.314,0)
CLAIM FOLDER LOCATION^*P4'X^DIC(4,^.31;4
"DATA",64850001,.3192,0)
COVERED BY HEALTH INSURANCE?^RS^Y:YES;N:NO;U:UNKNOWN;^.31;11
"DATA",64850001,.32101,0)
VIETNAM SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.321;1
"DATA",64850001,.32102,0)
AGENT ORANGE EXPOS. INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.321;2
"DATA",64850001,.32103,0)
RADIATION EXPOSURE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.321;3
"DATA",64850001,.32104,0)
VIETNAM FROM DATE^RDX^^.321;4
"DATA",64850001,.32105,0)
VIETNAM TO DATE^RDX^^.321;5
"DATA",64850001,.32107,0)
AGENT ORANGE REGISTRATION DATE^DX^^.321;7
"DATA",64850001,.32108,0)
AGENT ORANGE REPORTED TO C.O.^DX^^.321;8
"DATA",64850001,.32109,0)
AGENT ORANGE EXAM DATE^DX^^.321;9
"DATA",64850001,.3211,0)
AGENT ORANGE REGISTRATION #^NJ6,0X^^.321;10
"DATA",64850001,.32111,0)
RADIATION REGISTRATION DATE^DX^^.321;11
"DATA",64850001,.32115,0)
PROJ 112/SHAD^S^1:YES;0:NO;^.321;15
"DATA",64850001,.3212,0)
RADIATION EXPOSURE METHOD^SX^2:HIROSHIMA/NAGASAKI;3:ATMOSPHERIC NUCLEAR TESTING;4:H/N AND ATMOSPHERIC TESTING;5:UNDERGROUND NUCLEAR TESTING;6:EXPOSURE AT NUCLEAR FACILITY;7:OTHER;^.321;12
"DATA",64850001,.3213,0)
AGENT ORANGE EXPOSURE LOCATION^RSX^K:KOREAN DMZ;V:VIETNAM;O:OTHER;^.321;13
"DATA",64850001,.3214,0)
FILIPINO VETERAN PROOF^S^PP:US PASSPORT;BC:US BIRTH CERTIFICATE;BA:REPORT OF BIRTH ABROAD OF US CITIZEN;NA:VERIFICATION OF NATURALIZATION;PR:VERIFICATION OF PERMANENT RESIDENCY;VA:VA COMPENSATION AT FULL DOLLAR RATE;NO:NO PROOF;^.321;14
"DATA",64850001,.3215,0)
SERVICE [OEF OR OIF]^2.3215IS^^.3215;0
"DATA",64850001,.322,0)
SERVICE VERIFICATION DATE^DX^^.32;2
"DATA",64850001,.32201,0)
PERSIAN GULF SERVICE?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;10
"DATA",64850001,.322011,0)
PERSIAN GULF FROM DATE^RDX^^.322;11
"DATA",64850001,.322012,0)
PERSIAN GULF TO DATE^RDX^^.322;12
"DATA",64850001,.322013,0)
SOUTHWEST ASIA CONDITIONS?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;13
"DATA",64850001,.322014,0)
SW ASIA COND REGISTRATION DATE^DX^^.322;14
"DATA",64850001,.322015,0)
SW ASIA COND EXAM DATE^DX^^.322;15
"DATA",64850001,.322016,0)
SOMALIA SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;16
"DATA",64850001,.322017,0)
SOMALIA FROM DATE^RDX^^.322;17
"DATA",64850001,.322018,0)
SOMALIA TO DATE^RDX^^.322;18
"DATA",64850001,.322019,0)
YUGOSLAVIA SERVICE INDICATED?^SX^Y:YES;N:NO;U:UNKNOWN;^.322;19
"DATA",64850001,.32202,0)
YUGOSLAVIA FROM DATE^RDX^^.322;20
"DATA",64850001,.322021,0)
YUGOSLAVIA TO DATE^RDX^^.322;21
"DATA",64850001,.3221,0)
LEBANON SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;1
"DATA",64850001,.3222,0)
LEBANON FROM DATE^RDX^^.322;2
"DATA",64850001,.3223,0)
LEBANON TO DATE^RDX^^.322;3
"DATA",64850001,.3224,0)
GRENADA SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;4
"DATA",64850001,.3225,0)
GRENADA FROM DATE^RDX^^.322;5
"DATA",64850001,.3226,0)
GRENADA TO DATE^RDX^^.322;6
"DATA",64850001,.3227,0)
PANAMA SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;7
"DATA",64850001,.3228,0)
PANAMA FROM DATE^RDX^^.322;8
"DATA",64850001,.3229,0)
PANAMA TO DATE^RDX^^.322;9
"DATA",64850001,.323,0)
PERIOD OF SERVICE^*P21'Xa^DIC(21,^.32;3
"DATA",64850001,.324,0)
SERVICE DISCHARGE TYPE [LAST]^RP25'X^DIC(25,^.32;4
"DATA",64850001,.325,0)
SERVICE BRANCH [LAST]^P23'X^DIC(23,^.32;5
"DATA",64850001,.326,0)
SERVICE ENTRY DATE [LAST]^RDX^^.32;6
"DATA",64850001,.327,0)
SERVICE SEPARATION DATE [LAST]^RDX^^.32;7
"DATA",64850001,.328,0)
SERVICE NUMBER [LAST]^FX^^.32;8
"DATA",64850001,.3285,0)
SERVICE SECOND EPISODE?^RSX^Y:YES;N:NO;^.32;19
"DATA",64850001,.329,0)
SERVICE DISCHARGE TYPE [NTL]^RP25'X^DIC(25,^.32;9
"DATA",64850001,.3291,0)
SERVICE BRANCH [NTL]^P23'X^DIC(23,^.32;10
"DATA",64850001,.32911,0)
SERVICE COMPONENT [LAST]^*S^R:REGULAR;V:ACTIVATED RESERVE;G:ACTIVATED NG;^.3291;1
"DATA",64850001,.32912,0)
SERVICE COMPONENT [NTL]^*SX^R:REGULAR;V:ACTIVATED RESERVE;G:ACTIVATED NG;^.3291;2
"DATA",64850001,.32913,0)
SERVICE COMPONENT [NNTL]^*SX^R:REGULAR;V:ACTIVATED RESERVE;G:ACTIVATED NG;^.3291;3
"DATA",64850001,.3292,0)
SERVICE ENTRY DATE [NTL]^RDX^^.32;11
"DATA",64850001,.3293,0)
SERVICE SEPARATION DATE [NTL]^RDX^^.32;12
"DATA",64850001,.3294,0)
SERVICE NUMBER [NTL]^FX^^.32;13
"DATA",64850001,.32945,0)
SERVICE THIRD EPISODE?^RSX^Y:YES;N:NO;^.32;20
"DATA",64850001,.3295,0)
SERVICE DISCHARGE TYPE [NNTL]^RP25'X^DIC(25,^.32;14
"DATA",64850001,.3296,0)
SERVICE BRANCH [NNTL]^P23'X^DIC(23,^.32;15
"DATA",64850001,.3297,0)
SERVICE ENTRY DATE [NNTL]^RDX^^.32;16
"DATA",64850001,.3298,0)
SERVICE SEPARATION DATE [NNTL]^RDX^^.32;17
"DATA",64850001,.3299,0)
SERVICE NUMBER [NNTL]^FX^^.32;18
"DATA",64850001,.3412,0)
DESIGNEE CHANGE DATE/TIME^DX^^.332;3
"DATA",64850001,.352,0)
DEATH ENTERED BY^P200'^VA(200,^.35;2
"DATA",64850001,.353,0)
SOURCE OF NOTIFICATION^S^1:INPATIENT AT VAMC;2:NON-VA MEDICAL FACILITY;3:DEATH CERTIFICATE ON FILE;4:VBA;5:VA INSURANCE;6:SSA;7:NCA;8:NEXT OF KIN/FAMILY/FRIEND;9:OTHER;^.35;3
"DATA",64850001,.355,0)
LAST EDITED BY^P200'^VA(200,^.35;5
"DATA",64850001,.3601,0)
COLLATERAL SPONSOR'S NAME^R*P2'^DPT(^.36;11
"DATA",64850001,.3602,0)
MILITARY DISABILITY RETIREMENT^SX^1:YES;0:NO;^.36;12
"DATA",64850001,.3603,0)
DISCHARGE DUE TO DISABILITY^SX^1:YES;0:NO;^.36;13
"DATA",64850001,.361,0)
PRIMARY ELIGIBILITY CODE^*P8'Xa^DIC(8,^.36;1
"DATA",64850001,.3611,0)
ELIGIBILITY STATUS^SX^P:PENDING VERIFICATION;R:PENDING RE-VERIFICATION;V:VERIFIED;^.361;1
"DATA",64850001,.3612,0)
ELIGIBILITY STATUS DATE^DX^^.361;2
"DATA",64850001,.3613,0)
ELIGIBILITY VERIF. SOURCE^S^H:HEC;V:VISTA;^.361;3
"DATA",64850001,.3614,0)
ELIGIBILITY INTERIM RESPONSE^DX^^.361;4
"DATA",64850001,.3615,0)
ELIGIBILITY VERIF. METHOD^FX^^.361;5
"DATA",64850001,.3616,0)
ELIGIBILITY STATUS ENTERED BY^P200'^VA(200,^.361;6
"DATA",64850001,.3617,0)
USER ENROLLEE VALID THROUGH^DX^^.361;7
"DATA",64850001,.3618,0)
USER ENROLLEE SITE^P4'^DIC(4,^.361;8
"DATA",64850001,.362,0)
DISABILITY RET. FROM MILITARY?^RSX^0:NO;1:YES, RECEIVING MILITARY RETIREMENT;2:YES, RECEIVING MILITARY RETIREMENT IN LIEU OF VA COMPENSATION;3:UNKNOWN;^.36;2
"DATA",64850001,.36205,0)
RECEIVING A&A BENEFITS?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;12
"DATA",64850001,.3621,0)
AMOUNT OF AID & ATTENDANCE^NJ10,2X^^.362;1
"DATA",64850001,.36215,0)
RECEIVING HOUSEBOUND BENEFITS?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;13
"DATA",64850001,.3622,0)
AMOUNT OF HOUSEBOUND^NJ10,2X^^.362;2
"DATA",64850001,.36225,0)
RECEIVING SOCIAL SECURITY?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;15
"DATA",64850001,.36235,0)
RECEIVING A VA PENSION?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;14
"DATA",64850001,.3624,0)
AMOUNT OF VA PENSION^NJ10,2X^^.362;4
"DATA",64850001,.3625,0)
*AMOUNT OF MILITARY RETIREMENT^NJ10,2X^^.362;5
"DATA",64850001,.36255,0)
RECEIVING MILITARY RETIREMENT?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;16
"DATA",64850001,.3626,0)
AMOUNT OF GI INSURANCE^NJ8,2X^^.362;6
"DATA",64850001,.36265,0)
GI INSURANCE POLICY?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;17
"DATA",64850001,.36275,0)
RECEIVING SUP. SECURITY (SSI)?^S^Y:YES;N:NO;U:UNKNOWN;^.362;19
"DATA",64850001,.3628,0)
AMOUNT OF OTHER RETIREMENT^NJ8,2X^^.362;8
"DATA",64850001,.36285,0)
TYPE OF OTHER RETIREMENT^SX^B:BLACK LUNG;M:MILITARY;C:CIVIL;R:RAILROAD;O:OTHER;X:COMBINATIONS OF TYPES;^.362;18
"DATA",64850001,.3629,0)
AMOUNT OF OTHER INCOME^NJ8,2X^^.362;9
"DATA",64850001,.36295,0)
TOTAL ANNUAL VA CHECK AMOUNT^NJ8,2X^^.362;20
"DATA",64850001,.364,0)
PRIMARY SHORT ID^F^^.36;4
"DATA",64850001,.368,0)
SERVICE DENTAL INJURY?^S^Y:YES;N:NO;^.36;8
"DATA",64850001,.369,0)
SERVICE TEETH EXTRACTED?^S^Y:YES;N:NO;^.36;9
"DATA",64850001,.37,0)
DATE OF DENTAL TREATMENT^2.11D^^.37;0
"DATA",64850001,.3721,0)
RATED DISABILITIES (VA)^2.04P^^.372;0
"DATA",64850001,.3731,0)
SERVICE CONNECTED CONDITIONS^2.05A^^.373;0
"DATA",64850001,.381,0)
ELIGIBLE FOR MEDICAID?^RS^1:YES;0:NO;^.38;1
"DATA",64850001,.382,0)
DATE MEDICAID LAST ASKED^RD^^.38;2
"DATA",64850001,.39,0)
VETERAN CATASTROPHICALLY DISABLED?^S^Y:YES;N:NO;^.39;6
"DATA",64850001,.391,0)
DECIDED BY^F^^.39;1
"DATA",64850001,.392,0)
DATE OF DECISION^DX^^.39;2
"DATA",64850001,.393,0)
FACILITY MAKING DETERMINATION^P4'^DIC(4,^.39;3
"DATA",64850001,.394,0)
REVIEW DATE^D^^.39;4
"DATA",64850001,.395,0)
METHOD OF DETERMINATION^S^2:MEDICAL RECORD REVIEW;3:PHYSICAL EXAMINATION;^.39;5
"DATA",64850001,.3951,0)
DATE VETERAN REQUESTED CD EVAL^D^^.39;7
"DATA",64850001,.3952,0)
DATE FACILITY INITIATED REVIEW^D^^.39;8
"DATA",64850001,.3953,0)
DATE VETERAN WAS NOTIFIED^D^^.39;9
"DATA",64850001,.396,0)
CD STATUS DIAGNOSES^2.396P^^.396;0
"DATA",64850001,.397,0)
CD STATUS PROCEDURES^2.397P^^.397;0
"DATA",64850001,.398,0)
CD STATUS CONDITIONS^2.398P^^.398;0
"DATA",64850001,.399,0)
CD HISTORY DATE^2.399DA^^.399;0
"DATA",64850001,.525,0)
POW STATUS INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.52;5
"DATA",64850001,.526,0)
POW CONFINEMENT LOCATION^RP22'X^DIC(22,^.52;6
"DATA",64850001,.527,0)
POW FROM DATE^RDX^^.52;7
"DATA",64850001,.528,0)
POW TO DATE^RDX^^.52;8
"DATA",64850001,.529,0)
POW STATUS VERIFIED^D^^.52;9
"DATA",64850001,.5291,0)
COMBAT SERVICE INDICATED?^RSX^Y:YES;N:NO;^.52;11
"DATA",64850001,.5292,0)
COMBAT SERVICE LOCATION^RP22'X^DIC(22,^.52;12
"DATA",64850001,.5293,0)
COMBAT FROM DATE^RDX^^.52;13
"DATA",64850001,.5294,0)
COMBAT TO DATE^RDX^^.52;14
"DATA",64850001,.5295,0)
COMBAT VETERAN END DATE^D^^.52;15
"DATA",64850001,.5296,0)
CV DATE EDITED^D^^.52;16
"DATA",64850001,.531,0)
CURRENT PH INDICATOR^SX^Y:YES;N:NO;^.53;1
"DATA",64850001,.532,0)
CURRENT PURPLE HEART STATUS^S^1:PENDING;2:IN PROCESS;3:CONFIRMED;^.53;2
"DATA",64850001,.533,0)
CURRENT PURPLE HEART REMARKS^S^1:UNACCEPTABLE DOCUMENTATION;2:NO DOCUMENTATION REC'D;3:ENTERED IN ERROR;4:UNSUPPORTED PURPLE HEART;5:VAMC;6:UNDELIVERABLE MAIL;^.53;3
"DATA",64850001,.535,0)
PH DIVISION^P4'^DIC(4,^.53;4
"DATA",64850001,.6,0)
TEST PATIENT INDICATOR^SI^1:YES;0:NO;^0;21
"DATA",64850001,1.01,0)
NAME COMPONENTS
"DATA",64850001,2.0361,0)
PATIENT ELIGIBILITIES
"DATA",64850001,27.01,0)
CURRENT ENROLLMENT^P27.11'I^DGEN(27.11,^ENR;1
"DATA",64850001,53,0)
*REACTIONS^S^Y:YES;N:NO;^PI;1
"DATA",64850001,57.1,0)
*HEIGHT(cm)^NJ3,0^^57;1
"DATA",64850001,57.2,0)
*WEIGHT(kg)^NJ3,0^^57;2
"DATA",64850001,57.4,0)
SPINAL CORD INJURY^S^1:PARAPLEGIA-TRAUMATIC;2:QUADRIPLEGIA-TRAUMATIC;3:PARAPLEGIA-NONTRAUMATIC;4:QUADRIPLEGIA-NONTRAUMATIC;X:NOT APPLICABLE;^57;4
"DATA",64850001,63,0)
LABORATORY REFERENCE^IP63X^LR(^LR;1
"DATA",64850001,67,0)
LAB REFERRAL REF^P67'X^LRT(67,^LRT;1
"DATA",64850001,148,0)
CNH CURRENT^S^Y:YES;N:NO;^NHC;1
"DATA",64850001,220,0)
DENTAL CLASSIFICATION^P220.2'^DIC(220.2,^DENT;1
"DATA",64850001,220.1,0)
DENTAL ELIGIBILITY EXPIRATION^D^^DENT;2
"DATA",64850001,361,0)
PATIENT ELIGIBILITIES^2.0361IP^^E;0
"DATA",64850001,391,0)
TYPE^P391'a^DG(391,^TYPE;1
"DATA",64850001,401.3,0)
CONDITION^S^S:SERIOUSLY ILL;^DAC;1
"DATA",64850001,401.4,0)
DATE ENTERED ON SI LIST^RDX^^DAC;2
"DATA",64850001,534,0)
PH DATE/TIME UPDATED^2.0534DA^^PH;0
"DATA",64850001,991.01,0)
INTEGRATION CONTROL NUMBER^NJ12,0Xa^^MPI;1
"DATA",64850001,991.02,0)
ICN CHECKSUM^Fa^^MPI;2
"DATA",64850001,991.03,0)
COORDINATING MASTER OF RECORD^P4'a^DIC(4,^MPI;3
"DATA",64850001,991.04,0)
LOCALLY ASSIGNED ICN^Sa^1:YES;^MPI;4
"DATA",64850001,991.05,0)
SUBSCRIPTION CONTROL NUMBER^P774'Ia^HLS(774,^MPI;5
"DATA",64850001,991.06,0)
CMOR ACTIVITY SCORE^NJ7,0a^^MPI;6
"DATA",64850001,991.07,0)
SCORE CALCULATION DATE^Da^^MPI;7
"DATA",64850001,992,0)
ICN HISTORY^2.0992A^^MPIFHIS;0
"DATA",64850001,993,0)
CMOR HISTORY^2.0993A^^MPICMOR;0
"DATA",64850001,1010.15,0)
RECEIVED VA CARE PREVIOUSLY?^RS^Y:YES;N:NO;^1010.15;5
"DATA",64850001,1010.151,0)
MOST RECENT DATE OF CARE^DX^^1010.15;1
"DATA",64850001,1010.1511,0)
APPOINTMENT REQUEST DATE^D^^1010.15;11
"DATA",64850001,1010.152,0)
MOST RECENT LOCATION OF CARE^P4'^DIC(4,^1010.15;2
"DATA",64850001,1010.153,0)
2ND MOST RECENT DATE OF CARE^DX^^1010.15;3
"DATA",64850001,1010.154,0)
2ND MOST RECENT LOCATION^P4'^DIC(4,^1010.15;4
"DATA",64850001,1010.156,0)
MOST RECENT 1010EZ^P712'I^EAS(712,^1010.15;6
"DATA",64850001,1010.157,0)
COMBAT INDICATED ON 1010EZ^S^0:NO;1:YES;^1010.15;7
"DATA",64850001,1010.158,0)
DISABILITY DISCHARGE ON 1010EZ^S^0:NO;1:YES;^1010.15;8
"DATA",64850001,1010.159,0)
APPOINTMENT REQUEST ON 1010EZ^S^0:NO;1:YES;^1010.15;9
"DATA",64850001,1010.161,0)
APPOINTMENT REQUEST STATUS^S^C:CANCELLED;E:EWL;F:FILLED;I:IN PROCESS/VETERAN CONTACTED;^1010.16;1
"DATA",64850001,1010.162,0)
DATE STATUS LAST EDITED^D^^1010.16;2
"DATA",64850001,1010.163,0)
APPOINTMENT REQUEST COMMENT^F^^1010.16;3
"DATA",64850001,1010.164,0)
DATE COMMENT LAST EDITED^D^^1010.16;4
"DATA",64850001,1100.02,0)
FFF ENTERED BY^P200'^VA(200,^FFP;2
"DATA",64850001,1100.03,0)
FFF DATE ENTERED^D^^FFP;3
"DATA",64850001,1100.04,0)
FFF REMOVED BY^P200'^VA(200,^FFP;4
"DATA",64850001,1100.05,0)
FFF DATE REMOVED^D^^FFP;5
"DATA",64850001,1100.09,0)
FFF REMOVAL REMARKS^F^^FFP;9
"DATA",64850001,1900,0)
APPOINTMENT^2.98P^^S;0
"DATA",64850001,1901,0)
VETERAN (Y/N)?^SXa^Y:YES;N:NO;^VET;1
"DATA",64850001,1903,0)
ARCHIVED DATA^2.12SA^^ARCH;0
"DATA",64850001,11500.01,0)
INITIAL ODS TREATMENT RECEIVED^D^^ODS;1
"DATA",64850001,11500.02,0)
RECALLED TO ACTIVE DUTY^S^0:NO;1:NATIONAL GUARD;2:RESERVES;^ODS;2
"DATA",64850001,11500.03,0)
RANK^*P25002.1'^DIC(25002.1,^ODS;3
"DATA",64850001,19900,0)
ALTERNATE PHONE NUMBER^F^^19900;1
"DATA",64850001,19902,0)
IS PATIENT A VETERAN^S^Y:YES;N:NO;^19900;3
"DATA",64850001,19905,0)
YEAR ARRIVED IN COUNTRY^NJ4,0^^19900;6
"DATA",64850001,537025,0)
NETWORK IDENTIFIER^F^^537025;1
"DATA",64850002,1,0)
ALIAS^1^DEMOG
"DATA",64850002,1,"M",0)
^64850002.01A
"DATA",64850002,1,"M",1,0)
ALIAS^.01;2.01^
"DATA",64850002,1,"M",2,0)
ALIAS SSN^1;2.01^
"DATA",64850002,2,0)
AMOUNT OF SSI^.3627^MB
"DATA",64850002,3,0)
CITY^.114^DEMOG
"DATA",64850002,4,0)
CONFIDENTIAL ADDR COUNTRY^.14116^CONFIDENTIAL
"DATA",64850002,5,0)
CONFIDENTIAL ADDR POSTAL CODE^.14115^CONFIDENTIAL
"DATA",64850002,6,0)
CONFIDENTIAL ADDR PROVINCE^.14114^CONFIDENTIAL
"DATA",64850002,7,0)
CONFIDENTIAL ADDRESS ACTIVE?^.14105^CONFIDENTIAL
"DATA",64850002,8,0)
CONFIDENTIAL ADDRESS CITY^.1414^CONFIDENTIAL
"DATA",64850002,9,0)
CONFIDENTIAL ADDRESS COUNTY^.14111^CONFIDENTIAL
"DATA",64850002,10,0)
CONFIDENTIAL ADDRESS STATE^.1415^CONFIDENTIAL
"DATA",64850002,11,0)
CONFIDENTIAL ADDRESS ZIP CODE^.1416^CONFIDENTIAL
"DATA",64850002,12,0)
CONFIDENTIAL END DATE^.1418^CONFIDENTIAL
"DATA",64850002,13,0)
CONFIDENTIAL PHONE NUMBER^.1315^CONFIDENTIAL
"DATA",64850002,14,0)
CONFIDENTIAL START DATE^.1417^CONFIDENTIAL
"DATA",64850002,15,0)
CONFIDENTIAL STREET [LINE 1]^.1411^CONFIDENTIAL
"DATA",64850002,16,0)
CONFIDENTIAL STREET [LINE 2]^.1412^CONFIDENTIAL
"DATA",64850002,17,0)
CONFIDENTIAL STREET [LINE 3]^.1413^CONFIDENTIAL
"DATA",64850002,18,0)
COUNTRY^.1173^DEMOG
"DATA",64850002,19,0)
COUNTY^.117^DEMOG
"DATA",64850002,20,0)
Cell Phone^.134^DEMOG
"DATA",64850002,21,0)
D-CITY^.346^D1
"DATA",64850002,22,0)
D-DESIGNEE SAME AS NOK?^.3405^D1
"DATA",64850002,23,0)
D-PHONE NUMBER^.349^D1
"DATA",64850002,24,0)
D-RELATIONSHIP TO PATIENT^.342^D1
"DATA",64850002,25,0)
D-STATE^.347^D1
"DATA",64850002,26,0)
D-STREET ADDRESS [LINE 1]^.343^D1
"DATA",64850002,27,0)
D-STREET ADDRESS [LINE 2]^.344^D1
"DATA",64850002,28,0)
D-STREET ADDRESS [LINE 3]^.345^D1
"DATA",64850002,29,0)
D-WORK PHONE NUMBER^.34011^D1
"DATA",64850002,30,0)
D-ZIP CODE^.348^D1
"DATA",64850002,31,0)
D-ZIP+4^.2202^D1
"DATA",64850002,32,0)
DATE OF DEATH^.351^DEMOG
"DATA",64850002,33,0)
DATE OF DEATH LAST UPDATED^.354^DEMOG
"DATA",64850002,34,0)
DISPOSITION LOG-IN DATE/TIME^1000^VISIT
"DATA",64850002,34,"M",0)
^64850002.01A
"DATA",64850002,34,"M",1,0)
A-ADDRESS 1^31;2.101
"DATA",64850002,34,"M",2,0)
A-ADDRESS 2^32;2.101
"DATA",64850002,34,"M",3,0)
A-ADDRESS 3^33;2.101
"DATA",64850002,34,"M",4,0)
A-CITY^34;2.101
"DATA",64850002,34,"M",5,0)
A-PHONE^37;2.101
"DATA",64850002,34,"M",6,0)
A-STATE^35;2.101
"DATA",64850002,34,"M",7,0)
A-ZIP CODE^36;2.101
"DATA",64850002,34,"M",8,0)
A-ZIP+4^38;2.101
"DATA",64850002,34,"M",9,0)
ACTIVE^50;2.101
"DATA",64850002,34,"M",10,0)
ATTORNEY'S NAME^30;2.101
"DATA",64850002,34,"M",11,0)
DESCRIPTION OF INCIDENT^10;2.101
"DATA",64850002,34,"M",12,0)
DISPOSITION^6;2.101
"DATA",64850002,34,"M",13,0)
FACILITY APPLYING TO^3;2.101
"DATA",64850002,34,"M",14,0)
FILED AGAINST INJURING PARTY^26;2.101
"DATA",64850002,34,"M",15,0)
INJURING PARTIES INSURANCE^25;2.101
"DATA",64850002,34,"M",16,0)
INJURY CAUSED BY^24;2.101
"DATA",64850002,34,"M",17,0)
LOG IN DATE/TIME^.01;2.101
"DATA",64850002,34,"M",18,0)
LOG OUT DATE TIME^5;2.101
"DATA",64850002,34,"M",19,0)
NEED RELATED TO AN ACCIDENT^23;2.101
"DATA",64850002,34,"M",20,0)
NEED RELATED TO OCCUPATION^20;2.101
"DATA",64850002,34,"M",21,0)
OUTPATIENT ENCOUNTER^18;2.101
"DATA",64850002,34,"M",22,0)
REASON FOR LATE DISPOSITION^8;2.101
"DATA",64850002,34,"M",23,0)
REGISTRATION ELIGIBILITY CODE^13;2.101
"DATA",64850002,34,"M",24,0)
STATUS^1;2.101
"DATA",64850002,34,"M",25,0)
TYPE OF BENEFIT APPLIED FOR^2;2.101
"DATA",64850002,34,"M",26,0)
TYPE OF CARE APPLIED FOR^2.1;2.101
"DATA",64850002,34,"M",27,0)
WORKMEN'S COMP CLAIM FILED^21;2.101
"DATA",64850002,34,"M",28,0)
WORKMEN'S COMP CLAIM NUMBER^22;2.101
"DATA",64850002,35,0)
E-CITY^.336^EC1
"DATA",64850002,36,0)
E-CONTACT CHANGE DATE/TIME^.33012^EC1
"DATA",64850002,37,0)
E-EMER. CONTACT SAME AS NOK?^.3305^EC1
"DATA",64850002,38,0)
E-NAME^.331^EC1
"DATA",64850002,39,0)
E-PHONE NUMBER^.339^EC1
"DATA",64850002,40,0)
E-RELATIONSHIP TO PATIENT^.332^EC1
"DATA",64850002,41,0)
E-STATE^.337^EC1
"DATA",64850002,42,0)
E-STREET ADDRESS [LINE 1]^.333^EC1
"DATA",64850002,43,0)
E-STREET ADDRESS [LINE 2]^.334^EC1
"DATA",64850002,44,0)
E-STREET ADDRESS [LINE 3]^.335^EC1
"DATA",64850002,45,0)
E-WORK PHONE NUMBER^.33011^EC1
"DATA",64850002,46,0)
E-ZIP CODE^.338^EC1
"DATA",64850002,47,0)
E-ZIP+4^.2201^EC1
"DATA",64850002,48,0)
E2-CITY^.3316^EC2
"DATA",64850002,49,0)
E2-CONTACT CHANGE DATE/TIME^.33112^EC2
"DATA",64850002,50,0)
E2-NAME OF SECONDARY CONTACT^.3311^EC2
"DATA",64850002,51,0)
E2-PHONE NUMBER^.3319^EC2
"DATA",64850002,52,0)
E2-RELATIONSHIP TO PATIENT^.3312^EC2
"DATA",64850002,53,0)
E2-STATE^.3317^EC2
"DATA",64850002,54,0)
E2-STREET ADDRESS [LINE 1]^.3313^EC2
"DATA",64850002,55,0)
E2-STREET ADDRESS [LINE 2]^.3314^EC2
"DATA",64850002,56,0)
E2-STREET ADDRESS [LINE 3]^.3315^EC2
"DATA",64850002,57,0)
E2-WORK PHONE NUMBER^.331011^EC2
"DATA",64850002,58,0)
E2-ZIP CODE^.3318^EC2
"DATA",64850002,59,0)
E2-ZIP+4^.2204^EC2
"DATA",64850002,60,0)
EMAIL ADDRESS^.133^DEMOG
"DATA",64850002,61,0)
EMERGENCY CONTACT^.331^EC1
"DATA",64850002,62,0)
EMERGENCY CONTACT-2^.3311^EC2
"DATA",64850002,63,0)
EMPLOYER CITY^.3116^EM1
"DATA",64850002,64,0)
EMPLOYER NAME^.3111^EM1
"DATA",64850002,65,0)
EMPLOYER PHONE NUMBER^.3119^EM1
"DATA",64850002,66,0)
EMPLOYER STATE^.3117^EM1
"DATA",64850002,67,0)
EMPLOYER STREET [LINE 1]^.3113^EM1
"DATA",64850002,68,0)
EMPLOYER STREET [LINE 2]^.3114^EM1
"DATA",64850002,69,0)
EMPLOYER STREET [LINE 3]^.3115^EM1
"DATA",64850002,70,0)
EMPLOYER ZIP CODE^.3118^EM1
"DATA",64850002,71,0)
EMPLOYER ZIP+4^.2205^EM1
"DATA",64850002,72,0)
EMPLOYMENT STATUS^.31115^EM1
"DATA",64850002,73,0)
END DATE OF TEMP ADDRESS^.1218^TAD
"DATA",64850002,74,0)
ENROLLMENT CLINIC^3^ENROLL
"DATA",64850002,74,"M",0)
2.001P^^^
"DATA",64850002,74,"M",1,0)
CURRENT STATUS^2;2.001
"DATA",64850002,74,"M",2,0)
ENROLLMENT CLINIC^.01;2.001
"DATA",64850002,74,"M",3,0)
ENROLLMENT DATA^1;2.001
"DATA",64850002,74,"M",3,"MM",0)
2.011DA^^^
"DATA",64850002,74,"M",3,"MM",1,0)
DATE OF ENROLLMENT^3;2.011
"DATA",64850002,74,"M",3,"MM",2,0)
OPT OR AC^1;2.011
"DATA",64850002,74,"M",3,"MM",3,0)
DATE OF DISCHARGE^3;2.011
"DATA",64850002,74,"M",3,"MM",4,0)
REASON FOR DISCHARGE^4;2.011
"DATA",64850002,74,"M",3,"MM",5,0)
REVIEW DATE^5;2.011
"DATA",64850002,75,0)
ETHNICITY INFORMATION^6^DEMOG
"DATA",64850002,75,"M",0)
2.06PA^^
"DATA",64850002,75,"M",1,0)
ETHNICITY INFORMATION^.01;2.06
"DATA",64850002,76,0)
Email Address^.133^DEMOG
"DATA",64850002,77,0)
FATHER'S COUNTRY OF BIRTH^19904^DEMOG
"DATA",64850002,78,0)
FATHER'S NAME^.2401^DEMOG
"DATA",64850002,79,0)
FUGITIVE FELON FLAG^1100.01^FLAG
"DATA",64850002,80,0)
GOVERNMENT AGENCY^.3112^GOV
"DATA",64850002,81,0)
HEALTH RECORD NO.^64850001^DEMOG
"DATA",64850002,82,0)
INSURANCE TYPE^.3121^II
"DATA",64850002,82,"M",0)
2.312IPA^^
"DATA",64850002,82,"M",1,0)
COMMENT - PATIENT POLICY^1.08;2.312
"DATA",64850002,82,"M",2,0)
COORDINATION OF BENEFITS^.2;2.312
"DATA",64850002,82,"M",3,0)
DATE ENTERED^1.01;2.312
"DATA",64850002,82,"M",4,0)
DATE LAST EDITED^1.05;2.312
"DATA",64850002,82,"M",5,0)
DATE LAST VERIFIED^1.03;2.312
"DATA",64850002,82,"M",6,0)
DATE OF SOURCE OF INFORMATION^1.1;2.312
"DATA",64850002,82,"M",7,0)
EFFECTIVE DATE OF POLICY^8;2.312
"DATA",64850002,82,"M",8,0)
EIV AUTO-UPDATE^4.04;2.312
"DATA",64850002,82,"M",9,0)
ELIGIBILITY/BENEFIT^60;2.312
"DATA",64850002,82,"M",10,0)
EMPLOY CLAIM ST ADDRESS LINE 2^2.03;2.312
"DATA",64850002,82,"M",11,0)
EMPLOY CLAIM ST ADDRESS LINE 3^2.04;2.312
"DATA",64850002,82,"M",12,0)
EMPLOYER CLAIMS CITY^2.05;2.312
"DATA",64850002,82,"M",13,0)
EMPLOYER CLAIMS PHONE^2.08;2.312
"DATA",64850002,82,"M",14,0)
EMPLOYER CLAIMS STATE^2.06;2.312
"DATA",64850002,82,"M",15,0)
EMPLOYER CLAIMS STREET ADDRESS^2.02;2.312
"DATA",64850002,82,"M",16,0)
EMPLOYER CLAIMS ZIP CODE^2.07;2.312
"DATA",64850002,82,"M",17,0)
EMPLOYMENT STATUS^2.11;2.312
"DATA",64850002,82,"M",18,0)
ENTERED BY^1.02;2.312
"DATA",64850002,82,"M",19,0)
ESGHP^2.1;2.312
"DATA",64850002,82,"M",20,0)
GROUP PLAN^.18;2.312
"DATA",64850002,82,"M",21,0)
INSURANCE EXPIRATION DATE^3;2.312
"DATA",64850002,82,"M",22,0)
INSURANCE NUMBER^1;2.312
"DATA",64850002,82,"M",23,0)
INSURANCE TYPE^.01;2.312
"DATA",64850002,82,"M",24,0)
INSURED'S BRANCH^3.02;2.312
"DATA",64850002,82,"M",25,0)
INSURED'S CITY^3.08;2.312
"DATA",64850002,82,"M",26,0)
INSURED'S DOB^3.01;2.312
"DATA",64850002,82,"M",27,0)
INSURED'S PHONE^3.11;2.312
"DATA",64850002,82,"M",28,0)
INSURED'S RANK^3.03;2.312
"DATA",64850002,82,"M",29,0)
INSURED'S SEX^3.12;2.312
"DATA",64850002,82,"M",30,0)
INSURED'S SSN^3.05;2.312
"DATA",64850002,82,"M",31,0)
INSURED'S STATE^3.09;2.312
"DATA",64850002,82,"M",32,0)
INSURED'S STREET 1^3.06;2.312
"DATA",64850002,82,"M",33,0)
INSURED'S STREET 2^3.07;2.312
"DATA",64850002,82,"M",34,0)
INSURED'S ZIP^3.1;2.312
"DATA",64850002,82,"M",35,0)
LAST EDITED BY^1.06;2.312
"DATA",64850002,82,"M",36,0)
NAME OF INSURED^17;2.312
"DATA",64850002,82,"M",37,0)
NEW GROUP NAME^20;2.312
"DATA",64850002,82,"M",38,0)
NEW GROUP NUMBER^21;2.312
"DATA",64850002,82,"M",39,0)
PATIENT ID^5.01;2.312
"DATA",64850002,82,"M",40,0)
PATIENT'S SEC QUALIFIER^1
"DATA",64850002,82,"M",41,0)
PATIENT'S SEC QUALIFIER^2
"DATA",64850002,82,"M",42,0)
PATIENT'S SEC QUALIFIER^3
"DATA",64850002,82,"M",43,0)
PATIENT'S SECONDARY ID^1
"DATA",64850002,82,"M",44,0)
PATIENT'S SECONDARY ID^2
"DATA",64850002,82,"M",45,0)
PATIENT'S SECONDARY ID^3
"DATA",64850002,82,"M",46,0)
POLICY NOT BILLABLE^3.04;2.312
"DATA",64850002,82,"M",47,0)
PRIMARY CARE PROVIDER^4.01;2.312
"DATA",64850002,82,"M",48,0)
PRIMARY PROVIDER PHONE^4.02;2.312
"DATA",64850002,82,"M",49,0)
PT. RELATIONSHIP - HIPAA^4.03;2.312
"DATA",64850002,82,"M",50,0)
PT. RELATIONSHIP TO INSURED^16;2.312
"DATA",64850002,82,"M",51,0)
RETIREMENT DATE^2.12;2.312
"DATA",64850002,82,"M",52,0)
SEND BILL TO EMPLOYER^2.01;2.312
"DATA",64850002,82,"M",53,0)
SOURCE OF INFORMATION^1.09;2.312
"DATA",64850002,82,"M",54,0)
SUBSCRIBER ID^1;2.312
"DATA",64850002,82,"M",55,0)
SUBSCRIBER'S EMPLOYER NAME^2.015;2.312
"DATA",64850002,82,"M",56,0)
SUBSCRIBER'S SEC ID^1
"DATA",64850002,82,"M",57,0)
SUBSCRIBER'S SEC ID^2
"DATA",64850002,82,"M",58,0)
SUBSCRIBER'S SEC ID^3
"DATA",64850002,82,"M",59,0)
SUBSCRIBER'S SEC QUALIFIER^1
"DATA",64850002,82,"M",60,0)
SUBSCRIBER'S SEC QUALIFIER^2
"DATA",64850002,82,"M",61,0)
SUBSCRIBER'S SEC QUALIFIER^3
"DATA",64850002,82,"M",62,0)
VERIFIED BY^1.04;2.312
"DATA",64850002,82,"M",63,0)
WHOSE INSURANCE^6;2.312
"DATA",64850002,83,0)
INTERPRETER LANGUAGE^19906^DEMOG
"DATA",64850002,83,"M",0)
2.019906P^^
"DATA",64850002,83,"M",1,0)
INTERPRETER LANGUAGE^.01;2.019906
"DATA",64850002,84,0)
K-CITY^.216^NK1
"DATA",64850002,85,0)
K-NAME OF PRIMARY NOK^.211^NK1
"DATA",64850002,86,0)
K-PHONE NUMBER^.219^NK1
"DATA",64850002,87,0)
K-RELATIONSHIP TO PATIENT^.212^NK1
"DATA",64850002,88,0)
K-STATE^.217^NK1
"DATA",64850002,89,0)
K-STREET ADDRESS [LINE 1]^.213^NK1
"DATA",64850002,90,0)
K-STREET ADDRESS [LINE 2]^.214^NK1
"DATA",64850002,91,0)
K-STREET ADDRESS [LINE 3]^.215^NK1
"DATA",64850002,92,0)
K-WORK PHONE NUMBER^.21011^NK1
"DATA",64850002,93,0)
K-ZIP CODE^.218^NK1
"DATA",64850002,94,0)
K-ZIP+4^.2207^NK1
"DATA",64850002,95,0)
K2-ADDRESS SAME AS PATIENT'S?^.21925^NK2
"DATA",64850002,96,0)
K2-CITY^.2196^NK2
"DATA",64850002,97,0)
K2-NAME OF SECONDARY NOK^.2191^NK2
"DATA",64850002,98,0)
K2-PHONE NUMBER^.2199^NK2
"DATA",64850002,99,0)
K2-RELATIONSHIP TO PATIENT^.2192^NK2
"DATA",64850002,100,0)
K2-STATE^.2197^NK2
"DATA",64850002,101,0)
K2-STREET ADDRESS [LINE 1]^.2193^NK2
"DATA",64850002,102,0)
K2-STREET ADDRESS [LINE 2]^.2194^NK2
"DATA",64850002,103,0)
K2-STREET ADDRESS [LINE 3]^.2195^NK2
"DATA",64850002,104,0)
K2-WORK PHONE NUMBER^.211011^NK2
"DATA",64850002,105,0)
K2-ZIP CODE^.2198^NK2
"DATA",64850002,106,0)
K2-ZIP+4^.2203^NK2
"DATA",64850002,107,0)
LANGUAGE PREFERENCE^256000^DEMOG
"DATA",64850002,108,0)
LANGUAGE SKILLS^256001^DEMOG
"DATA",64850002,108,"M",0)
2.0256001P^^
"DATA",64850002,108,"M",1,0)
LANGUAGE SKILLS^.01;2.0256001
"DATA",64850002,108,"M",2,0)
READING SKILL LEVEL^3;2.0256001
"DATA",64850002,108,"M",3,0)
SPEAKING SKILL LEVEL^2;2.0256001
"DATA",64850002,108,"M",4,0)
UNDERSTANDING SKILL LEVEL^1;2.0256001
"DATA",64850002,108,"M",5,0)
WRITTEN SKILL LEVEL^4;2.0256001
"DATA",64850002,109,0)
LODGER WARD LOCATION^.107^N/A
"DATA",64850002,110,0)
MARITAL STATUS^.05^DEMOG
"DATA",64850002,111,0)
MEDICAID NUMBER^.383^DEMOG
"DATA",64850002,112,0)
MOTHER'S COUNTRY OF BIRTH^19903^DEMOG
"DATA",64850002,113,0)
MOTHER'S MAIDEN NAME^.2403^DEMOG
"DATA",64850002,114,0)
MOTHER'S NAME^.2402^DEMOG
"DATA",64850002,115,0)
MULTIPLE BIRTH INDICATOR^994^DEMOG
"DATA",64850002,116,0)
NAME^.01^DEMOG
"DATA",64850002,117,0)
K-NEXT OF KIN^.211^NK1
"DATA",64850002,118,0)
K2-NEXT OF KIN^.2191^NK2
"DATA",64850002,119,0)
PAGER NUMBER CHANGE DT/TM^.1312^DEMOG
"DATA",64850002,120,0)
PAGER NUMBER CHANGE SITE^.1314^DEMOG
"DATA",64850002,121,0)
PAGER NUMBER CHANGE SOURCE^.1313^DEMOG
"DATA",64850002,122,0)
PHONE NUMBER [CELLULAR]^.134^DEMOG
"DATA",64850002,123,0)
PHONE NUMBER [RESIDENCE]^.131^DEMOG
"DATA",64850002,124,0)
PLACE OF BIRTH [CITY]^.092^DEMOG
"DATA",64850002,125,0)
PLACE OF BIRTH [STATE]^.093^DEMOG
"DATA",64850002,126,0)
POB CITY^.092^DEMOG
"DATA",64850002,127,0)
POB STATE^.093^DEMOG
"DATA",64850002,128,0)
POSTAL CODE^.1172^DEMOG
"DATA",64850002,129,0)
PREFERRED FACILITY^27.02^DEMOG
"DATA",64850002,130,0)
PRELIMINARY CAUSE OF DEATH^250043.1^DEMOG
"DATA",64850002,130,"M",0)
2.250043^^^
"DATA",64850002,130,"M",1,0)
PRELIMINARY CAUSE OF DEATH^2.250043
"DATA",64850002,131,0)
D-NAME OF DESIGNEE^.341^D1
"DATA",64850002,132,0)
PROVINCE^.1171^DEMOG
"DATA",64850002,133,0)
RACE^.06^DEMOG
"DATA",64850002,134,0)
RACE INFORMATION^2^DEMOG
"DATA",64850002,134,"M",0)
2.02P^^
"DATA",64850002,134,"M",1,0)
RACE INFORMATION^.01;2.02
"DATA",64850002,135,0)
RATED INCOMPETENT?^.293^DEMOG
"DATA",64850002,136,0)
RELIGION^.08^DEMOG
"DATA",64850002,137,0)
RELIGIOUS PREFERENCE^.08^DEMOG
"DATA",64850002,138,0)
REMARKS^.091^DEMOG
"DATA",64850002,140,0)
SOCIAL SECURITY AMOUNT^.3623^MB
"DATA",64850002,141,0)
SPOUSE'S EMP PHONE NUMBER^.258^SPOUSE
"DATA",64850002,142,0)
SPOUSE'S EMP STREET [LINE 1]^.252^SPOUSE
"DATA",64850002,143,0)
SPOUSE'S EMP STREET [LINE 2]^.253^SPOUSE
"DATA",64850002,144,0)
SPOUSE'S EMP STREET [LINE 3]^.254^SPOUSE
"DATA",64850002,145,0)
SPOUSE'S EMP ZIP CODE^.257^SPOUSE
"DATA",64850002,146,0)
SPOUSE'S EMP ZIP+4^.2206^SPOUSE
"DATA",64850002,147,0)
SPOUSE'S EMPLOYER NAME^.251^SPOUSE
"DATA",64850002,148,0)
SPOUSE'S EMPLOYER'S CITY^.255^SPOUSE
"DATA",64850002,149,0)
SPOUSE'S EMPLOYER'S STATE^.256^SPOUSE
"DATA",64850002,150,0)
SPOUSE'S EMPLOYMENT STATUS^.2515^SPOUSE
"DATA",64850002,151,0)
SPOUSE'S OCCUPATION^.2514^SPOUSE
"DATA",64850002,152,0)
SPOUSE'S RETIREMENT DATE^.2516^SPOUSE
"DATA",64850002,153,0)
START DATE OF TEMP ADDRESS^.1217^TAD
"DATA",64850002,154,0)
STATE^.115^DEMOG
"DATA",64850002,155,0)
STREET ADDRESS [LINE 1]^.111^DEMOG
"DATA",64850002,156,0)
STREET ADDRESS [LINE 2]^.112^DEMOG
"DATA",64850002,157,0)
STREET ADDRESS [LINE 3]^.113^DEMOG
"DATA",64850002,158,0)
TEMPORARY ADDRESS CHANGE DT/TM^.12113^TAD
"DATA",64850002,159,0)
TEMPORARY ADDRESS CHANGE SITE^.12114^TAD
"DATA",64850002,160,0)
TEMPORARY ADDRESS COUNTRY^.1223^TAD
"DATA",64850002,161,0)
TEMPORARY ADDRESS COUNTY^.12111^TAD
"DATA",64850002,162,0)
TEMPORARY ADDRESS END DATE^.1218^TAD
"DATA",64850002,163,0)
TEMPORARY ADDRESS POSTAL CODE^.1222^TAD
"DATA",64850002,164,0)
TEMPORARY ADDRESS PROVINCE^.1221^TAD
"DATA",64850002,165,0)
TEMPORARY ADDRESS START DATE^.1217^TAD
"DATA",64850002,166,0)
TEMPORARY CITY^.1214^TAD
"DATA",64850002,167,0)
TEMPORARY PHONE NUMBER^.1219^TAD
"DATA",64850002,168,0)
TEMPORARY STATE^.1215^TAD
"DATA",64850002,169,0)
TEMPORARY STREET [LINE 1]^.1211^TAD
"DATA",64850002,170,0)
TEMPORARY STREET [LINE 2]^.1212^TAD
"DATA",64850002,171,0)
TEMPORARY STREET [LINE 3]^.1213^TAD
"DATA",64850002,172,0)
TEMPORARY ZIP CODE^.1216^TAD
"DATA",64850002,173,0)
TEMPORARY ZIP+4^.12112^TAD
"DATA",64850002,174,0)
TIME OF BIRTH^540000.1^DEMOG
"DATA",64850002,175,0)
ZIP CODE^.116^DEMOG
"DATA",64850002,176,0)
ZIP+4^.1112^DEMOG
"DATA",64850002,177,0)
OCCUPATION^.07^DEMOG
"DATA",64850002,178,0)
SEX^.02^DEMOG
"DATA",64850003,1,0)
DEMOG^Demographics
"DATA",64850003,1,"F",0)
^64850003.02^21^1
"DATA",64850003,1,"F",1,0)
.01
"DATA",64850003,1,"F",2,0)
.02
"DATA",64850003,1,"F",3,0)
.03
"DATA",64850003,1,"F",4,0)
.05
"DATA",64850003,1,"F",5,0)
.06
"DATA",64850003,1,"F",6,0)
.08
"DATA",64850003,1,"F",7,0)
.09
"DATA",64850003,1,"F",8,0)
.111
"DATA",64850003,1,"F",9,0)
.1112
"DATA",64850003,1,"F",10,0)
.112
"DATA",64850003,1,"F",11,0)
.113
"DATA",64850003,1,"F",12,0)
.114
"DATA",64850003,1,"F",13,0)
.115
"DATA",64850003,1,"F",14,0)
.116
"DATA",64850003,1,"F",15,0)
.117
"DATA",64850003,1,"F",16,0)
.131
"DATA",64850003,1,"F",17,0)
.132
"DATA",64850003,1,"F",18,0)
.363
"DATA",64850003,1,"F",19,0)
1
"DATA",64850003,1,"F",20,0)
256000
"DATA",64850003,1,"F",21,0)
.1172
"DATA",64850003,2,0)
D1^Designee
"DATA",64850003,2,"F",0)
^64850003.02^^0
"DATA",64850003,2,"F",1,0)
.2202
"DATA",64850003,2,"F",2,0)
.2202
"DATA",64850003,2,"F",3,0)
.3405
"DATA",64850003,2,"F",4,0)
.341
"DATA",64850003,2,"F",5,0)
.342
"DATA",64850003,2,"F",6,0)
.343
"DATA",64850003,2,"F",7,0)
.344
"DATA",64850003,2,"F",8,0)
.345
"DATA",64850003,2,"F",9,0)
.346
"DATA",64850003,2,"F",10,0)
.347
"DATA",64850003,2,"F",11,0)
.348
"DATA",64850003,2,"F",13,0)
.115
"DATA",64850003,2,"F",14,0)
.116
"DATA",64850003,2,"F",15,0)
.117
"DATA",64850003,2,"F",16,0)
.131
"DATA",64850003,2,"F",17,0)
.132
"DATA",64850003,2,"F",18,0)
.363
"DATA",64850003,2,"F",19,0)
1
"DATA",64850003,2,"F",21,0)
.1172
"DATA",64850003,3,0)
EC1^Emergency contact
"DATA",64850003,3,"F",0)
^64850003.02^11^11
"DATA",64850003,3,"F",1,0)
.2201
"DATA",64850003,3,"F",2,0)
.3305
"DATA",64850003,3,"F",3,0)
.331
"DATA",64850003,3,"F",4,0)
.332
"DATA",64850003,3,"F",5,0)
.333
"DATA",64850003,3,"F",6,0)
.334
"DATA",64850003,3,"F",7,0)
.335
"DATA",64850003,3,"F",8,0)
.336
"DATA",64850003,3,"F",9,0)
.337
"DATA",64850003,3,"F",10,0)
.338
"DATA",64850003,3,"F",11,0)
.339
"DATA",64850003,4,0)
EC2^Emergency Contact
"DATA",64850003,4,"F",0)
^64850003.02^10^10
"DATA",64850003,4,"F",1,0)
.2204
"DATA",64850003,4,"F",2,0)
.3311
"DATA",64850003,4,"F",3,0)
.3312
"DATA",64850003,4,"F",4,0)
.3313
"DATA",64850003,4,"F",5,0)
.3314
"DATA",64850003,4,"F",6,0)
.3315
"DATA",64850003,4,"F",7,0)
.3316
"DATA",64850003,4,"F",8,0)
.3317
"DATA",64850003,4,"F",9,0)
.3318
"DATA",64850003,4,"F",10,0)
.3319
"DATA",64850003,5,0)
SP1^Spousal Info
"DATA",64850003,5,"F",0)
^64850003.02^.258^9
"DATA",64850003,5,"F",1,0)
.2206
"DATA",64850003,5,"F",2,0)
.251
"DATA",64850003,5,"F",3,0)
.252
"DATA",64850003,5,"F",4,0)
.253
"DATA",64850003,5,"F",5,0)
.254
"DATA",64850003,5,"F",6,0)
.255
"DATA",64850003,5,"F",7,0)
.256
"DATA",64850003,5,"F",8,0)
.257
"DATA",64850003,5,"F",9,0)
.258
"DATA",64850003,8,0)
II^Insurance
"DATA",64850003,8,"F",0)
^64850003.02^2^2
"DATA",64850003,8,"F",1,0)
.3121
"DATA",64850003,8,"F",2,0)
.3192
"DATA",64850003,9,0)
IRD^Radiation Exposure
"DATA",64850003,9,"F",0)
^64850003.02^3^3
"DATA",64850003,9,"F",1,0)
.32103
"DATA",64850003,9,"F",2,0)
.32111
"DATA",64850003,9,"F",3,0)
.3212
"DATA",64850003,10,0)
NK1^Next of kin
"DATA",64850003,10,"F",0)
^64850003.02^11^11
"DATA",64850003,10,"F",1,0)
.211
"DATA",64850003,10,"F",2,0)
.212
"DATA",64850003,10,"F",3,0)
.2125
"DATA",64850003,10,"F",4,0)
.213
"DATA",64850003,10,"F",5,0)
.214
"DATA",64850003,10,"F",6,0)
.215
"DATA",64850003,10,"F",7,0)
.216
"DATA",64850003,10,"F",8,0)
.217
"DATA",64850003,10,"F",9,0)
.218
"DATA",64850003,10,"F",10,0)
.219
"DATA",64850003,10,"F",11,0)
.2207
"DATA",64850003,11,0)
NK2^Next of kin
"DATA",64850003,11,"F",0)
^64850003.02^11^11
"DATA",64850003,11,"F",1,0)
.2191
"DATA",64850003,11,"F",2,0)
.2192
"DATA",64850003,11,"F",3,0)
.21925
"DATA",64850003,11,"F",4,0)
.2193
"DATA",64850003,11,"F",5,0)
.2194
"DATA",64850003,11,"F",6,0)
.2195
"DATA",64850003,11,"F",7,0)
.2196
"DATA",64850003,11,"F",8,0)
.2197
"DATA",64850003,11,"F",9,0)
.2198
"DATA",64850003,11,"F",10,0)
.2199
"DATA",64850003,11,"F",11,0)
.2203
"DATA",64850003,13,0)
TAD^Temp address
"DATA",64850003,13,"F",0)
^64850003.02^12^12
"DATA",64850003,13,"F",1,0)
.12105
"DATA",64850003,13,"F",2,0)
.1211
"DATA",64850003,13,"F",3,0)
.12111
"DATA",64850003,13,"F",4,0)
.12112
"DATA",64850003,13,"F",5,0)
.1212
"DATA",64850003,13,"F",6,0)
.1213
"DATA",64850003,13,"F",7,0)
.1214
"DATA",64850003,13,"F",8,0)
.1215
"DATA",64850003,13,"F",9,0)
.1216
"DATA",64850003,13,"F",10,0)
.1217
"DATA",64850003,13,"F",11,0)
.1218
"DATA",64850003,13,"F",12,0)
.1219
"DATA",64850004,1,0)
DGCOLLATERAL^418
"DATA",64850004,2,0)
DG LOAD EDIT SCREEN 7^420
"DATA",64850004,3,0)
PSO OUTPTA^867
"DATA",64850004,4,0)
DVBHINQ UPDATE^960
"DATA",64850004,5,0)
DVBA C ADD 2507 PAT^965
"DATA",64850004,6,0)
DGRPT 10-10T REGISTRATION^1476
"DATA",64850004,7,0)
A1CK VARO/DHCP^1505
"DATA",64850004,8,0)
DGEN NEACL^1724
"FIA",2)
PATIENT
"FIA",2,0)
^DPT(
"FIA",2,0,0)
2I
"FIA",2,0,1)
y^y^p^^^^n^^n
"FIA",2,0,10)

"FIA",2,0,11)

"FIA",2,0,"RLRO")

"FIA",2,2)
1
"FIA",2,2,540001.1)

"FIA",64850001)
PATIENT FILE FIELD EXCLUSIONS
"FIA",64850001,0)
^DIZ(64850001,
"FIA",64850001,0,0)
64850001
"FIA",64850001,0,1)
y^n^f^^n^^y^m^y
"FIA",64850001,0,10)

"FIA",64850001,0,11)

"FIA",64850001,0,"RLRO")

"FIA",64850001,64850001)
0
"FIA",64850002)
CIVILIAN PATIENT FIELDS
"FIA",64850002,0)
^DIZ(64850002,
"FIA",64850002,0,0)
64850002
"FIA",64850002,0,1)
y^n^f^^y^^y^m^n
"FIA",64850002,0,10)

"FIA",64850002,0,11)

"FIA",64850002,0,"RLRO")

"FIA",64850002,64850002)
0
"FIA",64850002,64850002.01)
0
"FIA",64850002,64850002.13)
0
"FIA",64850003)
FIELD GROUPS
"FIA",64850003,0)
^DIZ(64850003,
"FIA",64850003,0,0)
64850003
"FIA",64850003,0,1)
y^n^f^^y^^y^m^n
"FIA",64850003,0,10)

"FIA",64850003,0,11)

"FIA",64850003,0,"RLRO")

"FIA",64850003,64850003)
0
"FIA",64850003,64850003.02)
0
"FIA",64850004)
VERBOTEN TEMPLATES
"FIA",64850004,0)
^DIZ(64850004,
"FIA",64850004,0,0)
64850004
"FIA",64850004,0,1)
y^n^f^^y^^y^m^n
"FIA",64850004,0,10)

"FIA",64850004,0,11)

"FIA",64850004,0,"RLRO")

"FIA",64850004,64850004)
0
"INI")
PI^VWREGIT2
"KRN",.402,1771,-1)
0^6
"KRN",.402,1771,0)
VW WESTVIRGINIA TEST^3150408.103^@^2^^@^3170308
"KRN",.402,1771,"DIAB",1,1,2.06,0)
ALL
"KRN",.402,1771,"DR",1,2)
540000.1;6;.111;.112;.2926;.2927;.1172;.117;.08;
"KRN",.402,1771,"DR",2,2.06)
.01:.02
"KRN",.402,1773,-1)
0^4
"KRN",.402,1773,0)
VW PT REGISTRATION^3170316.1534^^2^^^3170316
"KRN",.402,1773,"%D",0)
^^1^1^3160416^
"KRN",.402,1773,"%D",1,0)
Created via registration client
"KRN",.402,1773,"DR",1,2)
.01;.02;.03;.05;.363;27.02;.111;.112;.1112;.114;.115;.117;.131;.132;.134;.133;.331;.339;.3121;.091;3;250043.1;
"KRN",.402,1773,"DR",2,2.001)
.01;1;
"KRN",.402,1773,"DR",2,2.312)
.01;
"KRN",.402,1773,"DR",3,2.011)
.01;1;
"KRN",.402,1774,-1)
0^1
"KRN",.402,1774,0)
VW ADDRESS ^3160323.1111^^2^^^3160323
"KRN",.402,1774,"DR",1,2)
.111;.112;.1172;.114;.115;.117;.1173;.131;.132;.134;
"KRN",.402,1776,-1)
0^3
"KRN",.402,1776,0)
VW NEXT OF KIN ^3160323.1123^@^2^^@^3160323
"KRN",.402,1776,"DR",1,2)
.211;.212;.2125;.213;.214;.2207;.216;.217;.219;.21011;
"KRN",.402,1777,-1)
0^2
"KRN",.402,1777,0)
VW EMERG. CONTACT ^3160323.1143^@^2^^@^3160323
"KRN",.402,1777,"DR",1,2)
.331;.332;.333;.334;.338;.336;.337;.339;.33011;
"KRN",.402,1778,-1)
0^5
"KRN",.402,1778,0)
VW REPORTED DEATH ^3160327.0944^@^2^^@^3160328
"KRN",.402,1778,"DR",1,2)
.351;
"KRN",3.8,278,-1)
0^1
"KRN",3.8,278,0)
VW REG ERROR REPORT^PU^n^^^^
"KRN",3.8,278,2,0)
^^1^1^3160705^
"KRN",3.8,278,2,1,0)
[Optional] Report any GUI registration errors
"KRN",3.8,278,3)

"KRN",19,11341,-1)
0^2
"KRN",19,11341,0)
VW REG IT CONTROL^VW GUI REGISTRATION SET UP ACCESS^^M^^^^^^^^
"KRN",19,11341,99)
64030,52494
"KRN",19,11341,99.1)
64362,33983
"KRN",19,11341,"U")
VW GUI REGISTRATION SET UP ACC
"KRN",19,11342,-1)
0^1
"KRN",19,11342,0)
VW PATIENT REGISTRATION^VW PATIENT REGISTRATION^^^^^^^^^^
"KRN",19,11342,"U")
VW PATIENT REGISTRATION
"KRN",8989.51,1344,-1)
0^1
"KRN",8989.51,1344,0)
VW GUI REG TEMPLATE DIRECTORY^Host Home Directory^0^^Path for local Home Directory^
"KRN",8989.51,1344,1)
F^1:100^Enter your home directory (i.e., a Linux vista directory might be: /home/vista/)
"KRN",8989.51,1344,4,0)
^8989.514^^0
"KRN",8989.51,1344,6)
N^1:1
"KRN",8989.51,1344,20,0)
^8989.512^1^1^3160118^^^^
"KRN",8989.51,1344,20,1,0)
Asked to find the home directory for application parameter files
"KRN",8989.51,1344,30,0)
^8989.513I^5^2
"KRN",8989.51,1344,30,3,0)
9^4.2
"KRN",8989.51,1344,30,5,0)
3^4
"KRN",8989.51,1345,-1)
0^2
"KRN",8989.51,1345,0)
VW REG DEFAULT STATE^DEFAULT HOME STATE^0^^Select your home state
"KRN",8989.51,1345,1)
P^5
"KRN",8989.51,1345,6)
^
"KRN",8989.51,1345,30,0)
^8989.513I^1^1
"KRN",8989.51,1345,30,1,0)
9^4.2
"KRN",8989.51,1347,-1)
0^3
"KRN",8989.51,1347,0)
VW REG RDNPT^DEFAULT NEW PT TEMPLATE^0^^Default template for new pt registration
"KRN",8989.51,1347,1)
P^.402^Select the input template that is your default for new pt registration.
"KRN",8989.51,1347,6)
^
"KRN",8989.51,1347,30,0)
^8989.513I^1^1
"KRN",8989.51,1347,30,1,0)
9^4.2
"KRN",8994,2853,-1)
0^9
"KRN",8994,2853,0)
VW REG MAIN^EN^VWREGIT^2^P^^^0^2.01
"KRN",8994,2853,1,0)
^8994.01^1^1^3131007^^^^
"KRN",8994,2853,1,1,0)
Called by client to get template names from the server/site working directory 
"KRN",8994,2853,2,0)
^8994.02A^^0
"KRN",8994,2853,3,0)
^8994.03^1^1^3150506^^^^
"KRN",8994,2853,3,1,0)
Returns template names(IEN)
"KRN",8994,2854,-1)
0^12
"KRN",8994,2854,0)
VW REG NEW PT^NPT^VWREGIT^2^P^^^0^2.01
"KRN",8994,2854,2,0)
^8994.02A^1^1
"KRN",8994,2854,2,1,0)
TIEN^1^^1^2
"KRN",8994,2854,2,"B","TIEN",1)

"KRN",8994,2854,2,"PARAMSEQ",2,1)

"KRN",8994,2868,-1)
0^18
"KRN",8994,2868,0)
VW REG SPI^SPI^VWREGITU^2^P^^^0^2.01
"KRN",8994,2868,1,0)
^^1^1^3150605^
"KRN",8994,2868,1,1,0)
Simple Patient Inquiry for GUI roll-over
"KRN",8994,2868,2,0)
^8994.02A^2^1
"KRN",8994,2868,2,2,0)
DFN^1^^1^2
"KRN",8994,2868,2,"B","DFN",2)

"KRN",8994,2868,2,"PARAMSEQ",2,2)

"KRN",8994,2869,-1)
0^13
"KRN",8994,2869,0)
VW REG PARTIAL PT LIST^GPL^VWREGITX^2^P^^^0^2.01
"KRN",8994,2869,1,0)
^8994.01^1^1^3151103^^^
"KRN",8994,2869,1,1,0)
Returns the called for alpha list of patients
"KRN",8994,2869,2,0)
^8994.02A^1^1
"KRN",8994,2869,2,1,0)
IDDATA^1^^1^2
"KRN",8994,2869,2,1,1,0)
^8994.021^1^1^3151103^^
"KRN",8994,2869,2,1,1,1,0)
Segmented alphabetic (A^D, E^H, U^Z, etc)
"KRN",8994,2869,2,"B","IDDATA",1)

"KRN",8994,2869,2,"PARAMSEQ",2,1)

"KRN",8994,2870,-1)
0^14
"KRN",8994,2870,0)
VW REG PF^PF^VWREGIT^2^P^^^0^2.01
"KRN",8994,2870,1,0)
^^1^1^3150528^
"KRN",8994,2870,1,1,0)
Returns .01(.001) to GUI
"KRN",8994,2870,2,0)
^8994.02A^1^1
"KRN",8994,2870,2,1,0)
XPF^1^^1^2
"KRN",8994,2870,2,"B","XPF",1)

"KRN",8994,2870,2,"PARAMSEQ",2,1)

"KRN",8994,2871,-1)
0^8
"KRN",8994,2871,0)
VW REG GRP LIST^RETGRP^VWREGITX^2^P^^^0^2.01
"KRN",8994,2871,1,0)
^8994.01^11^11^3160411^^^
"KRN",8994,2871,1,1,0)
Returns Patient file (#2) Field Groups:
"KRN",8994,2871,1,2,0)
RESULT(1)="Demographics(1)"
"KRN",8994,2871,1,3,0)
RESULT(2)="Designee(2)"
"KRN",8994,2871,1,4,0)
RESULT(3)="Emergency contact(3)"
"KRN",8994,2871,1,5,0)
RESULT(4)="Emergency Contact(4)"
"KRN",8994,2871,1,6,0)
RESULT(5)="SPOUSAL INFO(5)"
"KRN",8994,2871,1,7,0)
RESULT(6)="Insurance(8)"
"KRN",8994,2871,1,8,0)
RESULT(7)="Radiation Exposure(9)"
"KRN",8994,2871,1,9,0)
RESULT(8)="Next of kin(10)"
"KRN",8994,2871,1,10,0)
RESULT(9)="Next of kin(11)"
"KRN",8994,2871,1,11,0)
RESULT(10)="Temp address(13)"
"KRN",8994,2872,-1)
0^5
"KRN",8994,2872,0)
VW REG FLD BY GRP^LF^VWREGITX^2^P^^^0^2.01
"KRN",8994,2872,1,0)
^8994.01^1^1^3151009^^^
"KRN",8994,2872,1,1,0)
Returns the patient file fields identified by their group assignment
"KRN",8994,2872,2,0)
^8994.02A^1^1
"KRN",8994,2872,2,1,0)
FTYPE^1^^^2
"KRN",8994,2872,2,1,1,0)
^8994.021^1^1^3151009^^^
"KRN",8994,2872,2,1,1,1,0)
The caption of the menu selection
"KRN",8994,2872,2,"B","FTYPE",1)

"KRN",8994,2872,2,"PARAMSEQ",2,1)

"KRN",8994,2873,-1)
0^1
"KRN",8994,2873,0)
VW REG AHF^AHF^VWREGITX^2^P^^^0^2.01
"KRN",8994,2873,1,0)
^8994.01^8^8^3151017^^
"KRN",8994,2873,1,1,0)
GUI client sends a list of individual fields selected in the
"KRN",8994,2873,1,2,0)
"ad hoc" process. This app returns all the necessary field data
"KRN",8994,2873,1,3,0)
to the client: FIELD NAME^NO;SUBDIC^EXISTING VALUE^HELP^P/SC
"KRN",8994,2873,1,4,0)
  FIELD NAME     : TEXT NAME OF THE FIELD (.01)
"KRN",8994,2873,1,5,0)
  FIELD NO/SUBDIC: FIELD OF FILE 2 OR SUB-FIELD DICTIONARY
"KRN",8994,2873,1,6,0)
  EXISTING VALUE : IF PATIENT SELECTED, VALUE OF THE FIELD
"KRN",8994,2873,1,7,0)
  HELP           : HELP TEXT OF THE FIELD
"KRN",8994,2873,1,8,0)
  P/SC           : POINTER OR SET OF CODES
"KRN",8994,2873,2,0)
^8994.02A^1^1
"KRN",8994,2873,2,1,0)
AHF^2^^^2
"KRN",8994,2873,2,"B","AHF",1)

"KRN",8994,2873,2,"PARAMSEQ",2,1)

"KRN",8994,2874,-1)
0^10
"KRN",8994,2874,0)
VW REG MF^M^VWREGITU^2^P^^^0^2.01
"KRN",8994,2874,1,0)
^8994.01^1^1^3160130^^^^
"KRN",8994,2874,1,1,0)
Displays Multiple Field Input form.
"KRN",8994,2874,2,0)
^8994.02A^1^1
"KRN",8994,2874,2,1,0)
XMF^1^^^2
"KRN",8994,2874,2,"B","XMF",1)

"KRN",8994,2874,2,"PARAMSEQ",2,1)

"KRN",8994,2875,-1)
0^11
"KRN",8994,2875,0)
VW REG MISC^MISC^VWREGITU^2^P^^^0^2.01
"KRN",8994,2875,1,0)
^8994.01^1^1^3150623^
"KRN",8994,2875,1,1,0)
Takes in DD#, returns simple list .01TEXT(DIC#/FIELD#)
"KRN",8994,2875,2,0)
^8994.02A^1^1
"KRN",8994,2875,2,1,0)
VWDD^1^^1^2
"KRN",8994,2875,2,1,1,0)
^^1^1^3150623^
"KRN",8994,2875,2,1,1,1,0)
DD number (i.e., DD(355.1))
"KRN",8994,2875,2,"B","VWDD",1)

"KRN",8994,2875,2,"PARAMSEQ",2,1)

"KRN",8994,2876,-1)
0^20
"KRN",8994,2876,0)
VW REG ZIP^ZPC^VWREGITU^2^P^^^0^2.01
"KRN",8994,2876,1,0)
^8994.01^1^1^3150701^^^^
"KRN",8994,2876,1,1,0)
Returns city,state,zip,county
"KRN",8994,2876,2,0)
^8994.02A^1^1
"KRN",8994,2876,2,1,0)
ZIP^1^^^1
"KRN",8994,2876,2,1,1,0)
^8994.021^1^1^3150701^^^^
"KRN",8994,2876,2,1,1,1,0)
Postal code
"KRN",8994,2876,2,"B","ZIP",1)

"KRN",8994,2876,2,"PARAMSEQ",1,1)

"KRN",8994,2878,-1)
0^2
"KRN",8994,2878,0)
VW REG ALIST^ALIST^VWREGITX^2^P^^^0^2.01
"KRN",8994,2878,1,0)
^8994.01^21^21^3160123^^^^
"KRN",8994,2878,1,1,0)
ALIST will take two args but the 3rd (CALLERID) can be empty.
"KRN",8994,2878,1,2,0)
If CALLERID is sent and ALIST contains pieces(^) then @subroutine
"KRN",8994,2878,1,3,0)
of CALLERID is executed.
"KRN",8994,2878,1,4,0)
Otherwise,
"KRN",8994,2878,1,5,0)
Returns a listing of the required alphabetic (2nd arg)
"KRN",8994,2878,1,6,0)
           ID/HRN    ^CLIENT NAME(DFN)   ^DOB@TIME          ^PHONE (.131)
"KRN",8994,2878,1,7,0)
RESULT(1)="----------^BARNES,DANIEL(10)^OCT 21, 1945^"
"KRN",8994,2878,1,8,0)
RESULT(2)="----------^BARNES,PAUL(102)^JAN 04, 1988^"
"KRN",8994,2878,1,9,0)
RESULT(3)="----------^BARTLET,DAVID(124)^JUL 12, 1942^"
"KRN",8994,2878,1,10,0)
RESULT(4)="----------^BENSON,ALBERT(144)^AUG 24, 1953^"
"KRN",8994,2878,1,11,0)
RESULT(5)="8876 23 24^BLACK,EDWARD D(11)^APR 07, 2015@09:43^"
"KRN",8994,2878,1,12,0)
RESULT(6)="----------^BLACK,GEORGE(12)^MAR 03, 2007^"
"KRN",8994,2878,1,13,0)
RESULT(7)="----------^BOKHARI,ZAHID(99)^JAN 01, 1963^"
"KRN",8994,2878,1,14,0)
RESULT(8)="----------^BOND,JAMES(96)^JAN 30, 1958^"
"KRN",8994,2878,1,15,0)
RESULT(9)="----------^BRENT,NORA(13)^FEB 15, 2009^"
"KRN",8994,2878,1,16,0)
RESULT(10)="----------^BROOKS,MARIA(14)^APR 09, 2006^"
"KRN",8994,2878,1,17,0)
RESULT(11)="----------^BROOKS,RICHARD(15)^MAY 16, 1956^"
"KRN",8994,2878,1,18,0)
RESULT(12)="----------^BROWN,MARK DOUGLAS(80)^JAN 01, 1960^207 959-2228"
"KRN",8994,2878,1,19,0)
RESULT(13)="----------^BUICK,BERNADETTE P(219)^AUG 20, 1980^448-887-9999"
"KRN",8994,2878,1,20,0)
RESULT(14)="----------^BUICK,RALPH P(208)^MAR 29, 1980^448-887-9999"
"KRN",8994,2878,1,21,0)
RESULT(15)="----------^BUICK,WILLYS P(220)^JUN 20, 2007@13:46^448-887-9999"
"KRN",8994,2878,2,0)
^8994.02A^2^2
"KRN",8994,2878,2,1,0)
ALIST^1^^1^2
"KRN",8994,2878,2,2,0)
CALLERID^1^^0^3
"KRN",8994,2878,2,"B","ALIST",1)

"KRN",8994,2878,2,"B","CALLERID",2)

"KRN",8994,2878,2,"PARAMSEQ",2,1)

"KRN",8994,2878,2,"PARAMSEQ",3,2)

"KRN",8994,2880,-1)
0^6
"KRN",8994,2880,0)
VW REG GPD^GPD^VWREGITP^2^P^^^0^2.01
"KRN",8994,2880,1,0)
^^2^2^3160213^
"KRN",8994,2880,1,1,0)
Returns data for an existing patient. Sub-routine GPD is contained
"KRN",8994,2880,1,2,0)
in the patient utility routine VWREGITP
"KRN",8994,2880,2,0)
^8994.02A^1^1
"KRN",8994,2880,2,1,0)
DATA^1^^1^2
"KRN",8994,2880,2,1,1,0)
^^1^1^3160213^
"KRN",8994,2880,2,1,1,1,0)
TEMPLATENAME(IEN)^FIELDSET(as in .01,.03, etc)^PATIENT NAME(IEN of file2)
"KRN",8994,2880,2,"B","DATA",1)

"KRN",8994,2880,2,"PARAMSEQ",2,1)

"KRN",8994,2880,3,0)
^8994.03^23^23^3160213^^
"KRN",8994,2880,3,1,0)
Example: DATA="(1773^^(208"
"KRN",8994,2880,3,2,0)
RESULT(1)=".01^BUICK,RALPH P"
"KRN",8994,2880,3,3,0)
RESULT(2)=".02^MALE"
"KRN",8994,2880,3,4,0)
RESULT(3)=".03^03/29/1980"
"KRN",8994,2880,3,5,0)
RESULT(4)=".05^MARRIED"
"KRN",8994,2880,3,6,0)
RESULT(5)="64850001^4545 67 89AZ"
"KRN",8994,2880,3,7,0)
RESULT(6)=".363^4545 65 89AZ"
"KRN",8994,2880,3,8,0)
RESULT(7)="27.02^BOSTON HCS (523)"
"KRN",8994,2880,3,9,0)
RESULT(8)=".111^12735 WINCHESTER BLVD"
"KRN",8994,2880,3,10,0)
RESULT(9)=".112^APT 3G"
"KRN",8994,2880,3,11,0)
RESULT(10)=".1172^48005"
"KRN",8994,2880,3,12,0)
RESULT(11)=".114^ARMADA"
"KRN",8994,2880,3,13,0)
RESULT(12)=".115^MICHIGAN"
"KRN",8994,2880,3,14,0)
RESULT(13)=".117^099"
"KRN",8994,2880,3,15,0)
RESULT(14)=".131^448-887-9999"
"KRN",8994,2880,3,16,0)
RESULT(15)=".132^"
"KRN",8994,2880,3,17,0)
RESULT(16)=".134^971-555-5567"
"KRN",8994,2880,3,18,0)
RESULT(17)=".133^RALPHYTHEBUICK@SOMEWHERE.NET"
"KRN",8994,2880,3,19,0)
RESULT(18)=".331^"
"KRN",8994,2880,3,20,0)
RESULT(19)=".339^"
"KRN",8994,2880,3,21,0)
RESULT(20)=".091^"
"KRN",8994,2880,3,22,0)
RESULT(21)="1^"
"KRN",8994,2880,3,23,0)
RESULT(22)="3^"
"KRN",8994,2881,-1)
0^7
"KRN",8994,2881,0)
VW REG GPDM^GPDM^VWREGITP^2^P^^^0^2.01
"KRN",8994,2881,1,0)
^8994.01^1^1^3160217^
"KRN",8994,2881,1,1,0)
Returns multiple data values for a patient
"KRN",8994,2881,2,0)
^8994.02A^1^1
"KRN",8994,2881,2,1,0)
DATA^1^^1^2
"KRN",8994,2881,2,1,1,0)
^^1^1^3160217^
"KRN",8994,2881,2,1,1,1,0)
DATA=PARENT FIELD LABEL^PARENT FIELD#^DFN
"KRN",8994,2881,2,"B","DATA",1)

"KRN",8994,2881,2,"PARAMSEQ",2,1)

"KRN",8994,2881,3,0)
^8994.03^4^4^3160217^^
"KRN",8994,2881,3,1,0)
Example: ENROLLMENT CLINIC^3^208
"KRN",8994,2881,3,2,0)
 RESULT(1)="ENROLLMENT CLINIC(s)"
"KRN",8994,2881,3,3,0)
 RESULT(2)="CARDIOLOGY^NOV 29, 2015@09:51^AC^CLINIC^"
"KRN",8994,2881,3,4,0)
 RESULT(3)="DERMATOLOGY PROCEDURE^DEC 10, 2015@09:38^AC^CLINIC^"
"KRN",8994,2882,-1)
0^16
"KRN",8994,2882,0)
VW REG SAVE^SAVE^VWREGITS^2^P^^^0^2.01
"KRN",8994,2882,1,0)
^8994.01^3^3^3160326^^^^
"KRN",8994,2882,1,1,0)
Saves patient/client data to the Patient file (#2) and the
"KRN",8994,2882,1,2,0)
IHS Patient file (#9000001). If a DFN is empty, the routine
"KRN",8994,2882,1,3,0)
will check for an entry anyway.
"KRN",8994,2882,2,0)
^8994.02A^1^1
"KRN",8994,2882,2,1,0)
LDATA^2^^1^2
"KRN",8994,2882,2,1,1,0)
^8994.021^16^16^3160318^^^
"KRN",8994,2882,2,1,1,1,0)
Incoming data from the client example:
"KRN",8994,2882,2,1,1,2,0)
S LDATA=""
"KRN",8994,2882,2,1,1,3,0)
S LDATA(1)="NAME^.01^buick,ralphinia"
"KRN",8994,2882,2,1,1,4,0)
S LDATA(3)="SEX^.02^fEMALE"
"KRN",8994,2882,2,1,1,5,0)
S LDATA(5)="DOB^.03^2009"
"KRN",8994,2882,2,1,1,6,0)
S LDATA(7)="MARITAL STATUS^.05^NEVER MARRIED(6)"
"KRN",8994,2882,2,1,1,7,0)
S LDATA(9)="OCCUPATION^.07^child"
"KRN",8994,2882,2,1,1,8,0)
S LDATA(11)="RELIGION^.08^OTHER(22)"
"KRN",8994,2882,2,1,1,9,0)
S LDATA(13)="SSN^64850001^p"
"KRN",8994,2882,2,1,1,10,0)
S LDATA(15)="STREET ADDRESS [LINE 1]^.111^1430 Winchester Blvd"
"KRN",8994,2882,2,1,1,11,0)
S LDATA(17)="STREET ADDRESS [LINE 2]^.112^apt 3g"
"KRN",8994,2882,2,1,1,12,0)
S LDATA(19)="ZIP+4^.1112^48005"
"KRN",8994,2882,2,1,1,13,0)
S LDATA(21)="CITY^.114^ARMADA"
"KRN",8994,2882,2,1,1,14,0)
S LDATA(23)="STATE^.115^MICHIGAN(26)"
"KRN",8994,2882,2,1,1,15,0)
S LDATA(25)="COUNTY^.117^MACOMB(5)"
"KRN",8994,2882,2,1,1,16,0)
S LDATA(27)="EMERGENCY CONTACT^.331^buick,ralph"
"KRN",8994,2882,2,"B","LDATA",1)

"KRN",8994,2882,2,"PARAMSEQ",2,1)

"KRN",8994,2882,3,0)
^8994.03^1^1^3160318^^^
"KRN",8994,2882,3,1,0)
RESULT(N) will contain warning message of "Filed..."
"KRN",8994,2893,-1)
0^4
"KRN",8994,2893,0)
VW REG FGNA^FGNA^VWREGITX^2^P^^^0^2.01
"KRN",8994,2893,1,0)
^^4^4^3161102^
"KRN",8994,2893,1,1,0)
Returns an array of sorted fields:
"KRN",8994,2893,1,2,0)
  G In group,number order
"KRN",8994,2893,1,3,0)
  N In field number order
"KRN",8994,2893,1,4,0)
  A Alphabetical order
"KRN",8994,2893,2,0)
^8994.02A^1^1
"KRN",8994,2893,2,1,0)
KIND^1^^1^2
"KRN",8994,2893,2,"B","KIND",1)

"KRN",8994,2893,2,"PARAMSEQ",2,1)

"KRN",8994,2894,-1)
0^19
"KRN",8994,2894,0)
VW REG TEMPLATE^EN^VWREGITT^2^P^^^0^2.01
"KRN",8994,2894,1,0)
^^1^1^3161105^
"KRN",8994,2894,1,1,0)
Takes in template data from the GUI and executes the action listed.
"KRN",8994,2894,2,0)
^8994.02A^1^1
"KRN",8994,2894,2,1,0)
TDATA^2^^^2
"KRN",8994,2894,2,"B","TDATA",1)

"KRN",8994,2894,2,"PARAMSEQ",2,1)

"KRN",8994,2895,-1)
0^15
"KRN",8994,2895,0)
VW REG RTF^RTF^VWREGITT^2^P^^^0^2.01
"KRN",8994,2895,1,0)
^^12^12^3161109^
"KRN",8994,2895,1,1,0)
Returns the regparam/regit.txt file in RESULT:
"KRN",8994,2895,1,2,0)
RESULT(1)="[TEMPLATES]"
"KRN",8994,2895,1,3,0)
RESULT(2)="AD HOC FIELDS"
"KRN",8994,2895,1,4,0)
RESULT(3)="VW PT REGISTRATION(1773)"
"KRN",8994,2895,1,5,0)
RESULT(4)="ADDRESS [WorldVistA](1774)"
"KRN",8994,2895,1,6,0)
RESULT(5)="BASSANT(1784)"
"KRN",8994,2895,1,7,0)
RESULT(6)="EMERG. CONTACT [WorldVistA](1777)"
"KRN",8994,2895,1,8,0)
RESULT(7)="NEXT OF KIN [WorldVistA](1776)"
"KRN",8994,2895,1,9,0)
RESULT(8)="REPORTED DEATH [WorldVistA](1778)"
"KRN",8994,2895,1,10,0)
RESULT(9)="VW WESTVIRGINIA TEST(1771)"
"KRN",8994,2895,1,11,0)
RESULT(10)="testing(XXXX)"
"KRN",8994,2895,1,12,0)
RESULT(11)="[ID]"
"KRN",8994,2895,3,0)
^^1^1^3161109^
"KRN",8994,2895,3,1,0)
See description
"KRN",8994,2896,-1)
0^3
"KRN",8994,2896,0)
VW REG EGF^EGF^VWREGITT^2^P^^^0^2.01
"KRN",8994,2896,1,0)
^^1^1^3161113^
"KRN",8994,2896,1,1,0)
Returns the field of ID'd template for editing by client
"KRN",8994,2896,2,0)
^8994.02A^1^1
"KRN",8994,2896,2,1,0)
TNAME^1^^^2
"KRN",8994,2896,2,1,1,0)
^^1^1^3161113^
"KRN",8994,2896,2,1,1,1,0)
The name of the template for client editing
"KRN",8994,2896,2,"B","TNAME",1)

"KRN",8994,2896,2,"PARAMSEQ",2,1)

"MBREQ")
0
"ORD",7,.402)
.402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
"ORD",7,.402,0)
INPUT TEMPLATE
"ORD",11,3.8)
3.8;11;;;MAILG^XPDTA1;MAILGF1^XPDIA1;MAILGE1^XPDIA1;MAILGF2^XPDIA1;;MAILGDEL^XPDIA1(%)
"ORD",11,3.8,0)
MAIL GROUP
"ORD",16,8994)
8994;16;1;;;;;;;RPCDEL^XPDIA1
"ORD",16,8994,0)
REMOTE PROCEDURE
"ORD",18,19)
19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
"ORD",18,19,0)
OPTION
"ORD",20,8989.51)
8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%)
"ORD",20,8989.51,0)
PARAMETER DEFINITION
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
8
"RTN","VWREGIT")
0^1^B34467909
"RTN","VWREGIT",1,0)
VWREGIT ;Portland,OR/Jim Bell, et al Patient Registration Utility August 2015
"RTN","VWREGIT",2,0)
 ;;2.0;B/FProductions,LLC,WORLD VISTA;**LOCAL**;;Build 1
"RTN","VWREGIT",3,0)
 ;*******************************************************************
"RTN","VWREGIT",4,0)
 ;* VW Registration is designed for patient specific fields as      *
"RTN","VWREGIT",5,0)
 ;* defined in Fileman Input Templates or ad hoc field selection.   *
"RTN","VWREGIT",6,0)
 ;* Copyright Martius/MMXV ad infinitum (GNU License: See GPLv3.txt)*
"RTN","VWREGIT",7,0)
 ;*******************************************************************
"RTN","VWREGIT",8,0)
 ;;NO FALL THROUGH - JEB
"RTN","VWREGIT",9,0)
 Q
"RTN","VWREGIT",10,0)
 ;
"RTN","VWREGIT",11,0)
TFM(XF) ;TemplateField Management
"RTN","VWREGIT",12,0)
 ;***********************************************
"RTN","VWREGIT",13,0)
 ;* Check primary field entries for "parentage" *
"RTN","VWREGIT",14,0)
 ;* Add an "*" to gain all sub-fields of the    *
"RTN","VWREGIT",15,0)
 ;* parent                                      *
"RTN","VWREGIT",16,0)
 ;* REMEMBER: All fields pertain to file 2 only *
"RTN","VWREGIT",17,0)
 ;***********************************************
"RTN","VWREGIT",18,0)
 N I,N,FIELD
"RTN","VWREGIT",19,0)
 K FARRAY
"RTN","VWREGIT",20,0)
 I '$L(XF),'$G(TNUM) Q ""
"RTN","VWREGIT",21,0)
 I '$L(XF),+$G(TNUM) S XF=^DIE(TNUM,"DR",1,2)
"RTN","VWREGIT",22,0)
 F I=1:1:$L(XF,";") S:$L($P(XF,";",I)) FARRAY(I)=+$P(XF,";",I)
"RTN","VWREGIT",23,0)
 S N=0 F I=1:1 S N=$O(FARRAY(N)) Q:'+N  D
"RTN","VWREGIT",24,0)
 . S FIELD=FARRAY(N)
"RTN","VWREGIT",25,0)
 . I +$P(^DD(2,FIELD,0),"^",2) S FIELD=FIELD_"*",FMARRAY(FIELD)=$P(^(0),"^",4) K FARRAY(N)
"RTN","VWREGIT",26,0)
 S XF="",N=0 F  S N=$O(FARRAY(N)) Q:'+N  S XF=XF_FARRAY(N)_";"
"RTN","VWREGIT",27,0)
 Q XF
"RTN","VWREGIT",28,0)
 ;
"RTN","VWREGIT",29,0)
CHECK() ;
"RTN","VWREGIT",30,0)
 Q ""
"RTN","VWREGIT",31,0)
 ;
"RTN","VWREGIT",32,0)
INR() Q $O(RESULT(" "),-1)+1
"RTN","VWREGIT",33,0)
 ;
"RTN","VWREGIT",34,0)
EN(RESULT)    ;Template name and ID labels
"RTN","VWREGIT",35,0)
 ;Get the input template list
"RTN","VWREGIT",36,0)
 ;housekeeping
"RTN","VWREGIT",37,0)
 S DTIME=99999
"RTN","VWREGIT",38,0)
 ;ZSY "chmod 777 "_$ZD_"regparam/*.txt" ;Moved to post-install
"RTN","VWREGIT",39,0)
 ;end housekeeping
"RTN","VWREGIT",40,0)
 ;
"RTN","VWREGIT",41,0)
 K AR,RESULT
"RTN","VWREGIT",42,0)
 N N,HD,FILE,LOC,P4,P5,%ZISHF,%ZISHO,DEFST,XTMP,X
"RTN","VWREGIT",43,0)
 S RESULT(0)=1
"RTN","VWREGIT",44,0)
 S DEFST="";
"RTN","VWREGIT",45,0)
 ;S DEFTMP=$O(^DIE("B","FAU_EDU",0)) ;For Florida College only
"RTN","VWREGIT",46,0)
 S RESULT(0)=$$CONTROL^VWREGITU()
"RTN","VWREGIT",47,0)
 S RESULT(1)="-1^No templates found"
"RTN","VWREGIT",48,0)
 S DEFST=$$GET^XPAR("ALL","VW REG DEFAULT STATE")
"RTN","VWREGIT",49,0)
 S DEFTMP=$$GET^XPAR("ALL","VW REG RDNPT")
"RTN","VWREGIT",50,0)
 S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
"RTN","VWREGIT",51,0)
 I '$L(HD) K RESULT D  Q
"RTN","VWREGIT",52,0)
 . S RESULT($$INR)="-1^NO HOME DIRECTORY - refer to IT support, if necessary."
"RTN","VWREGIT",53,0)
 . S RESULT($$INR)="No home directory has been supplied which indicates"
"RTN","VWREGIT",54,0)
 . S RESULT($$INR)="the VWREG installation is incomplete. See the Help manual"
"RTN","VWREGIT",55,0)
 . S RESULT($$INR)="for installation and Enter/Editing parameter values."
"RTN","VWREGIT",56,0)
 . S RESULT($$INR)="Thank you,"
"RTN","VWREGIT",57,0)
 . S RESULT($$INR)="      The Management."
"RTN","VWREGIT",58,0)
 S FILE="regit.txt"
"RTN","VWREGIT",59,0)
 S P4=1
"RTN","VWREGIT",60,0)
 S P5=""
"RTN","VWREGIT",61,0)
 S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
"RTN","VWREGIT",62,0)
 D:+RESULT(0)
"RTN","VWREGIT",63,0)
 . S $P(RESULT(0),"^",2)=$G(HD)
"RTN","VWREGIT",64,0)
 . S $P(RESULT(0),"^",3)=$S(DEFST:$P(^DIC(5,DEFST,0),"^")_"("_DEFST_")",1:"")
"RTN","VWREGIT",65,0)
 . S $P(RESULT(0),"^",4)=$S(+DEFTMP:$P(^DIE(DEFTMP,0),"^")_"("_DEFTMP_")",1:DEFTMP)
"RTN","VWREGIT",66,0)
 . S $P(RESULT(0),"^",5)=DUZ
"RTN","VWREGIT",67,0)
 I $O(AR(0)) S RESULT(1)="[TEMPLATES]"
"RTN","VWREGIT",68,0)
 S N=0 F  S N=$O(AR(N)) Q:'+N  D
"RTN","VWREGIT",69,0)
 . Q:$E(AR(N))="*"
"RTN","VWREGIT",70,0)
 . Q:'+$P(AR(N),"(",2)
"RTN","VWREGIT",71,0)
 . Q:$P($G(^DIE(+$P(AR(N),"(",2),0)),"^",4)'=2  ;must be pat file
"RTN","VWREGIT",72,0)
 . S RESULT($$INR)=AR(N)
"RTN","VWREGIT",73,0)
 S RESULT($$INR)="[ID]"
"RTN","VWREGIT",74,0)
 ;S N=0 F  S N=$O(^DIZ(64850003,N)) Q:'+N  S RESULT($$INR)=$P(^(N,0),"^",2)_"("_$P(^(0),"^")_")"
"RTN","VWREGIT",75,0)
 ;S N=0 F  S N=$O(RESULT(N)) Q:'+N  K:RESULT(N)="" RESULT(N)
"RTN","VWREGIT",76,0)
 I '$O(RESULT(0)) S RESULT(1)="-1^No PATIENT FILE templates found"
"RTN","VWREGIT",77,0)
 K AR
"RTN","VWREGIT",78,0)
 Q
"RTN","VWREGIT",79,0)
 ;
"RTN","VWREGIT",80,0)
NPT(RESULT,TNAME) ;
"RTN","VWREGIT",81,0)
 ; *************************************************
"RTN","VWREGIT",82,0)
 ; * Incoming: DFN^TEMPLATE NAME(IEN)              *
"RTN","VWREGIT",83,0)
 ; * Process : Get template fields plus any help   *
"RTN","VWREGIT",84,0)
 ; *           If +TNAME (a DFN), get DFN data for *
"RTN","VWREGIT",85,0)
 ; *           the template fields (Put data in    *
"RTN","VWREGIT",86,0)
 ; *           $P(RESULT(N),"^",3))                *
"RTN","VWREGIT",87,0)
 ; * Return  : RESULT(N), etc                      *
"RTN","VWREGIT",88,0)
 ; *************************************************
"RTN","VWREGIT",89,0)
 ;W "  ;Intentional bust for debugging
"RTN","VWREGIT",90,0)
 N N,TNUM,FIELDS,F,FNAME,FVALUE,FHELP,FPSC,FNUM
"RTN","VWREGIT",91,0)
 S TNUM=+$P(TNAME,"(",2),DFN=+TNAME
"RTN","VWREGIT",92,0)
 I 'TNUM S RESULT(0)="0^new patient Template not found" Q
"RTN","VWREGIT",93,0)
 S TNAME=$P($P(TNAME,"^",2),"(")
"RTN","VWREGIT",94,0)
 S TNAME=$TR(TNAME,"$&*","")  ;Clean out TMENU chars
"RTN","VWREGIT",95,0)
 I TNAME="GENERIC INS. FRM [WorldVistA]" G GIF
"RTN","VWREGIT",96,0)
 S FIELDS=$G(^DIE(TNUM,"DR",1,2))
"RTN","VWREGIT",97,0)
 I '$L(FIELDS) Q
"RTN","VWREGIT",98,0)
 K RESULT S (FNUM,FCAP)=""
"RTN","VWREGIT",99,0)
 F I=1:1:$L(FIELDS,";")-1 D
"RTN","VWREGIT",100,0)
 . S F=$P(FIELDS,";",I)
"RTN","VWREGIT",101,0)
 . Q:'$D(^DD(2,F))  ;Not existing in this patient file
"RTN","VWREGIT",102,0)
 . I F["~" S FNUM=+F,FNAME=$P($P(F,"~"),FNUM,2),F=FNUM K FNUM
"RTN","VWREGIT",103,0)
 . S FNAME=$S($L($G(FNAME)):FNAME,$L($G(^DD(2,F,.1))):$P(^(.1),"^"),1:$P(^DD(2,F,0),"^"))
"RTN","VWREGIT",104,0)
 . S FVALUE=""  ;Patient Data
"RTN","VWREGIT",105,0)
 . S FHELP=$G(^DD(2,F,3))
"RTN","VWREGIT",106,0)
 . I F'=27.02,'$L(FHELP) S N=0 F  S N=$O(^DD(2,F,21,N)) Q:'+N  S FHELP=FHELP_^(N,0)
"RTN","VWREGIT",107,0)
 . S FHELP=$TR(FHELP,"'","`")
"RTN","VWREGIT",108,0)
 . S FPSC=$P(^DD(2,F,0),"^",3)
"RTN","VWREGIT",109,0)
 . S SUBDIC=+$P(^DD(2,F,0),"^",2)
"RTN","VWREGIT",110,0)
 . S RESULT($$INR)=FNAME_"^"_F_"^"_FVALUE_"^"_FHELP_"^"_FPSC_$S(SUBDIC:"^1",1:"^0")
"RTN","VWREGIT",111,0)
 . S (FNAME,FVALUE,FHELP,FPSC)=""
"RTN","VWREGIT",112,0)
 G NPTX:'DFN
"RTN","VWREGIT",113,0)
 I DFN D GETS^DIQ(2,DFN_",","**","EN","AR")  ;,RESULT(0)=$$DFNID^VWREGITU
"RTN","VWREGIT",114,0)
 K FIELD S N=0 F  S N=$O(RESULT(N)) Q:'+N  S FIELD($P(RESULT(N),"^",2))=""
"RTN","VWREGIT",115,0)
 S X="AR" F  S X=$Q(@X) Q:X=""  D
"RTN","VWREGIT",116,0)
 . S FILE=+$P(X,"(",2)
"RTN","VWREGIT",117,0)
 . S FIELD=+$P(X,",",$L(X,",")-1)
"RTN","VWREGIT",118,0)
 . I $D(FIELD(FIELD)) S FIELD(FIELD)=@X
"RTN","VWREGIT",119,0)
 S N=0 F  S N=$O(FIELD(N)) Q:'+N  D
"RTN","VWREGIT",120,0)
 . S N2=0 F  S N2=$O(RESULT(N2)) Q:'+N2  I $P(RESULT(N2),"^",2)=N S $P(RESULT(N2),"^",3)=FIELD(N)
"RTN","VWREGIT",121,0)
 . S RESULT(0)=$$DFNID^VWREGITU()
"RTN","VWREGIT",122,0)
NPTX K FIELD,AR,FCAP,FILE,SUBDIC,N,N2,DFN
"RTN","VWREGIT",123,0)
 Q
"RTN","VWREGIT",124,0)
 ;
"RTN","VWREGIT",125,0)
PF(RESULT,XPF) ;Pointer file - get the stuff
"RTN","VWREGIT",126,0)
 K RESULT,AR
"RTN","VWREGIT",127,0)
 N X,N
"RTN","VWREGIT",128,0)
 I '$L(XPF) S RESULT(0)="???" Q
"RTN","VWREGIT",129,0)
 S XPF="^"_XPF
"RTN","VWREGIT",130,0)
 I +$P(XPF,"(",2)=.85 G NAUTPF  ;Naughty file!
"RTN","VWREGIT",131,0)
 S N=0 F  S N=$O(@(XPF_N_")")) Q:'+N  S X=$P(^(N,0),"^"),AR(X,N)=X_"("_N_")"
"RTN","VWREGIT",132,0)
 S X="AR" F  S X=$Q(@X) Q:X=""  S RESULT($$INR)=@X
"RTN","VWREGIT",133,0)
 K AR
"RTN","VWREGIT",134,0)
 Q
"RTN","VWREGIT",135,0)
 ;
"RTN","VWREGIT",136,0)
NAUTPF ;The "NAUGHTY" pointer file - has a numeric .01 - Bad file !!!
"RTN","VWREGIT",137,0)
 S N=0 F  S N=$O(@(XPF_N_")")) Q:'+N  S X=$P(^(N,0),"^") D
"RTN","VWREGIT",138,0)
 . S LANG=$P(^(0),"^",2)
"RTN","VWREGIT",139,0)
 . S AR(LANG,N)=LANG_"("_N_")"
"RTN","VWREGIT",140,0)
 S X="AR" F  S X=$Q(@X) Q:X=""  S RESULT($$INR)=@X
"RTN","VWREGIT",141,0)
 Q
"RTN","VWREGIT",142,0)
GIF ;Generic Insurance form
"RTN","VWREGIT",143,0)
 K RESULT
"RTN","VWREGIT",144,0)
 S RESULT($$INR)="Insurance Company^2.312;.01^^^DIC(36,^0"
"RTN","VWREGIT",145,0)
 S RESULT($$INR)="Group Plan^2.312;.18^^^IBA(355.3,^0"
"RTN","VWREGIT",146,0)
 S RESULT($$INR)="Policy No.^2.312;1^^^^0"
"RTN","VWREGIT",147,0)
 ;S RESULT($$INR)="Type of Plan^^^^^0"
"RTN","VWREGIT",148,0)
 S RESULT($$INR)="Coverage^355.33;40.09^^^IBE(355.1,^0"
"RTN","VWREGIT",149,0)
 S RESULT($$INR)="Effective Date^2.312;8^^^^0"
"RTN","VWREGIT",150,0)
 S RESULT($$INR)="Expiration Date^.3121;^^^^0"
"RTN","VWREGIT",151,0)
 S RESULT($$INR)="Guarantor^^^^^0"
"RTN","VWREGIT",152,0)
 S RESULT($$INR)="Signature on File^^^^0:NO;1:YES^0"
"RTN","VWREGIT",153,0)
 S RESULT($$INR)="Employer^2.312;2.015^^^^0"
"RTN","VWREGIT",154,0)
 S RESULT($$INR)="Billing Address^2.312;2.02^^^^0"
"RTN","VWREGIT",155,0)
 S RESULT($$INR)="Billing Address(cont)^2.312;2.03^^^^0"
"RTN","VWREGIT",156,0)
 S RESULT($$INR)="Postal Code^2.312;2.07^^^^0"
"RTN","VWREGIT",157,0)
 S RESULT($$INR)="City^2.312;2.05^^^^0"
"RTN","VWREGIT",158,0)
 S RESULT($$INR)="County/Region/Area^^^^^0"
"RTN","VWREGIT",159,0)
 S RESULT($$INR)="State/Province/Region^2.312;2.06^^^DIC(5,^0"
"RTN","VWREGIT",160,0)
 Q
"RTN","VWREGIT",161,0)
 ;
"RTN","VWREGIT",162,0)
 
"RTN","VWREGIT2")
0^2^B7008432
"RTN","VWREGIT2",1,0)
VWREGIT2 ;Portland/WorldVista/BFP,LLC/Jim Bell, et al... - Post-Install for VWREG       
"RTN","VWREGIT2",2,0)
 ;;1.0;WORLD VISTA;**HOME **;;Build 1
"RTN","VWREGIT2",3,0)
 ;
"RTN","VWREGIT2",4,0)
 ;Continued from VWREGIT
"RTN","VWREGIT2",5,0)
 ;
"RTN","VWREGIT2",6,0)
 ;GNU License: See WVLIC.txt
"RTN","VWREGIT2",7,0)
 ;Modified FOIA VISTA,
"RTN","VWREGIT2",8,0)
 ;Copyright 2013 WorldVistA.  Licensed under the terms of the GNU
"RTN","VWREGIT2",9,0)
 Q
"RTN","VWREGIT2",10,0)
PRE ;Did this installation happen already? Avoid a re-do?
"RTN","VWREGIT2",11,0)
 I $O(^XMB(3.8,"B","VW REG ERROR REPORT",0))&($D(^XTV(8989.51,"B","VW GUI REG TEMPLATE DIRECTORY",0))) W !?5,"Installation has already occurred"
"RTN","VWREGIT2",12,0)
 W !,"Do you want to continue? NO//" R X:60 S:'$L(X) X="NO" S X=$$UP^XLFSTR(X)
"RTN","VWREGIT2",13,0)
 I "NON"[X W !,"OK" D ^XUSCLEAN
"RTN","VWREGIT2",14,0)
 Q
"RTN","VWREGIT2",15,0)
 ;
"RTN","VWREGIT2",16,0)
PI ;Post Installation install
"RTN","VWREGIT2",17,0)
 ;Checking for a home directory & file
"RTN","VWREGIT2",18,0)
 I $O(^XMB(3.8,"B","VW REG ERROR REPORT",0)) W !?5,"Installation has already occurred" Q
"RTN","VWREGIT2",19,0)
 S AR=1,AR(1)="[TEMPLATES]"
"RTN","VWREGIT2",20,0)
 S N=0 F  S N=$O(^DIE(N)) Q:'+N  S X=$P(^(N,0),"^") D
"RTN","VWREGIT2",21,0)
 . I X["VW " S AR($I(AR))=X_"("_N_")"
"RTN","VWREGIT2",22,0)
 . I X["[World" S AR($I(AR))=X_"("_N_")"
"RTN","VWREGIT2",23,0)
 S AR($I(AR))="[ID]"
"RTN","VWREGIT2",24,0)
 S P4=1,P5="",HD=$ZDIRECTORY_"regparam/",FILE="regit.txt"
"RTN","VWREGIT2",25,0)
 S X=$$GTF^%ZISH($NA(AR(1)),1,HD,"regit.txt")
"RTN","VWREGIT2",26,0)
 ZSY "chmod 777 "_$ZDIRECTORY_"regparam/"_FILE  ;No sensitive info here
"RTN","VWREGIT2",27,0)
 Q:$G(TEST)  ;Straightening out regit.txt
"RTN","VWREGIT2",28,0)
 ;
"RTN","VWREGIT2",29,0)
 ;; NOTE: The parameter definition is installed but there is no installation for
"RTN","VWREGIT2",30,0)
 ;;the actual parameter and value. Do it here.
"RTN","VWREGIT2",31,0)
 ;parameter value attempt
"RTN","VWREGIT2",32,0)
 ;Set a home directory for editing; SYSTEM (DIC(4,) and DOMAIN (DIC(4.2,) only:"/home/vista/regparam/"
"RTN","VWREGIT2",33,0)
 S PARD=$O(^XTV(8989.51,"B","VW GUI REG TEMPLATE DIRECTORY",0))
"RTN","VWREGIT2",34,0)
 I PARD D
"RTN","VWREGIT2",35,0)
 . L +^XTV(8989.5,0):1 D  L -^XTV(8989.5,0)
"RTN","VWREGIT2",36,0)
 .. S NEW=$O(^XTV(8989.5," "),-1)+1
"RTN","VWREGIT2",37,0)
 .. S $P(^XTV(8989.5,0),"^",3)=NEW
"RTN","VWREGIT2",38,0)
 .. S $P(^XTV(8989.5,0),"^",4)=$P(^(0),"^",4)+1
"RTN","VWREGIT2",39,0)
 .. S $P(^XTV(8989.5,NEW,0),"^")="1;DIC(4,"
"RTN","VWREGIT2",40,0)
 .. S $P(^XTV(8989.5,NEW,0),"^",2)=PARD
"RTN","VWREGIT2",41,0)
 .. S $P(^XTV(8989.5,NEW,0),"^",3)=1
"RTN","VWREGIT2",42,0)
 .. S ^XTV(8989.5,NEW,1)=HD
"RTN","VWREGIT2",43,0)
 .. S DA=NEW,DIK="^XTV(8989.5," D IX^DIK
"RTN","VWREGIT2",44,0)
 .. S NEW2=$O(^XTV(8989.5," "),-1)+1
"RTN","VWREGIT2",45,0)
 .. S $P(^XTV(8989.5,0),"^",3)=NEW2
"RTN","VWREGIT2",46,0)
 .. S $P(^XTV(8989.5,0),"^",4)=$P(^(0),"^",4)+1
"RTN","VWREGIT2",47,0)
 .. S $P(^XTV(8989.5,NEW2,0),"^")="9;DIC(4.2,"
"RTN","VWREGIT2",48,0)
 .. S $P(^XTV(8989.5,NEW2,0),"^",2)=PARD
"RTN","VWREGIT2",49,0)
 .. S $P(^XTV(8989.5,NEW2,0),"^",3)=1
"RTN","VWREGIT2",50,0)
 .. S ^XTV(8989.5,NEW2,1)=HD
"RTN","VWREGIT2",51,0)
 .. S DA=NEW2,DIK="^XTV(8989.5," D IX^DIK
"RTN","VWREGIT2",52,0)
 ;
"RTN","VWREGIT2",53,0)
 ;Mailgroup VW REG ERROR REPORT - add programmer's email
"RTN","VWREGIT2",54,0)
 S DA(1)=$O(^XMB(3.8,"B","VW REG ERROR REPORT",0))
"RTN","VWREGIT2",55,0)
 Q:'DA(1)
"RTN","VWREGIT2",56,0)
 S DIC="^XMB(3.8,"_DA(1)_",6,"
"RTN","VWREGIT2",57,0)
 S X="jbellco65@gmail.com"
"RTN","VWREGIT2",58,0)
 S DIC(0)="LZ"
"RTN","VWREGIT2",59,0)
 D FILE^DICN
"RTN","VWREGIT2",60,0)
 Q
"RTN","VWREGIT2",61,0)
 ;
"RTN","VWREGIT3")
0^3^B4498
"RTN","VWREGIT3",1,0)
VWREGIT3 ;VWEHR/BFProd-Jim Bell, et al - World VistA GUI Pat Reg Utility
"RTN","VWREGIT3",2,0)
 ;;1.0;WORLD VISTA;** **;;Build 1
"RTN","VWREGIT3",3,0)
 ;
"RTN","VWREGIT3",4,0)
 ;This routine utility is for patient specific fields and
"RTN","VWREGIT3",5,0)
 ;is used to build input templates for registration
"RTN","VWREGIT3",6,0)
 ;
"RTN","VWREGIT3",7,0)
 ;GNU License: See WVLIC.txt
"RTN","VWREGIT3",8,0)
 ;Modified FOIA VISTA,
"RTN","VWREGIT3",9,0)
 ;Copyright 2013 WorldVistA.  Licensed under the terms of the GNU
"RTN","VWREGIT3",10,0)
 Q
"RTN","VWREGIT3",11,0)
 ;
"RTN","VWREGITP")
0^4^B5382212
"RTN","VWREGITP",1,0)
VWREGITP ;BFP/Portland,OR-Jim Bell,et al - Client Registration Utility
"RTN","VWREGITP",2,0)
        ;2.0;BFP for WorldVistA;**LOCAL**;;;Build 1
"RTN","VWREGITP",3,0)
 ; *******************************************
"RTN","VWREGITP",4,0)
 ; * Copyright 2015 ad infinitum et ultra    *
"RTN","VWREGITP",5,0)
 ; * Gets data for existing clients/patients *
"RTN","VWREGITP",6,0)
 ; * GPL License: See License.txt            *
"RTN","VWREGITP",7,0)
 ; *******************************************
"RTN","VWREGITP",8,0)
 Q  ;No fall through - jeb
"RTN","VWREGITP",9,0)
 ;
"RTN","VWREGITP",10,0)
GPD(RESULT,DATA) ;Get patient data
"RTN","VWREGITP",11,0)
 ; ********************************* 8888***
"RTN","VWREGITP",12,0)
 ; * DATA_____TEMPLATE(IEN)^FIELDSET^DFN   *
"RTN","VWREGITP",13,0)
 ; * TEMPLATE__The name(IEN) of a          *
"RTN","VWREGITP",14,0)
 ; *            stored template            *
"RTN","VWREGITP",15,0)
 ; * FIELDSET_Adhoc fields in a string     *
"RTN","VWREGITP",16,0)
 ; *          as ".01;3;5;.131", etc       *
"RTN","VWREGITP",17,0)
 ; * DFN______IEN of patient file(#2)      *
"RTN","VWREGITP",18,0)
 ; * NOTE: TEMPLATE takes precedence       *
"RTN","VWREGITP",19,0)
 ; *       over FIELDSET                   *
"RTN","VWREGITP",20,0)
 ; *****************************************
"RTN","VWREGITP",21,0)
 ;
"RTN","VWREGITP",22,0)
 K RESULT,AR
"RTN","VWREGITP",23,0)
 N VAR,TNUM,FSET,F,DFN
"RTN","VWREGITP",24,0)
 I '$L(DATA) S RESULT(0)="No information relayed. Please try again" Q
"RTN","VWREGITP",25,0)
 I $P(DATA,"^",3)="" S RESULT(0)="Patient info not relayed. Please try again" Q
"RTN","VWREGITP",26,0)
 S VAR="TNUM^ADHOC^DFN" F I=1:1:3 S @$P(VAR,"^",I)=$P(DATA,"^",I)
"RTN","VWREGITP",27,0)
 S TNUM=$S(TNUM["(":+$P(TNUM,"(",2),1:TNUM)
"RTN","VWREGITP",28,0)
 S DFN=+$P($P(DATA,"^",3),"(",2)
"RTN","VWREGITP",29,0)
 S FSET=$S(TNUM:^DIE(TNUM,"DR",1,2),'TNUM&($L(ADHOC)):ADHOC,1:"")
"RTN","VWREGITP",30,0)
 D GETS^DIQ(2,DFN_",","**","N","AR")
"RTN","VWREGITP",31,0)
 F I=1:1:$L(FSET,";") D
"RTN","VWREGITP",32,0)
 . Q:'$L($P(FSET,";",I))
"RTN","VWREGITP",33,0)
 . S F=+$P(FSET,";",I)
"RTN","VWREGITP",34,0)
 . S RESULT($$INR^VWREGIT)=F_"^"_$G(AR(2,DFN_",",F))
"RTN","VWREGITP",35,0)
 Q
"RTN","VWREGITP",36,0)
GPDM(RESULT,DATA) ;
"RTN","VWREGITP",37,0)
 ; ****************************************************************
"RTN","VWREGITP",38,0)
 ; * DATA____Parent Text^Parent field #^PATIENT IEN^TEMPLATE(IEN) *
"RTN","VWREGITP",39,0)
 ; ****************************************************************
"RTN","VWREGITP",40,0)
 N F,SUBD,DFN,PIEN,X,RIND,FILE,X,Y,TNUM
"RTN","VWREGITP",41,0)
 K MX,MAR,RESULT,AR
"RTN","VWREGITP",42,0)
 S DFN=+$P(DATA,"^",3)
"RTN","VWREGITP",43,0)
 S F=+$P(DATA,"^",2)
"RTN","VWREGITP",44,0)
 S TNUM=+$P($P(DATA,"^",4),"(",2)
"RTN","VWREGITP",45,0)
 D GETS^DIQ(2,DFN_",",F_"*;","E","AR")
"RTN","VWREGITP",46,0)
 S SUBD=+$P(^DD(2,F,0),"^",2) D:+SUBD  ;Multiple field values
"RTN","VWREGITP",47,0)
 . S MX="AR("_SUBD_")" F  S MX=$Q(@MX) Q:MX=""!(+$P(MX,"(",2)'=SUBD)  D:$P(MX,",",$L(MX,",")-1)'=.01
"RTN","VWREGITP",48,0)
 .. S FILE=SUBD,PIEN=$P(MX,",",2,$L(MX,",")-1),PIEN=$TR(PIEN,"""","")
"RTN","VWREGITP",49,0)
 .. K MAR,IMAR
"RTN","VWREGITP",50,0)
 .. D GETS^DIQ(FILE,PIEN,"**","E","MAR")
"RTN","VWREGITP",51,0)
 .. D GETS^DIQ(FILE,PIEN,"**","I","IMAR")
"RTN","VWREGITP",52,0)
 .. S X=$Q(@"MAR"),Y=$Q(@"IMAR")
"RTN","VWREGITP",53,0)
 .. I @X'=@Y S @X=@X_"("_@Y_")"
"RTN","VWREGITP",54,0)
 .. S X="MAR"  ;,RIND=$$INR^VWREGIT
"RTN","VWREGITP",55,0)
 .. S RIND=$$INR^VWREGIT,RESULT(RIND)="" F  S X=$Q(@X) Q:X=""  S RESULT(RIND)=RESULT(RIND)_@X_"^"
"RTN","VWREGITP",56,0)
 K AR,MAR,IMAR,MX
"RTN","VWREGITP",57,0)
 Q
"RTN","VWREGITS")
0^5^B15352111
"RTN","VWREGITS",1,0)
VWREGITS ;Portland,OR/jeb et al Save utility for VWREG* routines 11/2015
"RTN","VWREGITS",2,0)
 ;V.2;;**LOCAL**;;;Build 1
"RTN","VWREGITS",3,0)
 ;c2014 ad infiniti, BellFelder Productions (BF Productions) & WorldVistA
"RTN","VWREGITS",4,0)
 ;License: See License.txt that with install
"RTN","VWREGITS",5,0)
 ;No fall thru - jeb
"RTN","VWREGITS",6,0)
 Q
"RTN","VWREGITS",7,0)
 ;
"RTN","VWREGITS",8,0)
 ;* *****************************************************************
"RTN","VWREGITS",9,0)
 ;* Data coming in may be for a new case or existing case           *
"RTN","VWREGITS",10,0)
 ;* Incoming: Array LDATA=                                          *
"RTN","VWREGITS",11,0)
 ;*   LDATA(1)=Field^Field number^value^[optional]DFN               *
"RTN","VWREGITS",12,0)
 ;*                       LDATA(N...)=Field^Field number^value      *
"RTN","VWREGITS",13,0)
 ;* Exception for Multiples:                                        *
"RTN","VWREGITS",14,0)
 ;*   LDATA(N)=Field(SUBDD;Field number):value(IEN)^...etc for every*
"RTN","VWREGITS",15,0)
 ;*            field that is a dependent of the parent              *
"RTN","VWREGITS",16,0)
 ;* Process:                                                        *
"RTN","VWREGITS",17,0)
 ;*  1. call is at Label SAVE                                       *
"RTN","VWREGITS",18,0)
 ;*  2. Some housekeeping that this programmer needs to do proper   *
"RTN","VWREGITS",19,0)
 ;*     string evaluations.                                         *
"RTN","VWREGITS",20,0)
 ;*  3. Filing of a new case with FILE^DICN.                        *
"RTN","VWREGITS",21,0)
 ;*  4. Remaining major fields are filed with DIE                   *
"RTN","VWREGITS",22,0)
 ;*  5. Multiples are filed with UPDATE^DIE                         *
"RTN","VWREGITS",23,0)
 ;*  6. Existing entries will contain only edited data and will     *
"RTN","VWREGITS",24,0)
 ;*     address those fields as in 4 & 5.                           *
"RTN","VWREGITS",25,0)
 ;* Bon Appettit, et al.                                            *
"RTN","VWREGITS",26,0)
 ;*******************************************************************
"RTN","VWREGITS",27,0)
SAVE(RESULT,LDATA) ;
"RTN","VWREGITS",28,0)
 K RESULT,^DIZ("DS",$J)
"RTN","VWREGITS",29,0)
 M ^DIZ("DS",$J)=LDATA
"RTN","VWREGITS",30,0)
 ;Q ;Testing
"RTN","VWREGITS",31,0)
 N DFN,DIC,DA,DR,VAR,FIELD,N,N1,X,Y,DIE,DIK
"RTN","VWREGITS",32,0)
 I $D(LDATA)<10 S RESULT(0)="-1: No data sent for filing. Please contact your IT dept." Q
"RTN","VWREGITS",33,0)
 ;UPcase everyTHING
"RTN","VWREGITS",34,0)
 S XDAT="LDATA" F  S XDAT=$Q(@XDAT) Q:XDAT=""  S @XDAT=$$UP^XLFSTR(@XDAT)
"RTN","VWREGITS",35,0)
 ;
"RTN","VWREGITS",36,0)
 ;Incoming housekeeping
"RTN","VWREGITS",37,0)
 S X="LDATA" F I=1:1 S X=$Q(@X) Q:X=""  I @X[":",@X[";" S ^DIZ("DS",$J,I)=@X K @X
"RTN","VWREGITS",38,0)
 I +$P(@$Q(LDATA),"^",4)!(+$P(@$Q(LDATA),"(",2)) G EXP ;DFN sent by client
"RTN","VWREGITS",39,0)
 S N=0 F  S N=$O(LDATA(N)) Q:'+N  I +$P($G(^DD(2,+$P(LDATA(N),"^",2),0)),"^",2) K LDATA(N)
"RTN","VWREGITS",40,0)
 S DFN=$$FIND1^DIC(2,"","M",$P(LDATA(1),"^",3),"","","ERR")
"RTN","VWREGITS",41,0)
 G EXP:DFN  ;Found patient/client
"RTN","VWREGITS",42,0)
 ;End housekeeping;
"RTN","VWREGITS",43,0)
 ;
"RTN","VWREGITS",44,0)
 S X=$P(LDATA(1),"^",3) D
"RTN","VWREGITS",45,0)
 . S DIC="^DPT(",DIC(0)="LZ" K D0 D FILE^DICN S (DA,DFN)=+Y
"RTN","VWREGITS",46,0)
 . S DIC="^AUPNPAT(",DIC(0)="LZ",X=DFN,DINUM=X,DIC(0)="L" D FILE^DICN
"RTN","VWREGITS",47,0)
 . S DIE=DIC,DR=.03_"////^S X=DT" D ^DIE
"RTN","VWREGITS",48,0)
 . S DR=.11_"////^S X=DUZ" D ^DIE
"RTN","VWREGITS",49,0)
LDPT L +^DPT(DFN):1 G LDPT:'$T
"RTN","VWREGITS",50,0)
 S N=1 F  S N=$O(LDATA(N)) Q:'+N  D
"RTN","VWREGITS",51,0)
 . Q:$P(LDATA(N),"^",2)[";"
"RTN","VWREGITS",52,0)
 . Q:'+$P(LDATA(N),"^",2)  ;Marker of some kind
"RTN","VWREGITS",53,0)
 . S FIELD=$P(LDATA(N),"^",2)
"RTN","VWREGITS",54,0)
 . S VAR=$P(LDATA(N),"^",3)
"RTN","VWREGITS",55,0)
 . I FIELD=.03 D
"RTN","VWREGITS",56,0)
 .. S VAR=$$DC(VAR)
"RTN","VWREGITS",57,0)
 .. S VARTIME=$P(VAR,".",2),VAR=$P(VAR,".")
"RTN","VWREGITS",58,0)
 .. I $L(VARTIME) D
"RTN","VWREGITS",59,0)
 ... N FDA
"RTN","VWREGITS",60,0)
 ... S FDA(2,DFN_",",540000.1)=VARTIME
"RTN","VWREGITS",61,0)
 ... D FILE^DIE("E","FDA")
"RTN","VWREGITS",62,0)
 ... D CLEAN^DILF
"RTN","VWREGITS",63,0)
 . S:VAR["(" VAR=$S($L(VAR,"(")>2:+$P(VAR,"(",$L(VAR,"(")),1:+$P(VAR,"(",2))
"RTN","VWREGITS",64,0)
 . S DIE="^DPT(",DR=FIELD_"///"_$S(+VAR:"/",1:"")_"^S X=VAR" D ^DIE
"RTN","VWREGITS",65,0)
 L -^DPT(DFN)
"RTN","VWREGITS",66,0)
 D M  ;File any multiple fields
"RTN","VWREGITS",67,0)
 S RESULT(0)="Filed..."
"RTN","VWREGITS",68,0)
 K ^DIZ("DS",$J)
"RTN","VWREGITS",69,0)
 Q
"RTN","VWREGITS",70,0)
 ;
"RTN","VWREGITS",71,0)
EXP ;Existing Patient
"RTN","VWREGITS",72,0)
 K X,FNAME,FFLD,FVALUE,AR,DIC,DA,DR,DIE,AR
"RTN","VWREGITS",73,0)
 S X="LDATA" F  S X=$Q(@X) Q:X=""  I @X[":" S AR($O(AR(" "),-1)+1)=@X K @X
"RTN","VWREGITS",74,0)
 S N=0 F  S N=$O(LDATA(N)) Q:'+N  S X=LDATA(N) D
"RTN","VWREGITS",75,0)
 . S FNAME=$P(X,"^")
"RTN","VWREGITS",76,0)
 . S FFLD=$P(X,"^",2)
"RTN","VWREGITS",77,0)
 . S FVALUE=$S($P(X,"^",3)["(":+$P(X,"(",2),1:$P(X,"^",3))
"RTN","VWREGITS",78,0)
 . S DFN=$P(X,"^",4)
"RTN","VWREGITS",79,0)
 . S DIE="^DPT(",DA=DFN,DR=FFLD_"///^S X=FVALUE" D ^DIE
"RTN","VWREGITS",80,0)
 D M
"RTN","VWREGITS",81,0)
 S RESULT($I(RESULT))="Filed..."
"RTN","VWREGITS",82,0)
 K X,FNAME,FFL,FVALUE,DFN,AR,DIE,DA,DR,DIC
"RTN","VWREGITS",83,0)
 Q
"RTN","VWREGITS",84,0)
 ;
"RTN","VWREGITS",85,0)
M ;File any multiples values; DFN should be defined above
"RTN","VWREGITS",86,0)
 Q:'$D(^DIZ("DS",$J))
"RTN","VWREGITS",87,0)
 M MULTS=^DIZ("DS",$J)
"RTN","VWREGITS",88,0)
 K MAR S N=0 F  S N=$O(MULTS(N)) Q:'+N  D
"RTN","VWREGITS",89,0)
 . F J=1:1:$L(MULTS(N),"^")-1 S MAR(J)=$P(MULTS(N),"^",J)
"RTN","VWREGITS",90,0)
 . S MX=$O(MAR(0))
"RTN","VWREGITS",91,0)
 . S MXFILE=+$P(MAR(MX),"(",2)
"RTN","VWREGITS",92,0)
 . S MXFLD=+$P(MAR(MX),";",2)
"RTN","VWREGITS",93,0)
 . S MXVAL=$P($P(MAR(MX),":",2),"(")
"RTN","VWREGITS",94,0)
 . I MXFLD=.01 S MXDATA(MXFILE,"?+1,"_DFN_",",MXFLD)=MXVAL K IEN D UPDATE^DIE("E","MXDATA","IEN","ERROR") Q:$G(DIERR)  D
"RTN","VWREGITS",95,0)
 .. S RECORD=$G(IEN(1)),INC=$G(IEN(1,0))
"RTN","VWREGITS",96,0)
 .. S J=MX F  S J=$O(MAR(J)) Q:'+J  D
"RTN","VWREGITS",97,0)
 ... s MXFILE=+$P(MAR(J),"(",2)
"RTN","VWREGITS",98,0)
 ... S MXFLD=+$P(MAR(J),";",2)
"RTN","VWREGITS",99,0)
 ... S MXVAL=$P(MAR(J),":",2),MXVAL=$S(MXVAL["(":$P(MXVAL,"("),1:MXVAL)
"RTN","VWREGITS",100,0)
 ... S MXDATA(MXFILE,$S(MXFLD=.01:INC,1:"")_"1,"_RECORD_","_DFN_",",MXFLD)=MXVAL
"RTN","VWREGITS",101,0)
 ... K IEN,ERROR D UPDATE^DIE("E","MXDATA","IEN","ERROR")
"RTN","VWREGITS",102,0)
 Q
"RTN","VWREGITS",103,0)
 ;
"RTN","VWREGITS",104,0)
DC(XDATE) ;Convert DOB to internal
"RTN","VWREGITS",105,0)
 N %DT,X
"RTN","VWREGITS",106,0)
 S X=XDATE,%DT="T" D ^%DT
"RTN","VWREGITS",107,0)
 Q Y
"RTN","VWREGITS",108,0)
 ;
"RTN","VWREGITS",109,0)
INSUR ;Insurance/Billing
"RTN","VWREGITS",110,0)
 Q
"RTN","VWREGITS",111,0)
 ;
"RTN","VWREGITS",112,0)
K S DA=$P(^DPT(0),"^",3),DIK="^DPT(" D ^DIK
"RTN","VWREGITS",113,0)
 S DIK="^AUPNPAT(" D ^DIK
"RTN","VWREGITS",114,0)
 Q
"RTN","VWREGITS",115,0)
 ;
"RTN","VWREGITT")
0^6^B38020021
"RTN","VWREGITT",1,0)
VWREGITT ;Portland\Jim Bell, BFP,LLC Input Template Management 2016
"RTN","VWREGITT",2,0)
 ;2.0**LOCAL** Copyright April 2016 ad infinitum;;;;;Build 1
"RTN","VWREGITT",3,0)
 ;*****************************************************************
"RTN","VWREGITT",4,0)
 ;* Licensed under GNU 2.0 or greater - see license.txt file      *
"RTN","VWREGITT",5,0)
 ;* Program/application is for the management of input templates  *
"RTN","VWREGITT",6,0)
 ;* owned by the user (DUZ).                                      *
"RTN","VWREGITT",7,0)
 ;* REMINDER: All template fields pertain only to the Patient File*
"RTN","VWREGITT",8,0)
 ;*  (#2)!                                                        *
"RTN","VWREGITT",9,0)
 ;*****************************************************************
"RTN","VWREGITT",10,0)
 Q  ;No fall through
"RTN","VWREGITT",11,0)
 ;
"RTN","VWREGITT",12,0)
AUTH(TUSER,TNUM) ;Can user edit or is IT CONTROL
"RTN","VWREGITT",13,0)
 N TMO
"RTN","VWREGITT",14,0)
 S TMO=$O(^DIC(19,"B","VW REG IT CONTROL",0)) I $D(^VA(200,TUSER,203,"B",TMO)) Q 1
"RTN","VWREGITT",15,0)
 S TMO=$O(^DIC(19,"B","VW PATIENT REGISTRATION",0))
"RTN","VWREGITT",16,0)
 I TMO,$P(^DIE(TNUM,0),"^",5)=TUSER Q 1
"RTN","VWREGITT",17,0)
 Q 0
"RTN","VWREGITT",18,0)
 ;
"RTN","VWREGITT",19,0)
INR() Q $O(RESULT(" "),-1)+1
"RTN","VWREGITT",20,0)
 ;
"RTN","VWREGITT",21,0)
CF(FIELD) ;If a computed field, 0, else 1
"RTN","VWREGITT",22,0)
 I $P($G(^DD(2,FIELD,0)),"^",2)["C" Q 0
"RTN","VWREGITT",23,0)
 Q 1
"RTN","VWREGITT",24,0)
 ;
"RTN","VWREGITT",25,0)
EGF(RESULT,TNAME) ;Get fields for client editing via TName
"RTN","VWREGITT",26,0)
 ;*************************
"RTN","VWREGITT",27,0)
 ;* Incoming___TNAME(IEN) *
"RTN","VWREGITT",28,0)
 ;*************************
"RTN","VWREGITT",29,0)
 K RESULT  ;N TNUM,TNAME,PF,SF
"RTN","VWREGITT",30,0)
 S TNUM=+$P(TNAME,"(",2)
"RTN","VWREGITT",31,0)
 S TNAME=$P(TNAME,"(")
"RTN","VWREGITT",32,0)
 I 'TNUM!('$D(^DIE(TNUM))) S RESULT(0)="Template name or number not found in Template file" Q
"RTN","VWREGITT",33,0)
 ;Check for authorization
"RTN","VWREGITT",34,0)
 I '$$AUTH(DUZ,TNUM) S RESULT(0)="Sorry, you are not authorized to edit this template." Q
"RTN","VWREGITT",35,0)
 S RESULT(0)="Editing "_TNAME_"("_TNUM_")"
"RTN","VWREGITT",36,0)
 S PF=$G(^DIE(TNUM,"DR",1,2))
"RTN","VWREGITT",37,0)
 F I=1:1:$L(PF,";") D:$P(PF,";",I) 
"RTN","VWREGITT",38,0)
 . S RESULT($$INR)=$P(^DD(2,$P(PF,";",I),0),"^")_"("_$P(PF,";",I)_")"
"RTN","VWREGITT",39,0)
 . S SDD=+$P(^DD(2,$P(PF,";",I),0),"^",2) D:SDD
"RTN","VWREGITT",40,0)
 .. S SDN=1 F  S SDN=$O(^DIE(TNUM,"DR",SDN)) Q:'SDN  S:$O(^(SDN,0))=SDD SF=^(SDD) D
"RTN","VWREGITT",41,0)
 ... F J=1:1:$L(SF,";") D:$P(SF,";",J)
"RTN","VWREGITT",42,0)
 .... S SFF=$P(^DIE(TNUM,"DR",SDN,SDD),";",J)
"RTN","VWREGITT",43,0)
 .... S RESULT($$INR)="  SF  "_$P(^DD(SDD,SFF,0),"^")_"("_SFF_";"_SDD_")"
"RTN","VWREGITT",44,0)
 Q
"RTN","VWREGITT",45,0)
 ;
"RTN","VWREGITT",46,0)
SFLDS ;Get sub-fields and dics
"RTN","VWREGITT",47,0)
 K MULT N N,X,I,Y
"RTN","VWREGITT",48,0)
 S Y="",N=0 F  S N=$O(TDATA(N)) Q:'+N  D
"RTN","VWREGITT",49,0)
 . Q:TDATA(N)'["  SF"  ;Still a major field
"RTN","VWREGITT",50,0)
 . F I=N:1:$O(TDATA(" "),-1) S X=TDATA(I) Q:X'["  SF"  S MULT(+$P(X,";",2),+$P(X,"(",2))=""
"RTN","VWREGITT",51,0)
 Q
"RTN","VWREGITT",52,0)
 ;
"RTN","VWREGITT",53,0)
FIELDS() ;
"RTN","VWREGITT",54,0)
 N FLDLIST,N,X,FLD K MULT
"RTN","VWREGITT",55,0)
 S FLDLIST=""
"RTN","VWREGITT",56,0)
 S N=0 F  S N=$O(TDATA(N)) Q:'+N  D:TDATA(N)'["  SF"
"RTN","VWREGITT",57,0)
 . S FLD=+$P(TDATA(N),"(",2)
"RTN","VWREGITT",58,0)
 . Q:'$$CF(+$P(TDATA(N),"(",2))  ;Computed field
"RTN","VWREGITT",59,0)
 . S FLDLIST=FLDLIST_FLD_";"
"RTN","VWREGITT",60,0)
 ;Collate thru for multiple fields:entry looks like "  SF  "
"RTN","VWREGITT",61,0)
 S N=0 F  S N=$O(TDATA(N)) Q:'+N  D:TDATA(N)["  SF"
"RTN","VWREGITT",62,0)
 . S X=$P(TDATA(N),"  ",3)
"RTN","VWREGITT",63,0)
 . S SDD=+$P(X,";",2)
"RTN","VWREGITT",64,0)
 . S SFL=+$P(X,"(",2)
"RTN","VWREGITT",65,0)
 . S MULT(SDD,SFL)=""
"RTN","VWREGITT",66,0)
 S N=0 F  S N=$O(MULT(N)) Q:'+N  D  S SUB(N)=MF
"RTN","VWREGITT",67,0)
 . S MF="",N2=0 F  S N2=$O(MULT(N,N2)) Q:'+N2  S MF=MF_N2_";"
"RTN","VWREGITT",68,0)
 K MULT
"RTN","VWREGITT",69,0)
 Q FLDLIST
"RTN","VWREGITT",70,0)
 ;
"RTN","VWREGITT",71,0)
RTF(RESULT) ;Send a refresh of regit.txt to client
"RTN","VWREGITT",72,0)
 K AR,RESULT
"RTN","VWREGITT",73,0)
 D LTF
"RTN","VWREGITT",74,0)
 M RESULT=AR
"RTN","VWREGITT",75,0)
 K AR
"RTN","VWREGITT",76,0)
 Q
"RTN","VWREGITT",77,0)
 ;
"RTN","VWREGITT",78,0)
LTF ;Load the regit.txt file into AR()
"RTN","VWREGITT",79,0)
 S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
"RTN","VWREGITT",80,0)
 S FILE="regit.txt"
"RTN","VWREGITT",81,0)
 S P4=1
"RTN","VWREGITT",82,0)
 S P5=""
"RTN","VWREGITT",83,0)
 S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
"RTN","VWREGITT",84,0)
 Q
"RTN","VWREGITT",85,0)
 ;
"RTN","VWREGITT",86,0)
FTF ;File the AR() to regit.txt
"RTN","VWREGITT",87,0)
 ZSY "cp "_HD_"regit.txt "_HD_"regitbu.txt"
"RTN","VWREGITT",88,0)
 S P4=1,P5="",FILE="regit.txt"
"RTN","VWREGITT",89,0)
 S X=$$GTF^%ZISH($NA(AR(1)),1,HD,FILE)
"RTN","VWREGITT",90,0)
 Q
"RTN","VWREGITT",91,0)
 ;
"RTN","VWREGITT",92,0)
ITCNTRL(USER) ;Check for control capability and user authorization
"RTN","VWREGITT",93,0)
 N ITCNTRL
"RTN","VWREGITT",94,0)
 S ITCNTRL=$O(^DIC(19,"B","VW REG IT CONTROL",0))
"RTN","VWREGITT",95,0)
 I 'ITCNTRL D  Q 0
"RTN","VWREGITT",96,0)
 . S VAL=0
"RTN","VWREGITT",97,0)
 . S RESULT(0)="-1^VW REGISTRATION does not appear to be complete."
"RTN","VWREGITT",98,0)
 . S RESULT(1)="Please contact your Supervisor or IT support."
"RTN","VWREGITT",99,0)
 . S RESULT(2)="Thank you,"
"RTN","VWREGITT",100,0)
 . S RESULT(3)="The Management"
"RTN","VWREGITT",101,0)
 I '$D(^VA(200,USER,203,"B",ITCNTRL)) D  Q 0
"RTN","VWREGITT",102,0)
 . S RESULT(0)="-1^User does not have authorization to modify/create"
"RTN","VWREGITT",103,0)
 . S RESULT(1)="input templates. Please contact your Supervisor or"
"RTN","VWREGITT",104,0)
 . S RESULT(2)="IT support. Or, questions can be referred to Jim"
"RTN","VWREGITT",105,0)
 . S RESULT(3)="Bell at jbellco65@gmail.com"
"RTN","VWREGITT",106,0)
 . S RESULT(4)="Thank you."
"RTN","VWREGITT",107,0)
 Q 1
"RTN","VWREGITT",108,0)
 ;
"RTN","VWREGITT",109,0)
EN(RESULT,TDATA) ;
"RTN","VWREGITT",110,0)
 ;************************************************
"RTN","VWREGITT",111,0)
 ;* Call from Client                             *
"RTN","VWREGITT",112,0)
 ;* TDATA Array:                                 *
"RTN","VWREGITT",113,0)
 ;*   0____Template Name^DUZ^ACTION^WRITEACCESS  *
"RTN","VWREGITT",114,0)
 ;*   1-n__Field name(number)                    *
"RTN","VWREGITT",115,0)
 ;************************************************
"RTN","VWREGITT",116,0)
 ; -- testing --
"RTN","VWREGITT",117,0)
 ;M ^DIZ("TDATA",$J)=TDATA
"RTN","VWREGITT",118,0)
 ;Q
"RTN","VWREGITT",119,0)
 ; -- end testing --
"RTN","VWREGITT",120,0)
 ;
"RTN","VWREGITT",121,0)
 N TNAME,TNUM,ITCNTRL,ACTION,FIELDS,CALLER
"RTN","VWREGITT",122,0)
 S CALLER=""
"RTN","VWREGITT",123,0)
 S X="TDATA" F  S X=$Q(@X) Q:X=""  S @X=$$UP^XLFSTR(@X)  ;Upcase everyTHING
"RTN","VWREGITT",124,0)
 I '$L($G(HD)) S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
"RTN","VWREGITT",125,0)
 S WHO=$P(TDATA(0),"^",2)
"RTN","VWREGITT",126,0)
 S ITCNTRL=$$ITCNTRL(WHO)  ;1=full action;0=create/edit own template(s)
"RTN","VWREGITT",127,0)
 S TNUM=+$P($P(TDATA(0),"^"),"(",2)
"RTN","VWREGITT",128,0)
 S TNAME=$P($P(TDATA(0),"^"),"(")
"RTN","VWREGITT",129,0)
 I TNAME["Editing" S SPEC("Editing ")="",TNAME=$$REPLACE^XLFSTR(TNAME,.SPEC)
"RTN","VWREGITT",130,0)
 S ACTION=$P(TDATA(0),"^",3)
"RTN","VWREGITT",131,0)
 S WRITEACC=$S($P(TDATA(0),"^",4)="SELF":$P(^VA(200,DUZ,0),"^",4),1:"")
"RTN","VWREGITT",132,0)
 S FIELDS=$$FIELDS
"RTN","VWREGITT",133,0)
 I '$L(ACTION) S RESULT(0)="-1^No action sent. I don't know what to do." Q
"RTN","VWREGITT",134,0)
 D @ACTION
"RTN","VWREGITT",135,0)
 Q
"RTN","VWREGITT",136,0)
 ;
"RTN","VWREGITT",137,0)
CREATE ;Create a new input template
"RTN","VWREGITT",138,0)
 ;******************************
"RTN","VWREGITT",139,0)
 ;* Check for computed fields  *
"RTN","VWREGITT",140,0)
 ;******************************
"RTN","VWREGITT",141,0)
 K RESULT N %DT,X,Y
"RTN","VWREGITT",142,0)
 S %DT="TS",X="NOW" D ^%DT S FDATE=Y
"RTN","VWREGITT",143,0)
 S X=TNAME,DIC="^DIE(",DIC(0)="LZ" D FILE^DICN
"RTN","VWREGITT",144,0)
 S $P(^DIE(+Y,0),"^",2)=FDATE,$P(^(0),"^",3)="",$P(^(0),"^",4)=2,$P(^(0),"^",5)=DUZ
"RTN","VWREGITT",145,0)
 S $P(^DIE(+Y,0),"^",6)=WRITEACC
"RTN","VWREGITT",146,0)
C2 S ^DIE(+Y,"DR",1,2)=FIELDS
"RTN","VWREGITT",147,0)
 ;Do mult fields here
"RTN","VWREGITT",148,0)
 S N=0 F  S N=$O(SUB(N)) Q:'+N  D
"RTN","VWREGITT",149,0)
 . S UP=^DD(N,0,"UP")
"RTN","VWREGITT",150,0)
 . I UP=2 S ^DIE(+Y,"DR",$O(^DIE(+Y,"DR"," "),-1)+1,N)=SUB(N)
"RTN","VWREGITT",151,0)
 . E  S ^DIE(+Y,"DR",$O(^DIE(+Y,"DR"," "),-1),N)=SUB(N)
"RTN","VWREGITT",152,0)
 I $P(^DIE(+Y,0),"^")=$P(TDATA(0),"^") S RESULT(0)=$P(Y,"^",2)_" filed"
"RTN","VWREGITT",153,0)
 Q:CALLER="EDIT"
"RTN","VWREGITT",154,0)
 S TNUM=+Y,TNAME=$P(Y,"^",2)
"RTN","VWREGITT",155,0)
 K AR
"RTN","VWREGITT",156,0)
 D LTF  ;Get the regit.txt file loaded into AR()
"RTN","VWREGITT",157,0)
 S LAST=$O(AR(" "),-1)
"RTN","VWREGITT",158,0)
 S AR(LAST)=TNAME_"("_TNUM_")"
"RTN","VWREGITT",159,0)
 S AR(LAST+1)="[ID]"
"RTN","VWREGITT",160,0)
 ;M ^DIZ("TDATA","AR",$J)=AR  ;Testing
"RTN","VWREGITT",161,0)
 D FTF  ;File AR() to regit.txt
"RTN","VWREGITT",162,0)
 K ^DIZ("TDATA",$J)
"RTN","VWREGITT",163,0)
 Q
"RTN","VWREGITT",164,0)
 ;
"RTN","VWREGITT",165,0)
EDIT ;Edit existing. Check for allowability
"RTN","VWREGITT",166,0)
 S Y=TNUM_"^"_TNAME
"RTN","VWREGITT",167,0)
EL L -^DIE(TNUM):1 G EL:'$T
"RTN","VWREGITT",168,0)
 S S=1 F  S S=$O(^DIE(TNUM,"DR",S)) Q:'+S  D
"RTN","VWREGITT",169,0)
 . S SUBD=0 F  S SUBD=$O(^DIE(TNUM,"DR",S,SUBD)) Q:'+SUBD  K ^DIE(TNUM,"DR",S,SUBD)
"RTN","VWREGITT",170,0)
 S CALLER="EDIT"
"RTN","VWREGITT",171,0)
 D C2
"RTN","VWREGITT",172,0)
 L +^DIE(TNUM)
"RTN","VWREGITT",173,0)
 S DA=TNUM,DIK="^DIE(" D IX^DIK  ;Re-index record just in case...
"RTN","VWREGITT",174,0)
 S RESULT(0)=Y_" modification filed..."
"RTN","VWREGITT",175,0)
 Q
"RTN","VWREGITT",176,0)
 ;
"RTN","VWREGITT",177,0)
DELETE ;********************************************
"RTN","VWREGITT",178,0)
 K AR
"RTN","VWREGITT",179,0)
 N I,J,X
"RTN","VWREGITT",180,0)
 S X="TDATA" F  S X=$Q(@X) Q:X=""  D
"RTN","VWREGITT",181,0)
 . Q:'$L($P(@X,"^",3))  ;No entry
"RTN","VWREGITT",182,0)
 . K @X
"RTN","VWREGITT",183,0)
 M AR=TDATA K TDATA
"RTN","VWREGITT",184,0)
 D FTF
"RTN","VWREGITT",185,0)
 I X S RESULT(0)="Template menu list updated."
"RTN","VWREGITT",186,0)
 E  S RESULT(0)="Template list not updated. Advise Template manager to manually update "_HD_"regit.txt"
"RTN","VWREGITT",187,0)
 Q
"RTN","VWREGITT",188,0)
 
"RTN","VWREGITU")
0^7^B34064749
"RTN","VWREGITU",1,0)
VWREGITU ;Portland, OR/jeb et al World Vista Registration Utilities
"RTN","VWREGITU",2,0)
 ;V.2;;**LOCAL**;; 2015;Build 1
"RTN","VWREGITU",3,0)
 ;;c2014, BellFelder Productions(BF Productions)
"RTN","VWREGITU",4,0)
 ;No Fall thru - jeb
"RTN","VWREGITU",5,0)
 Q
"RTN","VWREGITU",6,0)
 ;
"RTN","VWREGITU",7,0)
DFNID() ;Set NAME(IEN),TAB,DOB(AGE),TAB,HRN,TAB,PHONE#
"RTN","VWREGITU",8,0)
 N DFNID,NAME,X,Y,DOB,HRN,PHONE
"RTN","VWREGITU",9,0)
 I 'DFN Q ""
"RTN","VWREGITU",10,0)
 S NAME=$P(^DPT(DFN,0),"^")
"RTN","VWREGITU",11,0)
 S Y=$$OUTPUT^VWTIME(DFN) X ^DD("DD") S DOB=Y
"RTN","VWREGITU",12,0)
 S HRN=$G(^DPT(DFN,540001.1))
"RTN","VWREGITU",13,0)
 S PHONE="Phone: "_$P(^DPT(DFN,.13),"^")
"RTN","VWREGITU",14,0)
 S DFNID=NAME_$C(9)_DOB_$C(9)_$S($L(HRN):"HRN: "_HRN_$C(9),1:"")_PHONE
"RTN","VWREGITU",15,0)
 Q DFNID
"RTN","VWREGITU",16,0)
 ;
"RTN","VWREGITU",17,0)
HELP(XDIC,XFIELD) ;
"RTN","VWREGITU",18,0)
 N N
"RTN","VWREGITU",19,0)
 K FHELP
"RTN","VWREGITU",20,0)
 S FHELP=$G(^DD(XDIC,XFIELD,3))
"RTN","VWREGITU",21,0)
 G:'$L(FHELP) HELPX
"RTN","VWREGITU",22,0)
 S FHELP=FHELP_$S($E($L(FHELP))=".":" ",1:". ")
"RTN","VWREGITU",23,0)
 I XFIELD'=27.02,$D(^DD(XDIC,XFIELD,21)) S N=0 F  S N=$O(^DD(XDIC,XFIELD,21,N)) Q:'+N  S FHELP=FHELP_^(N,0)_" "
"RTN","VWREGITU",24,0)
 S FHELP=$TR(FHELP,"'","`")
"RTN","VWREGITU",25,0)
HELPX   Q FHELP
"RTN","VWREGITU",26,0)
 ;
"RTN","VWREGITU",27,0)
M(RESULT,XMF) ;
"RTN","VWREGITU",28,0)
 ; **********************************************
"RTN","VWREGITU",29,0)
 ; * XMF_____PARENT FIELD^DFN^TEMPLATE NAME(IEN)*
"RTN","VWREGITU",30,0)
 ; **********************************************
"RTN","VWREGITU",31,0)
 ;
"RTN","VWREGITU",32,0)
 ;W "  ;Intentional break
"RTN","VWREGITU",33,0)
 K RESULT,AR,TEMPLATE
"RTN","VWREGITU",34,0)
 N XMFD,SUBD,SUBD3,SUBD4,SUBD5,F2,F3,F4,F5,DFN,N,X,SUBF,XT,FHELP
"RTN","VWREGITU",35,0)
 S TNUM=+$P(XMF,"(",2)  ;Template IEN, if any
"RTN","VWREGITU",36,0)
 S DFN=+$P(XMF,"^",2)   ;Client IEN, if any
"RTN","VWREGITU",37,0)
 S XMF=+XMF  ;Parent field
"RTN","VWREGITU",38,0)
 I '+$P(^DD(2,XMF,0),"^",2) S RESULT(0)=-1  ;Not a parent, eh?!
"RTN","VWREGITU",39,0)
 S XMFD=+$P(^(0),"^",2)
"RTN","VWREGITU",40,0)
 S F=0 F  S F=$O(^DD(XMFD,F)) Q:'+F  S RESULT($$INR)=$P(^(F,0),"^")_"^"_XMFD_";"_F_"^^"_$$HELP(XMFD,F)_"^"_$P(^(0),"^",3) D:+$P(^(0),"^",2)
"RTN","VWREGITU",41,0)
 . S SUBD=+$P(^(0),"^",2)
"RTN","VWREGITU",42,0)
 . S F2=0 F  S F2=$O(^DD(SUBD,F2)) Q:'+F2  S RESULT($$INR)=$P(^(F2,0),"^")_"^"_SUBD_";"_F2_"^^"_$$HELP(SUBD,F2)_"^"_$P(^(0),"^",3) D:+$P(^DD(SUBD,F2,0),"^",2)
"RTN","VWREGITU",43,0)
 .. S SUBD3=+$P(^(0),"^",2)
"RTN","VWREGITU",44,0)
 .. S F3=0 F  S F3=$O(^DD(SUBD3,F3)) Q:'+F3  S RESULT($$INR)=$P(^(F3,0),"^")_"^"_SUBD3_";"_F3_"^^"_$$HELP(SUBD3,F3)_"^"_$P(^(0),"^",3) D:+$P(^DD(SUBD3,F3,0),"^",2)
"RTN","VWREGITU",45,0)
 ... S SUBD4=+$P(^DD(SUBD3,F3,0),"^",2)
"RTN","VWREGITU",46,0)
 ... S F4=0 F  S F4=$O(^DD(SUBD4,F4)) Q:'+F4  S RESULT($$INR)=$P(^(F4,0),"^")_"^"_SUBD4_";"_F4_"^^"_$$HELP(SUBD4,F4)_"^"_$P(^(0),"^",3) D:+$P(^DD(SUBD4,F2,0),"^",2)
"RTN","VWREGITU",47,0)
 .... S SUBD5=+$P(^(0),"^",2)
"RTN","VWREGITU",48,0)
 .... S F5=0 F  S F5=$O(^DD(SUBD5,F5)) Q:'+F5  S RESULT($$INR)=$P(^(F5,0),"^")_"^"_SUBD5_";"_F5_"^^"_$$HELP(SUBD5,F5)_"^"_$P(^(0),"^",3)
"RTN","VWREGITU",49,0)
 ;Clean up of parents IN multiple fields
"RTN","VWREGITU",50,0)
 M AR=RESULT K RESULT N DD,F
"RTN","VWREGITU",51,0)
 S N=0 F  S N=$O(AR(N)) Q:'+N  D
"RTN","VWREGITU",52,0)
 . S DD=+$P($P(AR(N),"^",2),";")  ;Is this a sub DD ?
"RTN","VWREGITU",53,0)
 . S F=+$P(AR(N),";",2)
"RTN","VWREGITU",54,0)
 . I +$P(^DD(DD,F,0),"^",2) K AR(N)
"RTN","VWREGITU",55,0)
 ;Clean up fields not in template
"RTN","VWREGITU",56,0)
 M TEMPLATE=^DIE(TNUM,"DR")
"RTN","VWREGITU",57,0)
 S X=$Q(@"TEMPLATE") K @X  ;Remove top, non-multiple subscript
"RTN","VWREGITU",58,0)
 S X="AR" F  S X=$Q(@X) Q:X=""  D
"RTN","VWREGITU",59,0)
 . S SUBD=+$P($P(@X,"^",2),";")
"RTN","VWREGITU",60,0)
 . S SUBF=+$P(@X,";",2)
"RTN","VWREGITU",61,0)
 . F I=1:1:20 I $D(TEMPLATE(I,SUBD)) D
"RTN","VWREGITU",62,0)
 .. Q:TEMPLATE(I,SUBD)[SUBF
"RTN","VWREGITU",63,0)
 .. K @X
"RTN","VWREGITU",64,0)
 S N=0 F  S N=$O(AR(N)) Q:'+N  S RESULT($$INR)=AR(N)
"RTN","VWREGITU",65,0)
 K AR,TEMPLATE
"RTN","VWREGITU",66,0)
 Q
"RTN","VWREGITU",67,0)
 ;
"RTN","VWREGITU",68,0)
DISV(RESULT,DFN) ;Set the Disv GLOBAL
"RTN","VWREGITU",69,0)
 K RESULT
"RTN","VWREGITU",70,0)
 I '$L(DFN) S RESULT=-1 Q
"RTN","VWREGITU",71,0)
 S ^DISV(DUZ,"^DPT(")=+$P(DFN,"(",2),RESULT=1
"RTN","VWREGITU",72,0)
 Q
"RTN","VWREGITU",73,0)
 ;
"RTN","VWREGITU",74,0)
SR(FNAME,FNUM,FVALUE,FHELP,FSETPNTR,FMISC) ;Set values into RESULT()
"RTN","VWREGITU",75,0)
 ;********************************************************
"RTN","VWREGITU",76,0)
 ;* FNAME________Field Name                              *
"RTN","VWREGITU",77,0)
 ;* FNUM_________Field Number                            *
"RTN","VWREGITU",78,0)
 ;* FVALUE_______Data from existing client/patient       *
"RTN","VWREGITU",79,0)
 ;* FHELP________Help text from field                    *
"RTN","VWREGITU",80,0)
 ;* FSETPNTR_____Set of codes or Pointer reference       *
"RTN","VWREGITU",81,0)
 ;* FMISC________Locally described designator (not used) *
"RTN","VWREGITU",82,0)
 ;********************************************************
"RTN","VWREGITU",83,0)
 S RESULT($$INR)=FNAME_"^"_FNUM_"^"_FVALUE_"^"_FHELP_"^"_FSETPNTR_"^"_FMISC
"RTN","VWREGITU",84,0)
 Q
"RTN","VWREGITU",85,0)
 ;      
"RTN","VWREGITU",86,0)
INR() ;Specific incrementer for RESULT array
"RTN","VWREGITU",87,0)
 Q $O(RESULT(" "),-1)+1
"RTN","VWREGITU",88,0)
 ;
"RTN","VWREGITU",89,0)
ZPC(RESULT,ZIP) ;Get zip,county/area/region,state/province,preferred city
"RTN","VWREGITU",90,0)
 K RESULT N STP,CNTP,COUNTY,XZIP
"RTN","VWREGITU",91,0)
 S XZIP=ZIP S RESULT(0)="No return" Q:'$L(XZIP)
"RTN","VWREGITU",92,0)
 D POSTAL^XIPUTIL(XZIP,.ZIPDATA)
"RTN","VWREGITU",93,0)
 I $D(ZIPDATA("ERROR")) Q  ;Can't be found
"RTN","VWREGITU",94,0)
 S COUNTY=$G(ZIPDATA("COUNTY"))
"RTN","VWREGITU",95,0)
 S STP=$G(ZIPDATA("STATE POINTER"))
"RTN","VWREGITU",96,0)
 I STP,$L(COUNTY) S CNTP=$O(^DIC(5,STP,1,"B",COUNTY,0))
"RTN","VWREGITU",97,0)
 K RESULT(0)
"RTN","VWREGITU",98,0)
 S RESULT($$INR)=ZIPDATA("STATE")_"("_STP_")"
"RTN","VWREGITU",99,0)
 S RESULT($$INR)=ZIPDATA("COUNTY")_"("_CNTP_")"
"RTN","VWREGITU",100,0)
 S RESULT($$INR)=ZIPDATA("CITY")
"RTN","VWREGITU",101,0)
 S RESULT($$INR)=ZIPDATA("FIPS CODE")
"RTN","VWREGITU",102,0)
 K ZIPDATA
"RTN","VWREGITU",103,0)
 Q
"RTN","VWREGITU",104,0)
 ;
"RTN","VWREGITU",105,0)
SPI(RESULT,DFN) ;Simple patient inquiry display
"RTN","VWREGITU",106,0)
 S LINE="----------"
"RTN","VWREGITU",107,0)
 S DIC="^DPT(",DA=DFN,DIQ(0)="E",DIQ="AR"
"RTN","VWREGITU",108,0)
 S DR=".01:.05;.111:.115;.1171:.1173;.117;.363"
"RTN","VWREGITU",109,0)
 D EN^DIQ1
"RTN","VWREGITU",110,0)
 S CITY=$G(AR(2,DFN,.114,"E"))
"RTN","VWREGITU",111,0)
 S STIEN="",STATE=$G(AR(2,DFN,.115,"E")) S:$L(STATE) STIEN=$O(^DIC(5,"B",STATE,0))
"RTN","VWREGITU",112,0)
 S XAGE=$G(AR(2,DFN,.033,"E"))
"RTN","VWREGITU",113,0)
 S XAGE=$S(+XAGE:XAGE_" y/o",1:"")
"RTN","VWREGITU",114,0)
 ;;GET HRN
"RTN","VWREGITU",115,0)
HRN S HRN="",N=$O(^AUPNPAT(DFN,41,0))
"RTN","VWREGITU",116,0)
 S HRN=$S('N:HRN,1:$P($G(^AUPNPAT(DFN,41,N,0)),"^",2))
"RTN","VWREGITU",117,0)
 S RESULT($$INR)=AR(2,DFN,.01,"E")_"  "_AR(2,DFN,.363,"E")_" HRN: "_HRN
"RTN","VWREGITU",118,0)
 S RESULT($$INR)="DOB: "_AR(2,DFN,.03,"E")_"  ("_XAGE_" "_AR(2,DFN,.02,"E")_")"
"RTN","VWREGITU",119,0)
 S RESULT($$INR)="ADDRESS"_LINE_LINE
"RTN","VWREGITU",120,0)
 S RESULT($$INR)=$G(AR(2,DFN,.111,"E"))_" "_$G(AR(2,DFN,.112,"E"))
"RTN","VWREGITU",121,0)
 S RESULT($$INR)=$G(AR(2,DFN,.114,"E"))_", "_$G(AR(2,DFN,.115,"E"))_"  "_$S($L($G(AR(2,DFN,.1172,"E"))):AR(2,DFN,.1172,"E"),1:$G(AR(2,DFN,.1112,"E")))
"RTN","VWREGITU",122,0)
 S RESULT($$INR)="Walk-ins"_LINE_LINE
"RTN","VWREGITU",123,0)
 S RESULT($$INR)="Appointments"_LINE_LINE
"RTN","VWREGITU",124,0)
 S RESULT($$INR)="Admissions"_LINE_LINE
"RTN","VWREGITU",125,0)
 Q
"RTN","VWREGITU",126,0)
 ;
"RTN","VWREGITU",127,0)
CONTROL()       ;Check for CONTROL status
"RTN","VWREGITU",128,0)
        N X S X=$O(^DIC(19,"B","VW REG IT CONTROL",0))
"RTN","VWREGITU",129,0)
        I 'X Q 0  ;Ain't no option there
"RTN","VWREGITU",130,0)
        Q $S($D(^VA(200,DUZ,203,"B",X)):1,1:0)
"RTN","VWREGITU",131,0)
        ;
"RTN","VWREGITU",132,0)
MISC(RESULT,VWDD) ;Get simple value from VWDD ID
"RTN","VWREGITU",133,0)
 ;***************************************************
"RTN","VWREGITU",134,0)
 ;* VWDD___________________(sub)-Dictionary number  *
"RTN","VWREGITU",135,0)
 ;* Multiple delimiter_____;(Semicolon)             *
"RTN","VWREGITU",136,0)
 ;***************************************************
"RTN","VWREGITU",137,0)
 ;
"RTN","VWREGITU",138,0)
 I '$L(VWDD) S RESULT(0)="No value to evaluate" Q
"RTN","VWREGITU",139,0)
 K RESULT
"RTN","VWREGITU",140,0)
 N XDD,XDDLOC,N,X
"RTN","VWREGITU",141,0)
 G MISCSD:$G(^DD(VWDD,0,"UP"))
"RTN","VWREGITU",142,0)
 S CALLER=$S($P(VWDD,"^",2)="INS":1,1:0)
"RTN","VWREGITU",143,0)
 S VWDD=$P(VWDD,"^")
"RTN","VWREGITU",144,0)
 F I=1:1:$L(VWDD,";") S XDD=+$P(VWDD,";",I) S RESULT($$INR)="["_$P(^DIC(XDD,0),"^")_"]" D MISC1
"RTN","VWREGITU",145,0)
 I CALLER S RESULT($$INR)="[GUARANTOR]" D
"RTN","VWREGITU",146,0)
 . S X=$P(^DD(2.312,16,0),"^",3)
"RTN","VWREGITU",147,0)
 . F I=1:1:$L(X,";") S Y=$P(X,";",I),RESULT($$INR)=$P(Y,":",2)_"("_$P(Y,":")_")"
"RTN","VWREGITU",148,0)
 Q
"RTN","VWREGITU",149,0)
 ;
"RTN","VWREGITU",150,0)
MISC1 S XDDLOC=$G(^DIC(XDD,0,"GL")) D:$L(XDDLOC)
"RTN","VWREGITU",151,0)
 . S N=0 F  S N=$O(@(XDDLOC_N_")")) Q:'+N  D
"RTN","VWREGITU",152,0)
 .. I XDDLOC["779.004" S XCNAME=$P(@(XDDLOC_N_",0)"),"^")_" "_$P(^(0),"^",2)_" "_+$G(^("SDS"))_"("_N_")",RESULT($$INR)=XCNAME Q
"RTN","VWREGITU",153,0)
 .. S X=$P(@(XDDLOC_N_",0)"),"^")_"("_N_")",RESULT($$INR)=X
"RTN","VWREGITU",154,0)
MX Q
"RTN","VWREGITU",155,0)
 ;
"RTN","VWREGITU",156,0)
MISCSD ;Sub-dictionary
"RTN","VWREGITU",157,0)
 W ^("UP")
"RTN","VWREGITU",158,0)
 Q
"RTN","VWREGITU",159,0)
 ;
"RTN","VWREGITU",160,0)
 
"RTN","VWREGITX")
0^8^B96032773
"RTN","VWREGITX",1,0)
VWREGITX ;VWEHR/BFProd-Jim Bell, et al - World VistA GUI Pat Reg Utility
"RTN","VWREGITX",2,0)
 ;;;;;;Build 1
"RTN","VWREGITX",3,0)
 ;;1.0;WORLD VISTA;**LOCAL **;;Build 26
"RTN","VWREGITX",4,0)
 ;
"RTN","VWREGITX",5,0)
 ;This routine utility is for patient specific fields and
"RTN","VWREGITX",6,0)
 ;is used to build input templates for registration
"RTN","VWREGITX",7,0)
 ;
"RTN","VWREGITX",8,0)
 ;GNU License: See WVLIC.txt
"RTN","VWREGITX",9,0)
 ;Modified FOIA VISTA,
"RTN","VWREGITX",10,0)
 ;Copyright 2013 WorldVistA.  Licensed under the terms of the GNU
"RTN","VWREGITX",11,0)
 Q
"RTN","VWREGITX",12,0)
 ;
"RTN","VWREGITX",13,0)
1 ;CallerID = HRN; value is at $P($P(CALLERID,":",2),"^")
"RTN","VWREGITX",14,0)
 S HRN=$P($P(CALLERID,":",2),"^")
"RTN","VWREGITX",15,0)
 S HRN=$$HRN(HRN)
"RTN","VWREGITX",16,0)
 I HRN="" S RESULT(0)="The Health Record Number (HRN) does not exist in this database"_$C(13,10)_"Please use NAME, DOB, or PHONE#."
"RTN","VWREGITX",17,0)
 Q
"RTN","VWREGITX",18,0)
 ;
"RTN","VWREGITX",19,0)
2 ;CallerID = NAME; in ^2@+CALLERID
"RTN","VWREGITX",20,0)
 K AR,ARR
"RTN","VWREGITX",21,0)
 N HRN,PHONE,DOB,N
"RTN","VWREGITX",22,0)
 S NAME=$P(CALLERID,"^",+CALLERID)
"RTN","VWREGITX",23,0)
 S XNAME=NAME F  S XNAME=$O(^DPT("B",XNAME)) Q:XNAME'[NAME  D
"RTN","VWREGITX",24,0)
 . S N=0 F  S N=$O(^DPT("B",XNAME,N)) Q:'+N  S AR($O(AR(" "),-1)+1)=N
"RTN","VWREGITX",25,0)
 I $O(AR(" "),-1)=1 D  Q
"RTN","VWREGITX",26,0)
 . S DFN=AR(1)
"RTN","VWREGITX",27,0)
 . S HRN=$$HRN(DFN),HRN=$S($L(HRN):HRN,'$L(HRN):"ID-"_$P($G(^DPT(DFN,.36)),"^",3),1:"------------")
"RTN","VWREGITX",28,0)
 . S DOB=$P(^DPT(DFN,0),"^",3),DOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$E(DOB,2,3)
"RTN","VWREGITX",29,0)
 . S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE):PHONE,1:"<No entry>")
"RTN","VWREGITX",30,0)
 . S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")^"_DOB_"^"_PHONE
"RTN","VWREGITX",31,0)
 S N=0 F  S N=$O(AR(N)) Q:'+N  S ARR($P(^DPT(+AR(N),0),"^"),N)=+AR(N)
"RTN","VWREGITX",32,0)
 S X="ARR" F  S X=$Q(@X) Q:X=""  S DFN=@X D
"RTN","VWREGITX",33,0)
 . S HRN=$$HRN(DFN),HRN=$S($L(HRN):HRN,'$L(HRN):"ID-"_$P($G(^DPT(DFN,.36)),"^",3),1:"------------")
"RTN","VWREGITX",34,0)
 . S DOB=$P(^DPT(DFN,0),"^",3),DOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$E(DOB,2,3)
"RTN","VWREGITX",35,0)
 . S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE):PHONE,1:"<No entry>")
"RTN","VWREGITX",36,0)
 . S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")^"_DOB_"^"_PHONE
"RTN","VWREGITX",37,0)
 K AR,ARR
"RTN","VWREGITX",38,0)
 Q
"RTN","VWREGITX",39,0)
 ;
"RTN","VWREGITX",40,0)
3 ;CallerID = DOB; in ^3@CALLERID
"RTN","VWREGITX",41,0)
 S X=$P(CALLERID,"^",+CALLERID)
"RTN","VWREGITX",42,0)
 K %DT,Y,AR
"RTN","VWREGITX",43,0)
 N HRN,PHONE,N
"RTN","VWREGITX",44,0)
 D ^%DT
"RTN","VWREGITX",45,0)
 S N=0 F  S N=$O(^DPT("ADOB",Y,N)) Q:'+N  S AR($O(AR(" "),-1)+1)=N_"^"_Y
"RTN","VWREGITX",46,0)
 I $O(AR(" "),-1)=1 D  Q  ;Only one find
"RTN","VWREGITX",47,0)
 . K RESULT
"RTN","VWREGITX",48,0)
 . S DFN=+AR(1)
"RTN","VWREGITX",49,0)
 . S HRN=$$HRN(DFN)
"RTN","VWREGITX",50,0)
 . I '$L(HRN) S HRN="ID-"_$P($G(^DPT(DFN,.36)),"^",3)
"RTN","VWREGITX",51,0)
 . I '$L(HRN) S HRN="------------"
"RTN","VWREGITX",52,0)
        . S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE)>0:PHONE,1:"<No entry>")
"RTN","VWREGITX",53,0)
 . S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")"_"^"_$P(CALLERID,"^",+CALLERID)_"^"_PHONE
"RTN","VWREGITX",54,0)
 K ARR S N=0 F  S N=$O(AR(N)) Q:'+N  S ARR($P(^DPT(+AR(N),0),"^"),N)=+AR(N)
"RTN","VWREGITX",55,0)
 S X="ARR" F  S X=$Q(@X) Q:X=""  S DFN=@X D
"RTN","VWREGITX",56,0)
 . S HRN=$$HRN(DFN)
"RTN","VWREGITX",57,0)
 . I '$L(HRN) S HRN=$P($G(^DPT(DFN,.36)),"^",3)_"(ID)"
"RTN","VWREGITX",58,0)
 . I '$L(HRN)!(HRN="(ID)") S HRN="------------"
"RTN","VWREGITX",59,0)
 . S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE)>0:PHONE,1:"<No entry>")
"RTN","VWREGITX",60,0)
 . S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")"_"^"_$P(CALLERID,"^",+CALLERID)_"^"_PHONE
"RTN","VWREGITX",61,0)
 K ARR,AR
"RTN","VWREGITX",62,0)
 Q
"RTN","VWREGITX",63,0)
 ;
"RTN","VWREGITX",64,0)
4 ;CallerID = PHONE; IN ^4@+CALLERID
"RTN","VWREGITX",65,0)
 S CALLERID=$TR(CALLERID,"- ()","")
"RTN","VWREGITX",66,0)
 Q
"RTN","VWREGITX",67,0)
 ;
"RTN","VWREGITX",68,0)
5 ;CallerID = space-bar; IN ^2@+CALLERID
"RTN","VWREGITX",69,0)
 S X=$P(CALLERID,"^",+CALLERID)
"RTN","VWREGITX",70,0)
 S DFN=$G(^DISV(DUZ,"^DPT("))
"RTN","VWREGITX",71,0)
 I 'DFN S RESULT(0)="Patient-Client not found" Q
"RTN","VWREGITX",72,0)
 S AR(1)=DFN G 2+6  ;Direct call
"RTN","VWREGITX",73,0)
 Q
"RTN","VWREGITX",74,0)
 ;
"RTN","VWREGITX",75,0)
DE(RESULT,DATA) ;Forced hard error
"RTN","VWREGITX",76,0)
 ;W "
"RTN","VWREGITX",77,0)
 Q
"RTN","VWREGITX",78,0)
 ;
"RTN","VWREGITX",79,0)
HRN(IEN) ;Health Record #s from IHS PATIENT
"RTN","VWREGITX",80,0)
 N N,HRNIEN,I
"RTN","VWREGITX",81,0)
 S HRNIEN=""
"RTN","VWREGITX",82,0)
 Q:'$D(^AUPNPAT(IEN)) HRNIEN
"RTN","VWREGITX",83,0)
 S N=0 F I=1:1 S N=$O(^AUPNPAT(IEN,41,N)) Q:'+N  S HRNIEN=HRNIEN_$P($G(^AUPNPAT(IEN,41,N,0)),"^",2)_"|"
"RTN","VWREGITX",84,0)
 I $E(HRNIEN,$L(HRNIEN))="|" S HRNIEN=$E(HRNIEN,1,$L(HRNIEN)-1)
"RTN","VWREGITX",85,0)
 Q HRNIEN
"RTN","VWREGITX",86,0)
 ;
"RTN","VWREGITX",87,0)
ALIST(RESULT,ALPHA,CALLERID) ;Alpha request from client
"RTN","VWREGITX",88,0)
 ;*****************************************************
"RTN","VWREGITX",89,0)
 ;* ALPHA_____Letter to look up                       *
"RTN","VWREGITX",90,0)
 ;* CALLERID__PIECE#:HRN^NAME(IEN)^DOB^PHONE look up  *
"RTN","VWREGITX",91,0)
 ;* RETURN____HRN^NAME^DOB^PHONE(Field .131 in File 2)*
"RTN","VWREGITX",92,0)
 ;***************************************************** 
"RTN","VWREGITX",93,0)
 I '$L(ALPHA),'+CALLERID S RESULT(0)="No Alphabetical letter or HRN,Name,DOB,Phone selection..." Q
"RTN","VWREGITX",94,0)
 S CALLERID=$$UP^XLFSTR(CALLERID)  ;Upcase EVERYTHING
"RTN","VWREGITX",95,0)
 I +CALLERID G @+CALLERID
"RTN","VWREGITX",96,0)
 N X,I,ANAME,HRN,ADOB,APHONE,Y
"RTN","VWREGITX",97,0)
 K RESULT,AR,ARR
"RTN","VWREGITX",98,0)
 S X="^DPT(""B"""_","_""""_ALPHA_""")"
"RTN","VWREGITX",99,0)
 F I=1:1 S X=$Q(@X) Q:$S($L(ALPHA)>1:$P(X,"""",4)'[ALPHA,1:$E($P(X,"""",4))'=ALPHA)  S AR(I)=+$P(X,",",$L(X,","))
"RTN","VWREGITX",100,0)
 S ARN=0 F  S ARN=$O(AR(ARN)) Q:'+ARN  D
"RTN","VWREGITX",101,0)
 . S HRN=$$HRN(ARN)
"RTN","VWREGITX",102,0)
 . S:'$L(HRN) HRN="---            "
"RTN","VWREGITX",103,0)
 . F JJ=$L(HRN):1:15 S HRN=HRN_" "
"RTN","VWREGITX",104,0)
 . S ANAME=$P(^DPT(AR(ARN),0),"^")
"RTN","VWREGITX",105,0)
 . S Y=$P(^(0),"^",3)_$S($G(^DPT(AR(ARN),540000)):^(540000),1:"")
"RTN","VWREGITX",106,0)
 . D DD^%DT S ADOB=Y
"RTN","VWREGITX",107,0)
 . S APHONE=$P($G(^DPT(AR(ARN),.13)),"^")
"RTN","VWREGITX",108,0)
 . S ARR(ANAME,ARN)=HRN_"^"_ANAME_"("_AR(ARN)_")^"_ADOB_"^"_APHONE
"RTN","VWREGITX",109,0)
 S X="ARR" F  S X=$Q(@X) Q:X=""  S RESULT($$INR)=@X
"RTN","VWREGITX",110,0)
 Q
"RTN","VWREGITX",111,0)
 ;
"RTN","VWREGITX",112,0)
PLID(IEN) ;Primary Long ID, used with or in absence of HRN.
"RTN","VWREGITX",113,0)
 Q $P($G(^DPT(IEN,.36)),"^",3)
"RTN","VWREGITX",114,0)
 ;
"RTN","VWREGITX",115,0)
INR() Q $O(RESULT(" "),-1)+1
"RTN","VWREGITX",116,0)
 ;
"RTN","VWREGITX",117,0)
 
"RTN","VWREGITX",118,0)
FIXNAME ;
"RTN","VWREGITX",119,0)
 N N,X,Y,XIEN,NLENGTH,I
"RTN","VWREGITX",120,0)
 S NLENGTH=0,X="AR" F  S X=$Q(@X) Q:X=""  D
"RTN","VWREGITX",121,0)
 . S Y=@X,N=$P(Y,"(")_"("_+$P(Y,"(",2)_")",STR=$P(Y,")",2)
"RTN","VWREGITX",122,0)
 . S NLENGTH=$S($L(N)>NLENGTH:$L(N),1:NLENGTH)
"RTN","VWREGITX",123,0)
 . F I=NLENGTH:-1:$L(N) S N=N_" "
"RTN","VWREGITX",124,0)
 . S Y=N_" "_STR
"RTN","VWREGITX",125,0)
 . S @X=Y
"RTN","VWREGITX",126,0)
 Q
"RTN","VWREGITX",127,0)
GPL(RESULT,IDDATA) ;Partial patient lists
"RTN","VWREGITX",128,0)
 ;***********************************************
"RTN","VWREGITX",129,0)
 ;* IDDATA_____Contains Start^Stop alpha chars  *
"RTN","VWREGITX",130,0)
 ;* RESULT_____Return of results                *
"RTN","VWREGITX",131,0)
 ;***********************************************
"RTN","VWREGITX",132,0)
 K RESULT,AR
"RTN","VWREGITX",133,0)
 N N,DFN,SSN,DOB,START,STOP,NAME,XDOB ;; ,NL
"RTN","VWREGITX",134,0)
 ;;Get user's last patient ID
"RTN","VWREGITX",135,0)
 S DFN=$G(^DISV(DUZ,"^DPT(")) D:DFN
"RTN","VWREGITX",136,0)
 . S NAME=$P(^DPT(DFN,0),"^")
"RTN","VWREGITX",137,0)
 . ;S SSN=$P(^(0),"^",9)
"RTN","VWREGITX",138,0)
 . S HRN="HRN: "_$$HRN(DFN)  ;Health record number
"RTN","VWREGITX",139,0)
 . S PLID="ID: "_$$PLID(DFN)  ;Primary Long ID
"RTN","VWREGITX",140,0)
 . S DOB=$P(^(0),"^",3)
"RTN","VWREGITX",141,0)
 . S XDOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$S($E(DOB)<3:19,1:20)_$E(DOB,2,3)
"RTN","VWREGITX",142,0)
 . S AR(0)=NAME_"("_DFN_")"_" "_XDOB_" "_$S($L($P(HRN,": ",2)):HRN,$L($P(PLID,": ",2)):PLID,1:"<NO ID ON FILE>")
"RTN","VWREGITX",143,0)
 S START=$P(IDDATA,"^")
"RTN","VWREGITX",144,0)
 S STOP=$P(IDDATA,"^",2)
"RTN","VWREGITX",145,0)
 S STOP=STOP_"z"
"RTN","VWREGITX",146,0)
 S STOP=$E($O(^DPT("B",STOP)))
"RTN","VWREGITX",147,0)
 S STOP=$S('$L(STOP):$P(IDDATA,"^",2)_"z",1:STOP)
"RTN","VWREGITX",148,0)
 S NL=0
"RTN","VWREGITX",149,0)
 S N=START F  S N=$O(^DPT("B",N)) Q:N=""!($E(N)=STOP)  D
"RTN","VWREGITX",150,0)
 . S DFN=$O(^(N,0))
"RTN","VWREGITX",151,0)
 . S NAME=$P(^DPT(DFN,0),"^")_"("_DFN_")"
"RTN","VWREGITX",152,0)
 . ;S SSN=$P(^(0),"^",9),SSN=$S('$L(SSN):"     ????",1:SSN)
"RTN","VWREGITX",153,0)
 . S HRN="HRN: "_$$HRN(DFN)
"RTN","VWREGITX",154,0)
        . S PLID="ID: "_$$PLID(DFN)  ;Primary Long ID
"RTN","VWREGITX",155,0)
 . S DOB=$P(^DPT(DFN,0),"^",3)
"RTN","VWREGITX",156,0)
 . S XDOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$S($E(DOB)<3:19,1:20)_$E(DOB,2,3)
"RTN","VWREGITX",157,0)
 . ;W !,$J(DFN,5)," ",$J($E(NAME,1,12),12)," ",$J(SSN,10)," ",XDOB
"RTN","VWREGITX",158,0)
 . S AR(NAME,DFN)=NAME_" "_XDOB_" "_$S($L($P(HRN,": ",2)):HRN,$L($P(PLID,": ",2)):PLID,1:"<NO ID ON FILE>")
"RTN","VWREGITX",159,0)
 . S (DFN,NAME,SSN,DOB,XDOB)=""
"RTN","VWREGITX",160,0)
 D FIXNAME
"RTN","VWREGITX",161,0)
 S X="AR" F  S X=$Q(@X) Q:X=""  S RESULT($$INR)=@X
"RTN","VWREGITX",162,0)
 K AR
"RTN","VWREGITX",163,0)
 Q
"RTN","VWREGITX",164,0)
 ;
"RTN","VWREGITX",165,0)
REJECT(FIELD,IEN,SUBDIC) ;Reject Asterisked,Amis,Computed fields,VA specific fields
"RTN","VWREGITX",166,0)
 ;This subroutine left in for possible future use
"RTN","VWREGITX",167,0)
 I $L(IEN),$D(^DIZ(64850001,IEN)) Q 1  ;VA specific data field
"RTN","VWREGITX",168,0)
 I FIELD["COMPONENT" Q 1  ;Pain in the butt!
"RTN","VWREGITX",169,0)
 I FIELD["(VA)"!(FIELD["(CIVIL)") Q 1  ;VA fields
"RTN","VWREGITX",170,0)
 I FIELD["AMIS",FIELD["SEGMENT" Q 1
"RTN","VWREGITX",171,0)
 I FIELD["ELIG VERIF" Q 1
"RTN","VWREGITX",172,0)
 I FIELD["ENCOUNTER CONVERSION" Q 1
"RTN","VWREGITX",173,0)
 I FIELD["PROGRAMMERS U" Q 1
"RTN","VWREGITX",174,0)
 I FIELD["WHO " Q 1
"RTN","VWREGITX",175,0)
 I FIELD["SC AT"!(FIELD["SC%") Q 1
"RTN","VWREGITX",176,0)
 I $E(FIELD)="*" Q 1  ;field marked for deletion
"RTN","VWREGITX",177,0)
 I FIELD["10-10" Q 1
"RTN","VWREGITX",178,0)
 I $L(IEN),$E($P($G(^DD(2,IEN,0)),"^",2))="C" Q 1  ;computed field
"RTN","VWREGITX",179,0)
 I $L($G(SUBDIC)),$E($P($G(^DD(SUBDIC,IEN,0)),"^",2))="C" Q 1 ;computet in sub-dic
"RTN","VWREGITX",180,0)
 Q 0  ;Passed
"RTN","VWREGITX",181,0)
 ;
"RTN","VWREGITX",182,0)
LF(RESULT,FTYPE) ;List of assumed civilian type fields from 
"RTN","VWREGITX",183,0)
 ;                Patient file(#2)
"RTN","VWREGITX",184,0)
 ;*******************************************************************
"RTN","VWREGITX",185,0)
 ;*The author (me) arbitarily selected fields from the patient file *
"RTN","VWREGITX",186,0)
 ;* that he (me) considers to be usable by civilian VistA/CPRS users*
"RTN","VWREGITX",187,0)
 ;* the field count is 284 out of the 700+ fields available in the  *
"RTN","VWREGITX",188,0)
 ;* full patient DD. File is located at ^DIZ(64850002,              *
"RTN","VWREGITX",189,0)
 ;*******************************************************************
"RTN","VWREGITX",190,0)
 ;
"RTN","VWREGITX",191,0)
 S FTYPE=$TR(FTYPE,"*&^%$#@!:;>?/., ","")  ;TMenuItem inclusions/jeb
"RTN","VWREGITX",192,0)
 ;S:$L(FTYPE) FTYPE=$P(^DIZ(64850003,+$P(FTYPE,"(",2),0),"^")
"RTN","VWREGITX",193,0)
 S FTYPE=$$UP^XLFSTR(FTYPE)
"RTN","VWREGITX",194,0)
 K RESULT
"RTN","VWREGITX",195,0)
 N N,X,FIELD,FLDNO,FGRP,M,MX,MF,MFNO,MFGP,MN
"RTN","VWREGITX",196,0)
 G FG:$L(FTYPE)
"RTN","VWREGITX",197,0)
 ; Add patient file fields
"RTN","VWREGITX",198,0)
 S N=0 F  S N=$O(^DIZ(64850002,N)) Q:'+N  D
"RTN","VWREGITX",199,0)
 . S X=^(N,0)
"RTN","VWREGITX",200,0)
 . S FIELD=$P(X,"^")
"RTN","VWREGITX",201,0)
 . S FLDNO=$P(X,"^",2)
"RTN","VWREGITX",202,0)
 . S FGRP=$P(X,"^",3)
"RTN","VWREGITX",203,0)
 . S RESULT($$INR)=FIELD_"("_FLDNO_")"_":"_FGRP
"RTN","VWREGITX",204,0)
 . I $O(^DIZ(64850002,N,"M",0)) D
"RTN","VWREGITX",205,0)
 .. S M=0 F  S M=$O(^DIZ(64850002,N,"M",M)) Q:'+M  D
"RTN","VWREGITX",206,0)
 ... S MX=^(M,0)
"RTN","VWREGITX",207,0)
 ... S MF=$P(MX,"^")
"RTN","VWREGITX",208,0)
 ... S MFNO=$P(MX,"^",2)
"RTN","VWREGITX",209,0)
 ... S MFGP=$P(MX,"^",3)
"RTN","VWREGITX",210,0)
 ... S RESULT($$INR)=" SF "_MF_"("_MFNO_")"_":"_MFGP
"RTN","VWREGITX",211,0)
 S X="RESULT" F I=1:1 S X=$Q(@X) Q:X=""
"RTN","VWREGITX",212,0)
 S RESULT(0)="Field count: "_(I-1)
"RTN","VWREGITX",213,0)
 Q
"RTN","VWREGITX",214,0)
 ;
"RTN","VWREGITX",215,0)
FG ;Fields by GROUP
"RTN","VWREGITX",216,0)
 Q:'$L(FTYPE)
"RTN","VWREGITX",217,0)
 K RESULT,AHF N LABEL,F,N,I
"RTN","VWREGITX",218,0)
 S N=$S(+$P(FTYPE,"(",2):+$P(FTYPE,"(",2),1:$O(^DIZ(64850003,"B",FTYPE,0)))
"RTN","VWREGITX",219,0)
 I 'N S RESULT($$INR)="Group not found." G FGX
"RTN","VWREGITX",220,0)
 S F=0 F I=1:1  S F=$O(^DIZ(64850003,N,"F","B",F)) Q:'+F  S RESULT($$INR)=$P(^DD(2,F,0),"^")_"("_F_")"
"RTN","VWREGITX",221,0)
FGX Q
"RTN","VWREGITX",222,0)
 ;
"RTN","VWREGITX",223,0)
FGNA(RESULT,KIND) ;Fields by sort designator
"RTN","VWREGITX",224,0)
 ;**********************************
"RTN","VWREGITX",225,0)
 ;* KIND                           *
"RTN","VWREGITX",226,0)
 ;*    G____Group,Field            *
"RTN","VWREGITX",227,0)
 ;*    N____Field#                 *
"RTN","VWREGITX",228,0)
 ;*    A____Alphabetical (Default) *   
"RTN","VWREGITX",229,0)
 ;* RESULT__Returned array         *
"RTN","VWREGITX",230,0)
 ;**********************************
"RTN","VWREGITX",231,0)
 K RESULT
"RTN","VWREGITX",232,0)
 I KIND="G" D  G FGNAX
"RTN","VWREGITX",233,0)
 . K AR
"RTN","VWREGITX",234,0)
 . S N=0 F  S N=$O(^DIZ(64850002,N)) Q:'+N  S X=^(N,0) D
"RTN","VWREGITX",235,0)
 .. S GRP=$P(X,"^",3)
"RTN","VWREGITX",236,0)
 .. S FN=$P(X,"^",2)
"RTN","VWREGITX",237,0)
 .. S FIELD=$P(X,"^")
"RTN","VWREGITX",238,0)
 .. S AR(GRP,FN)=FIELD_"("_FN_")"
"RTN","VWREGITX",239,0)
 .. I $O(^DIZ(64850002,N,"M",0)) D
"RTN","VWREGITX",240,0)
 ... S MN=0 F  S MN=$O(^DIZ(64850002,N,"M",MN)) Q:'+MN  D
"RTN","VWREGITX",241,0)
 .... S MX=^(MN,0)
"RTN","VWREGITX",242,0)
 .... S MFN=+$P(MX,"^",2)
"RTN","VWREGITX",243,0)
 .... S MFLD=$P(MX,"^")
"RTN","VWREGITX",244,0)
 .... S AR(GRP,FN,MFN)="  SF  "_$P(MX,"^")_"("_$P(MX,"^",2)_")"
"RTN","VWREGITX",245,0)
 . S G="" F  S G=$O(AR(G)) Q:G=""  S RESULT($$INR)="--- "_G_" ---" D
"RTN","VWREGITX",246,0)
 .. S FN=0 F  S FN=$O(AR(G,FN)) Q:'+FN  S X=AR(G,FN),RESULT($$INR)=$P(X,"^") I $O(AR(G,FN,0)) S SFN=0 F  S SFN=$O(AR(G,FN,SFN)) Q:'+SFN  S RESULT($$INR)=AR(G,FN,SFN)
"RTN","VWREGITX",247,0)
 I KIND="N" D  G FGNAX
"RTN","VWREGITX",248,0)
 . K AR,RESULT
"RTN","VWREGITX",249,0)
 . S N=0 F  S N=$O(^DIZ(64850002,N)) Q:'+N  S X=^(N,0) D
"RTN","VWREGITX",250,0)
 .. S GRP=$P(X,"^",3)
"RTN","VWREGITX",251,0)
 .. S FN=$P(X,"^",2)
"RTN","VWREGITX",252,0)
 .. S FIELD=$P(X,"^")
"RTN","VWREGITX",253,0)
 .. S AR(FN)=FIELD_"("_FN_")"
"RTN","VWREGITX",254,0)
 .. I $O(^DIZ(64850002,N,"M",0)) D
"RTN","VWREGITX",255,0)
        ... S MN=0 F  S MN=$O(^DIZ(64850002,N,"M",MN)) Q:'+MN  D
"RTN","VWREGITX",256,0)
        .... S MX=^(MN,0)
"RTN","VWREGITX",257,0)
        .... S MFN=+$P(MX,"^",2)
"RTN","VWREGITX",258,0)
        .... S MFLD=$P(MX,"^")
"RTN","VWREGITX",259,0)
        .... S AR(FN,MFN)="  SF  "_$P(MX,"^")_"("_$P(MX,"^",2)_")"
"RTN","VWREGITX",260,0)
 . S X="AR" F  S X=$Q(@X) Q:X=""  S RESULT($$INR)=@X
"RTN","VWREGITX",261,0)
 ;Kind = alphabetical
"RTN","VWREGITX",262,0)
 S N=0 F  S N=$O(^DIZ(64850002,N)) Q:'+N  S X=^(N,0) D
"RTN","VWREGITX",263,0)
 . S AR($P(X,"^"))=$P(X,"^")_"("_$P(X,"^",2)_")"
"RTN","VWREGITX",264,0)
 . I $O(^DIZ(64850002,N,"M",0)) D
"RTN","VWREGITX",265,0)
        .. S MN=0 F  S MN=$O(^DIZ(64850002,N,"M",MN)) Q:'+MN  D
"RTN","VWREGITX",266,0)
        ... S MX=^(MN,0)
"RTN","VWREGITX",267,0)
        ... S MFN=+$P(MX,"^",2)
"RTN","VWREGITX",268,0)
        ... S MFLD=$P(MX,"^")
"RTN","VWREGITX",269,0)
 ... S AR($P(X,"^"),MFLD)="  SF  "_$P(MX,"^")_"("_$P(MX,"^",2)_")"
"RTN","VWREGITX",270,0)
 S X="AR" F  S X=$Q(@X) Q:X=""  S RESULT($$INR)=@X
"RTN","VWREGITX",271,0)
FGNAX ;K AR
"RTN","VWREGITX",272,0)
 Q
"RTN","VWREGITX",273,0)
 ;
"RTN","VWREGITX",274,0)
RETGRP(RESULT) ;Return Group IDs
"RTN","VWREGITX",275,0)
 K RESULT
"RTN","VWREGITX",276,0)
 S N=0 F  S N=$O(^DIZ(64850003,N)) Q:'+N  S RESULT($$INR)=$P(^(N,0),"^",2)_"("_N_")"
"RTN","VWREGITX",277,0)
 Q
"RTN","VWREGITX",278,0)
 ;
"RTN","VWREGITX",279,0)
AHF(RESULT,AHF) ;Ad hoc field selection "Finished" pressed/jeb
"RTN","VWREGITX",280,0)
 ;*****************************************************
"RTN","VWREGITX",281,0)
 ;* AFH ARRAY:                                        *
"RTN","VWREGITX",282,0)
 ;*   AHF(0)____DFN                                   *
"RTN","VWREGITX",283,0)
 ;*   AHF ARRAY_FIELD(NO) OR FIELD(NO;SUB-DIC)        *
"RTN","VWREGITX",284,0)
 ;*****************************************************
"RTN","VWREGITX",285,0)
 ;W "  ;the END
"RTN","VWREGITX",286,0)
 K ^DIZ("AHF") M ^DIZ("AHF")=AHF
"RTN","VWREGITX",287,0)
 K RESULT
"RTN","VWREGITX",288,0)
 N FIELD,FNO,DFNDR
"RTN","VWREGITX",289,0)
 S DFNDR=""
"RTN","VWREGITX",290,0)
 S DFN=+AHF(0) K AHF(0)
"RTN","VWREGITX",291,0)
 S X="AHF" F  S X=$Q(@X) Q:X=""  S Y=@X D
"RTN","VWREGITX",292,0)
 . S FIELD=$P(Y,"(")
"RTN","VWREGITX",293,0)
 . S FNO=+$P(Y,"(",2)
"RTN","VWREGITX",294,0)
 . D GFA(FNO)
"RTN","VWREGITX",295,0)
 . S RESULT($$INR)=FIELD_"^"_FNO_"^^"_FHELP_"^"_FPSC_"^"_$$MF(FNO)
"RTN","VWREGITX",296,0)
 . S DFNDR=DFNDR_FNO_";"
"RTN","VWREGITX",297,0)
 I DFN D
"RTN","VWREGITX",298,0)
 . K AR N N,Y,F
"RTN","VWREGITX",299,0)
 . D GETS^DIQ(2,DFN_",",DFNDR,"E","AR","ERR")
"RTN","VWREGITX",300,0)
 . S X="AR" F  S X=$Q(@X) Q:X=""  D
"RTN","VWREGITX",301,0)
 .. S Y=@X
"RTN","VWREGITX",302,0)
 .. S F=+$P(X,",",$L(X,",")-1)
"RTN","VWREGITX",303,0)
 .. S N=0 F  S N=$O(RESULT(N)) Q:'+N  I $P(RESULT(N),"^",2)=F S $P(RESULT(N),"^",3)=Y
"RTN","VWREGITX",304,0)
 ;ToDo: write fill in for the multiple fields
"RTN","VWREGITX",305,0)
 K FHELP,FPSC
"RTN","VWREGITX",306,0)
 Q
"RTN","VWREGITX",307,0)
 ;
"RTN","VWREGITX",308,0)
GFA(FNO) ;Get field attributes at piece3 and help
"RTN","VWREGITX",309,0)
 S (FHELP,FPSC)=""
"RTN","VWREGITX",310,0)
 S FHELP=$G(^DD(2,FNO,3))
"RTN","VWREGITX",311,0)
 I FNO'=27.02 S N=0 F  S N=$O(^DD(2,FNO,21,N)) Q:'+N  S FHELP=FHELP_^(N,0)
"RTN","VWREGITX",312,0)
 S FHELP=$TR(FHELP,"'","`")
"RTN","VWREGITX",313,0)
 S FPSC=$P(^DD(2,FNO,0),"^",3)
"RTN","VWREGITX",314,0)
 Q
"RTN","VWREGITX",315,0)
 ;
"RTN","VWREGITX",316,0)
MF(X) ;Check for multiple field
"RTN","VWREGITX",317,0)
 ;*****************************************************
"RTN","VWREGITX",318,0)
 ;* Reminder: This data set is Patient file only (#2) *
"RTN","VWREGITX",319,0)
 ;* MYESNO____=1 is a parent                          *
"RTN","VWREGITX",320,0)
 ;*           =0 is a primary field                   *
"RTN","VWREGITX",321,0)
 ;*****************************************************
"RTN","VWREGITX",322,0)
 ;
"RTN","VWREGITX",323,0)
 S MYESNO=$S(+$P(^DD(2,X,0),"^",2):1,1:0)
"RTN","VWREGITX",324,0)
 Q MYESNO
"RTN","VWREGITX",325,0)
 ;
"RTN","VWREGITX",326,0)
 
"VER")
8.0^22.2
"^DD",2,2,540001.1,0)
HEALTH RECORD NUMBER^F^^648HRN;1^K:$L(X)>30!($L(X)<1) X
"^DD",2,2,540001.1,3)
Enter patient/client's health record number (HRN), up to 30 characters
"^DD",2,2,540001.1,"DT")
3160309
"^DD",64850001,64850001,0)
FIELD^^.001^2
"^DD",64850001,64850001,0,"DDA")
N
"^DD",64850001,64850001,0,"DT")
3150506
"^DD",64850001,64850001,0,"IX","B",64850001,.01)

"^DD",64850001,64850001,0,"NM","PATIENT FILE FIELD EXCLUSIONS")

"^DD",64850001,64850001,.001,0)
FNUMBER^NJ15,7X^^ ^K:+X'=X!(X>9999999.9999999)!(X<0)!(X?.E1"."8N.N) X S:$G(X) DINUM=X
"^DD",64850001,64850001,.001,3)
Type a number between 0 and 9999999.9999999, 7 decimal digits.
"^DD",64850001,64850001,.001,"DT")
3150506
"^DD",64850001,64850001,.01,0)
FIELD^RF^^0;1^K:$L(X)>99!($L(X)<1)!'(X'?1P.E) X
"^DD",64850001,64850001,.01,1,0)
^.1
"^DD",64850001,64850001,.01,1,1,0)
64850001^B
"^DD",64850001,64850001,.01,1,1,1)
S ^DIZ(64850001,"B",$E(X,1,30),DA)=""
"^DD",64850001,64850001,.01,1,1,2)
K ^DIZ(64850001,"B",$E(X,1,30),DA)
"^DD",64850001,64850001,.01,1,1,"DT")
3151009
"^DD",64850001,64850001,.01,3)
Answer must be 1-99 characters in length.
"^DD",64850001,64850001,.01,"DT")
3151009
"^DD",64850002,64850002,0)
FIELD^^2.5^4
"^DD",64850002,64850002,0,"DDA")
N
"^DD",64850002,64850002,0,"DT")
3150602
"^DD",64850002,64850002,0,"IX","B",64850002,.01)

"^DD",64850002,64850002,0,"IX","C",64850002,3)

"^DD",64850002,64850002,0,"NM","CIVILIAN PATIENT FIELDS")

"^DD",64850002,64850002,.01,0)
NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
"^DD",64850002,64850002,.01,1,0)
^.1
"^DD",64850002,64850002,.01,1,1,0)
64850002^B
"^DD",64850002,64850002,.01,1,1,1)
S ^DIZ(64850002,"B",$E(X,1,30),DA)=""
"^DD",64850002,64850002,.01,1,1,2)
K ^DIZ(64850002,"B",$E(X,1,30),DA)
"^DD",64850002,64850002,.01,3)
Answer must be 3-30 characters in length.
"^DD",64850002,64850002,.01,4)
S X="SHOW ME THIS FIELD AND WHERE ITS LOCATED"
"^DD",64850002,64850002,.01,"DT")
3150601
"^DD",64850002,64850002,2,0)
FIELD NO^NJ15,7^^0;2^K:+X'=X!(X>9999999.9999999)!(X<0)!(X?.E1"."8N.N) X
"^DD",64850002,64850002,2,3)
Type a number between 0 and 9999999.9999999, 7 decimal digits.
"^DD",64850002,64850002,2,"DT")
3150601
"^DD",64850002,64850002,2.5,0)
Multiple of field^64850002.01A^^M;0
"^DD",64850002,64850002,3,0)
GROUP^F^^0;3^K:$L(X)>30!($L(X)<1) X
"^DD",64850002,64850002,3,1,0)
^.1
"^DD",64850002,64850002,3,1,1,0)
64850002^C
"^DD",64850002,64850002,3,1,1,1)
S ^DIZ(64850002,"C",$E(X,1,30),DA)=""
"^DD",64850002,64850002,3,1,1,2)
K ^DIZ(64850002,"C",$E(X,1,30),DA)
"^DD",64850002,64850002,3,1,1,"DT")
3150601
"^DD",64850002,64850002,3,3)
Answer must be 1-30 characters in length.
"^DD",64850002,64850002,3,"DT")
3150601
"^DD",64850002,64850002.01,0)
Multiple of field SUB-FIELD^^3^3
"^DD",64850002,64850002.01,0,"DT")
3150602
"^DD",64850002,64850002.01,0,"IX","B",64850002.01,.01)

"^DD",64850002,64850002.01,0,"NM","Multiple of field")

"^DD",64850002,64850002.01,0,"UP")
64850002
"^DD",64850002,64850002.01,.01,0)
Multiple of field^F^^0;1^K:$L(X)>30!($L(X)<1) X
"^DD",64850002,64850002.01,.01,1,0)
^.1
"^DD",64850002,64850002.01,.01,1,1,0)
64850002.01^B
"^DD",64850002,64850002.01,.01,1,1,1)
S ^DIZ(64850002,DA(1),"M","B",$E(X,1,30),DA)=""
"^DD",64850002,64850002.01,.01,1,1,2)
K ^DIZ(64850002,DA(1),"M","B",$E(X,1,30),DA)
"^DD",64850002,64850002.01,.01,3)
Answer must be 1-30 characters in length.
"^DD",64850002,64850002.01,.01,"DT")
3150601
"^DD",64850002,64850002.01,2,0)
FIELD NO^NJ15,7^^0;2^K:+X'=X!(X>9999999.9999999)!(X<0)!(X?.E1"."8N.N) X
"^DD",64850002,64850002.01,2,3)
Type a number between 0 and 9999999.9999999, 7 decimal digits.
"^DD",64850002,64850002.01,2,"DT")
3150601
"^DD",64850002,64850002.01,3,0)
MULT OF MULT^64850002.13A^^MM;0
"^DD",64850002,64850002.13,0)
MULT OF MULT SUB-FIELD^^2^2
"^DD",64850002,64850002.13,0,"DT")
3150602
"^DD",64850002,64850002.13,0,"IX","B",64850002.13,.01)

"^DD",64850002,64850002.13,0,"NM","MULT OF MULT")

"^DD",64850002,64850002.13,0,"UP")
64850002.01
"^DD",64850002,64850002.13,.01,0)
MULT OF MULT^F^^0;1^K:$L(X)>30!($L(X)<1) X
"^DD",64850002,64850002.13,.01,1,0)
^.1
"^DD",64850002,64850002.13,.01,1,1,0)
64850002.13^B
"^DD",64850002,64850002.13,.01,1,1,1)
S ^DIZ(64850002,DA(2),"M",DA(1),"MM","B",$E(X,1,30),DA)=""
"^DD",64850002,64850002.13,.01,1,1,2)
K ^DIZ(64850002,DA(2),"M",DA(1),"MM","B",$E(X,1,30),DA)
"^DD",64850002,64850002.13,.01,3)
Answer must be 1-30 characters in length.
"^DD",64850002,64850002.13,.01,"DT")
3150602
"^DD",64850002,64850002.13,2,0)
SFNOS^F^^0;2^K:$L(X)>30!($L(X)<1) X
"^DD",64850002,64850002.13,2,3)
Answer must be 1-30 characters in length.
"^DD",64850002,64850002.13,2,"DT")
3150602
"^DD",64850003,64850003,0)
FIELD^^.05^3
"^DD",64850003,64850003,0,"DT")
3160410
"^DD",64850003,64850003,0,"IX","B",64850003,.01)

"^DD",64850003,64850003,0,"NM","FIELD GROUPS")

"^DD",64850003,64850003,.01,0)
ABBREVIATION^RF^^0;1^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X
"^DD",64850003,64850003,.01,1,0)
^.1
"^DD",64850003,64850003,.01,1,1,0)
64850003^B
"^DD",64850003,64850003,.01,1,1,1)
S ^DIZ(64850003,"B",$E(X,1,30),DA)=""
"^DD",64850003,64850003,.01,1,1,2)
K ^DIZ(64850003,"B",$E(X,1,30),DA)
"^DD",64850003,64850003,.01,3)
Answer must be 1-30 characters in length.
"^DD",64850003,64850003,.01,"DT")
3160408
"^DD",64850003,64850003,.05,0)
FOR^F^^0;2^K:$L(X)>30!($L(X)<1) X
"^DD",64850003,64850003,.05,3)

"^DD",64850003,64850003,.05,"DT")
3160410
"^DD",64850003,64850003,2,0)
FIELD(S)^64850003.02^^F;0
"^DD",64850003,64850003.02,0)
FIELD(S) SUB-FIELD^^.01^1
"^DD",64850003,64850003.02,0,"DT")
3160409
"^DD",64850003,64850003.02,0,"IX","B",64850003.02,.01)

"^DD",64850003,64850003.02,0,"NM","FIELD(S)")

"^DD",64850003,64850003.02,0,"UP")
64850003
"^DD",64850003,64850003.02,.01,0)
FIELD(S)^MF^^0;1^K:$L(X)>30!($L(X)<1) X
"^DD",64850003,64850003.02,.01,1,0)
^.1
"^DD",64850003,64850003.02,.01,1,1,0)
64850003.02^B
"^DD",64850003,64850003.02,.01,1,1,1)
S ^DIZ(64850003,DA(1),"F","B",$E(X,1,30),DA)=""
"^DD",64850003,64850003.02,.01,1,1,2)
K ^DIZ(64850003,DA(1),"F","B",$E(X,1,30),DA)
"^DD",64850003,64850003.02,.01,3)
Answer must be 1-30 characters in length.
"^DD",64850003,64850003.02,.01,"DT")
3160409
"^DD",64850004,64850004,0)
FIELD^^.02^3
"^DD",64850004,64850004,0,"DDA")
N
"^DD",64850004,64850004,0,"DT")
3160503
"^DD",64850004,64850004,0,"IX","B",64850004,.01)

"^DD",64850004,64850004,0,"IX","C",64850004,.02)

"^DD",64850004,64850004,0,"NM","VERBOTEN TEMPLATES")

"^DD",64850004,64850004,.001,0)
NUMBER^NJ9,0^^ ^K:+X'=X!(X>999999999)!(X<0)!(X?.E1"."1N.N) X
"^DD",64850004,64850004,.001,3)
Type a number between 0 and 999999999, 0 decimal digits.
"^DD",64850004,64850004,.001,"DT")
3160503
"^DD",64850004,64850004,.01,0)
TEMPLATE NAME^RF^^0;1^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X
"^DD",64850004,64850004,.01,1,0)
^.1
"^DD",64850004,64850004,.01,1,1,0)
64850004^B
"^DD",64850004,64850004,.01,1,1,1)
S ^DIZ(64850004,"B",$E(X,1,30),DA)=""
"^DD",64850004,64850004,.01,1,1,2)
K ^DIZ(64850004,"B",$E(X,1,30),DA)
"^DD",64850004,64850004,.01,3)
Answer must be 1-30 characters in length.
"^DD",64850004,64850004,.01,10)
.402
"^DD",64850004,64850004,.01,20,0)
^.3LA^1^1
"^DD",64850004,64850004,.01,20,1,0)
TEMPLATE
"^DD",64850004,64850004,.01,21,0)
^^2^2^3160503^
"^DD",64850004,64850004,.01,21,1,0)
These are templates that are screen driven on the roll 'n scroll
"^DD",64850004,64850004,.01,21,2,0)
Fileman environ. The GUI by BFP for WorldVistA does not special navigation.
"^DD",64850004,64850004,.01,"DT")
3160503
"^DD",64850004,64850004,.02,0)
IEN^NJ9,0^^0;2^K:+X'=X!(X>999999999)!(X<0)!(X?.E1"."1N.N) X
"^DD",64850004,64850004,.02,1,0)
^.1
"^DD",64850004,64850004,.02,1,1,0)
64850004^C
"^DD",64850004,64850004,.02,1,1,1)
S ^DIZ(64850004,"C",$E(X,1,30),DA)=""
"^DD",64850004,64850004,.02,1,1,2)
K ^DIZ(64850004,"C",$E(X,1,30),DA)
"^DD",64850004,64850004,.02,1,1,"DT")
3160503
"^DD",64850004,64850004,.02,3)
Type a number between 0 and 999999999, 0 decimal digits.
"^DD",64850004,64850004,.02,"DT")
3160503
"^DIC",64850001,64850001,0)
PATIENT FILE FIELD EXCLUSIONS^64850001
"^DIC",64850001,64850001,0,"GL")
^DIZ(64850001,
"^DIC",64850001,64850001,"%",0)
^1.005^^0
"^DIC",64850001,64850001,"%D",0)
^^7^7^3150506^
"^DIC",64850001,64850001,"%D",1,0)
This is not quite a Fileman legal file, although it can be edited,
"^DIC",64850001,64850001,"%D",2,0)
preferrably by programmer access and direct code.
"^DIC",64850001,64850001,"%D",3,0)
The file contains patient file(#2) field numbers. These are fields that I
"^DIC",64850001,64850001,"%D",4,0)
arbitrarily consider VA specific fields and pretty much not applicable
"^DIC",64850001,64850001,"%D",5,0)
anywhere else.
"^DIC",64850001,64850001,"%D",6,0)
I know....how arrogant...
"^DIC",64850001,64850001,"%D",7,0)
jb
"^DIC",64850001,"B","PATIENT FILE FIELD EXCLUSIONS",64850001)

"^DIC",64850002,64850002,0)
CIVILIAN PATIENT FIELDS^64850002
"^DIC",64850002,64850002,0,"GL")
^DIZ(64850002,
"^DIC",64850002,64850002,"%D",0)
^1.001^1^1^3150610^^
"^DIC",64850002,64850002,"%D",1,0)
Fields selected by the author that are considered to be non-VA mandates
"^DIC",64850002,"B","CIVILIAN PATIENT FIELDS",64850002)

"^DIC",64850003,64850003,0)
FIELD GROUPS^64850003
"^DIC",64850003,64850003,0,"GL")
^DIZ(64850003,
"^DIC",64850003,"B","FIELD GROUPS",64850003)

"^DIC",64850004,64850004,0)
VERBOTEN TEMPLATES^64850004
"^DIC",64850004,64850004,0,"GL")
^DIZ(64850004,
"^DIC",64850004,64850004,"%D",0)
^1.001^3^3^3170209^^
"^DIC",64850004,64850004,"%D",1,0)
These are templates that have navigation for the roll 'n scroll
"^DIC",64850004,64850004,"%D",2,0)
Fileman environ. The GUI Registation utility by BFP for World-
"^DIC",64850004,64850004,"%D",3,0)
VistA does not require navigation.
"^DIC",64850004,"B","VERBOTEN TEMPLATES",64850004)

**END**
**END**