This commit is contained in:
jbell
parent
7eabd8c1a4
commit
5b4056f0a1
|
|
@ -0,0 +1,155 @@
|
|||
<!DOCTYPE HTML>
|
||||
<html>
|
||||
<Head><title>Home page</title>
|
||||
<style type="text/css">
|
||||
body {
|
||||
background: #d85570, no-repeat;
|
||||
background: -webkit-linear-gradient(left,#106CAC,black);
|
||||
background: -moz-linear-gradient(left,#106CAC,black);
|
||||
/* background: -moz-linear-gradient(left, #106CAC,black);*/ /* For Firefox 3.6 to 15 */
|
||||
background: -o-linear-gradient(left,#106CAC,black); /* For Opera 11.1 to 12.0 */
|
||||
background: linear-gradient(left,#106CAC,black); /*Standard syntax */
|
||||
background: linear-gradient(left, #106CAC,black); /* IE ? */
|
||||
background: -ms-linear-gradient(left, #106CAC, black); /* IE 11 */
|
||||
/*background-repeat: repeat;*/
|
||||
/*background-position: center;*/
|
||||
font-family: Verdana;
|
||||
font-size: .95em;
|
||||
color:White;
|
||||
margin-left: 200px;
|
||||
margin-right: 300px;
|
||||
}
|
||||
a:link {color: White;}
|
||||
a:active {color: White;}
|
||||
a:Visited {color: White;}
|
||||
|
||||
</style>
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<div align="center" style="font-family: Verdana; font-size: 2em;">
|
||||
Patient Registration and Template Utility Help</div>
|
||||
<div align="center" style="font-family: Verdana; font-Size: .8em;"> brought to you by </div>
|
||||
<table align="center">
|
||||
<tr>
|
||||
<td> </td>
|
||||
<td><a href="http://www.worldvista.org"><img src="file:///C:/VWREG/WVLogo11172013_50perc.gif" alt="WorldVistA.org" /></a></td>
|
||||
<td> </td>
|
||||
<td><a href="http://www.hardhats.org/fileman/pm/"><img src="file:///C:/VWREG/Filemanager Logo_scaled down.png" height=60 width=60 alt="By George Timson" /></a></td>
|
||||
<td> </td>
|
||||
<td><a href="http://www.d00a.com/"><img src="file:///C:/VWREG/BFproductions012511_125perc.gif" height=55 width=60 alt="BellFelder Prod. LLC"></a></td>
|
||||
<td> </td>
|
||||
</tr>
|
||||
</table>
|
||||
|
||||
|
||||
<table align="center" style="border: 1; border-spacing: 10px;">
|
||||
<tr>
|
||||
<td><a href="#Clear">Clear</a></td>
|
||||
<td><a href="#Exit">Exit</a></td>
|
||||
<td><a href="#Forms">Forms</a></td>
|
||||
<td><a href="#Save">Save</a></td>
|
||||
<td><a href="#Select Patient">Sel(ect) Patient</a></td>
|
||||
<td><a href="#Utilities">Utilities</a></td>
|
||||
<td><a href="#Examples">Examples</a></td>
|
||||
<td><a href="mailto:jbellco65@gmail.com"><u>Contact</u></a></td>
|
||||
</tr>
|
||||
</table>
|
||||
</div>
|
||||
<p><b>Intro:</b>
|
||||
This application is primarily oriented to the patient file. Referencing files are utilized but new additions and editing are patient specific. The application depends on the manager's and/or user's ability to make Fileman templates, or select specific patient file fields on the fly for data editing. Click on the Fileman icon at the top of the form for Fileman manuals.
|
||||
Regarding usership: access by employees you want to have/use the application can be managed
|
||||
via Fileman/Kernel User Management menu by adding to their secondary menu -
|
||||
<ul>
|
||||
<li>Standard users should receive the <b>VW PATIENT REGISTRATION</b> menu option. Users can
|
||||
edit their own templates.</li>
|
||||
<li>Manager type users should also receive the <b>VW REG IT CONTROL</b> menu option. Managers
|
||||
can create, delete, edit their templates, plus any other template they will have access
|
||||
to (e.g., user templates and/or any template allowed to them). Managers should at least
|
||||
be assigned the # in their <b>FILE MANAGER ACCESS CODE</b></li>
|
||||
</ul>
|
||||
</p>
|
||||
<b>Clear:</b><br>
|
||||
Clear is a "cleaner", like Leon in the movie "The Professional". It will remove any data
|
||||
in the edit fields, and then remove any of the template components on the page, leaving
|
||||
you a new, clean slate.
|
||||
<br><br>
|
||||
<b>Exit:</b><br>
|
||||
"Buh-bye!" You guessed it: closes the form (and uses the "cleaner" before doing so).
|
||||
<br><br>
|
||||
<b>Forms:</b><br>
|
||||
<img src="Help_FormsExample_75perc.png" Align=left>
|
||||
The Forms menu contains templates you can select. The installation will bring some stock
|
||||
WorldVistA/BFP templates, but it can also contain templates that are site local:
|
||||
New templates made by the local site will be included in the list.<br>
|
||||
|
||||
<a name="Save"><p><b>Save:</b></a>
|
||||
Pressing save will save whatever template and fields you input. The template will clear and you can do your next patient/client.</p>
|
||||
<div align="right"><a href="#TOP">Top</a></div>
|
||||
|
||||
<a name="Select Patient"><b>Sel(ect) Patient:</b><br>
|
||||
<img src="Help_SelectPatient_80perc.png" Align=Right>
|
||||
If you are wanting to edit data on a patient, select a template first. Then
|
||||
there are several ways of selecting patients. You can get a list by alphabetical letter,
|
||||
which is the first letter of the last name, or you can use the radio buttons to select
|
||||
by that category listing. Double-click the ID/HRN column to get your selection (even if
|
||||
it's blank).<br><i>NOTE: "Prior Patient" - This is a feature of Fileman. It tracks
|
||||
the last action/selection you were working on. So, if you saved a new patient entry,
|
||||
or were editing an existing patient and cleared the form via save, and wanted to
|
||||
return that patient to the form, Press the Prior Patient radio button once and <b>VIOLA!</b> that patient will be re-selected for action.</i><br>
|
||||
<i>The menus:</i><br>
|
||||
<li>Cancel: Closes the window without action</li>
|
||||
<li>Clear: Clears all the fields for new selection</li>
|
||||
|
||||
If you chose to use a radio button category, other than Prior Patient, the cursor will be placed in that field for your input. Then press the "GO" image.
|
||||
|
||||
The example selected the letter "p" for an alphabetical listing. Note that the Fileman
|
||||
will also look at aliases, hence the "ZZ" selection in the list.<br><br>
|
||||
<i><b>(Of Special Note:</b> In the listing area, select an entry by double-clicking in the first column (ID/HRN), even though it might be empty. The display is displayed by row, but selection is only done in the first column.)</i><div align="right"><a href="#TOP">Top</a></div><br>
|
||||
<br><br>
|
||||
<br>
|
||||
<a name=Examples><b>Examples</b></a>
|
||||
|
||||
<!-- <div align="right"><a href="#TOP">Top</a></div> -->
|
||||
<br>
|
||||
<table border width="100%"style="border: 1px solid white; border-spacing: 2px; cellspacing: 2px;">
|
||||
<tr style="text-align: left;">
|
||||
<td><a href="#Select">Select From the Form Menu</a></td>
|
||||
<td><a href="#Mult">Multiple fields</a></td>
|
||||
<td><a href="#Hovering">"Hovering"</a></td>
|
||||
<td><a href="#Closing">Closing the Main Reg. Window</a></td>
|
||||
</tr>
|
||||
</table>
|
||||
<br><br>
|
||||
<a name="Select"><b>Selecting from the Forms Menu:</b></a><br>
|
||||
<img src="Help_FormsExample2.png" alt="Selecting from forms menu" Align="Left">
|
||||
Clicking on the "Forms" menu will bring up a list of templates. Templates are files where a number of fields
|
||||
have been selected for presentation and are saved in the database for selection at anytime. Click on the template you want. The fields will be listed in a vertical order. The Window should auto-size and there would likely be no
|
||||
scrolling. In this example, I've selected PT REGISTRATION [WorldVistA]. The communications software will call the database, select the template so named and will return the fields for editing.
|
||||
<br>
|
||||
<img src="Help_FormSelected_80perc.png" alt="Template selected" align="right">
|
||||
As noted fields are simply listed vertically and input can begin. You can either choose to mouse and click to another rield or using the <tab> key will sequentially move through the field set.<br>
|
||||
<li>Fields that have a small down-arrow at the end of the field means that there are other possible selections for that field. Clicking on the arrow will list them for selection.</li><li>Fields that have a reference file connection, like MARITAL STATUS, upon entry to that field, a pop-up window will display the selections. In those windows, you can either double-click or single-click-return to select the value (See below).</li>
|
||||
<br>
|
||||
<img src="Help_ReferenceSelection2.png" alt="" align="left">
|
||||
I double-clicked "NEVER MARRIED", the result below:<img src="Help_ReferenceSelected2.png" alt=""align="right"><br><br><br><br><br><br><br><br><br><br>
|
||||
<a name=Hovering><b>Hovering over a field:</b></a><br>
|
||||
If there is any help text on the server for a field, it will be available for display as shown below. You can't see the mouse, but it is hovering over the name field, and VOILA! Help text will be displayed.
|
||||
<img src="Help_Hovering2.png" alt="" align="center">
|
||||
<br><br>
|
||||
<a name=Mult><b>Fields that take more than a single value:</b></a><br>
|
||||
<img src="Help_Multiples2.png" alt="" align="left">
|
||||
The value of M and the Fileman database is that one can create fields that carry multiple values. In this case, we'll look at CLINIC ENROLLMENT. I entered the field ENROLLMENT CLINIC and the pop-up that allows for multiple values is displayed. The fields you see in that window are the fields that have been selected as part of the PT REGISTRATION... template. The rules for sets of codes, indicated by a down-arrow at the end of the field, or a reference file for a field apply. Note that this window carries an "Add", "Cancel", "Finished","Help" selection. Use the "Add" option to save your input into the listing at the bottom of the window. Make the necessary selections for the fields. When done, press the "Finished" option. Those fields will be sent to the main form, and the Multiple window will close. The main form will show the last selection made from the multiple, but the multiple values are saved invisibly on the main form and transferred with the rest of any data to the server on "Save".<br>
|
||||
<br>
|
||||
<a name="Closing"><b>Closing the main window:</b><br>
|
||||
I typically use the clear and the exit menu selections. Remember to save your work, if that is the intention, which will also clear the form components and fields. However, if you just want to close the window without saving anything, use the Clear and Exit buttons, just to be on the safe side.
|
||||
<div align="right"><a href="#TOP">Top</a></div>
|
||||
<a name="Utilities"><b>Utilities</b><br>
|
||||
<p align="center"><b>A kinda one shot pic of template management</b></p>
|
||||
<div align="center"><img src="ImagestoSend\Help_TM.png" alt="1=shot"></div>
|
||||
<div align="right"><a href="#TOP">Top</a></div>
|
||||
|
||||
|
||||
</body>
|
||||
|
||||
</html>
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
<!DOCTYPE HTML>
|
||||
<html>
|
||||
<Head><title>Home page</title>
|
||||
<style type="text/css">
|
||||
body {
|
||||
background: #d85570, no-repeat;
|
||||
background: -webkit-linear-gradient(left,#106CAC,black);
|
||||
background: -moz-linear-gradient(left,#106CAC,black);
|
||||
/* background: -moz-linear-gradient(left, #106CAC,black);*/ /* For Firefox 3.6 to 15 */
|
||||
background: -o-linear-gradient(left,#106CAC,black); /* For Opera 11.1 to 12.0 */
|
||||
background: linear-gradient(left,#106CAC,black); /*Standard syntax */
|
||||
background: linear-gradient(left, #106CAC,black); /* IE ? */
|
||||
background: -ms-linear-gradient(left, #106CAC, black); /* IE 11 */
|
||||
/*background-repeat: repeat;*/
|
||||
/*background-position: center;*/
|
||||
font-family: Verdana;
|
||||
font-size: .95em;
|
||||
color:White;
|
||||
margin-left: 200px;
|
||||
margin-right: 300px;
|
||||
}
|
||||
a:link {color: White;}
|
||||
a:active {color: White;}
|
||||
a:Visited {color: White;}
|
||||
|
||||
</style>
|
||||
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<div align="center" style="font-family: Verdana; font-size: 2em;">Template Utility Help</div>
|
||||
<div align="center" style="font-family: Verdana; font-Size: .8em;"> brought to you by </div>
|
||||
<table align="center">
|
||||
<tr>
|
||||
<td> </td>
|
||||
<td><a href="http://www.worldvista.org"><img src="file:///C:/VWREG/WVLogo11172013_50perc.gif" alt="WorldVistA.org" /></a></td>
|
||||
<td> </td>
|
||||
<td><a href="http://www.hardhats.org/fileman/pm/"><img src="file:///C:/VWREG/Filemanager Logo_scaled down.png" height=60 width=60 alt="By George Timson" /></a></td>
|
||||
<td> </td>
|
||||
<td><a href="http://www.d00a.com/"><img src="file:///C:/VWREG/BFproductions012511_125perc.gif" height=55 width=60 alt="BellFelder Prod. LLC"></a></td>
|
||||
<td> </td>
|
||||
</tr>
|
||||
</table>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,162 @@
|
|||
VWREGIT ;Portland,OR/Jim Bell, et al Patient Registration Utility August 2015
|
||||
;;2.0;B/FProductions,LLC,WORLD VISTA;**LOCAL**;;Build 2
|
||||
;*******************************************************************
|
||||
;* VW Registration is designed for patient specific fields as *
|
||||
;* defined in Fileman Input Templates or ad hoc field selection. *
|
||||
;* Copyright Martius/MMXV ad infinitum (GNU License: See GPLv3.txt)*
|
||||
;*******************************************************************
|
||||
;;NO FALL THROUGH - JEB
|
||||
Q
|
||||
;
|
||||
TFM(XF) ;TemplateField Management
|
||||
;***********************************************
|
||||
;* Check primary field entries for "parentage" *
|
||||
;* Add an "*" to gain all sub-fields of the *
|
||||
;* parent *
|
||||
;* REMEMBER: All fields pertain to file 2 only *
|
||||
;***********************************************
|
||||
N I,N,FIELD
|
||||
K FARRAY
|
||||
I '$L(XF),'$G(TNUM) Q ""
|
||||
I '$L(XF),+$G(TNUM) S XF=^DIE(TNUM,"DR",1,2)
|
||||
F I=1:1:$L(XF,";") S:$L($P(XF,";",I)) FARRAY(I)=+$P(XF,";",I)
|
||||
S N=0 F I=1:1 S N=$O(FARRAY(N)) Q:'+N D
|
||||
. S FIELD=FARRAY(N)
|
||||
. I +$P(^DD(2,FIELD,0),"^",2) S FIELD=FIELD_"*",FMARRAY(FIELD)=$P(^(0),"^",4) K FARRAY(N)
|
||||
S XF="",N=0 F S N=$O(FARRAY(N)) Q:'+N S XF=XF_FARRAY(N)_";"
|
||||
Q XF
|
||||
;
|
||||
CHECK() ;
|
||||
Q ""
|
||||
;
|
||||
INR() Q $O(RESULT(" "),-1)+1
|
||||
;
|
||||
EN(RESULT) ;Template name and ID labels
|
||||
;Get the input template list
|
||||
;housekeeping
|
||||
S DTIME=99999
|
||||
;ZSY "chmod 777 "_$ZD_"regparam/*.txt" ;Moved to post-install
|
||||
;end housekeeping
|
||||
;
|
||||
K AR,RESULT
|
||||
N N,HD,FILE,LOC,P4,P5,%ZISHF,%ZISHO,DEFST,XTMP,X
|
||||
S RESULT(0)=1
|
||||
S DEFST="";
|
||||
;S DEFTMP=$O(^DIE("B","FAU_EDU",0)) ;For Florida College only
|
||||
S RESULT(0)=$$CONTROL^VWREGITU()
|
||||
S RESULT(1)="-1^No templates found"
|
||||
S DEFST=$$GET^XPAR("ALL","VW REG DEFAULT STATE")
|
||||
S DEFTMP=$$GET^XPAR("ALL","VW REG RDNPT")
|
||||
S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
|
||||
I '$L(HD) K RESULT D Q
|
||||
. S RESULT($$INR)="-1^NO HOME DIRECTORY - refer to IT support, if necessary."
|
||||
. S RESULT($$INR)="No home directory has been supplied which indicates"
|
||||
. S RESULT($$INR)="the VWREG installation is incomplete. See the Help manual"
|
||||
. S RESULT($$INR)="for installation and Enter/Editing parameter values."
|
||||
. S RESULT($$INR)="Thank you,"
|
||||
. S RESULT($$INR)=" The Management."
|
||||
S FILE="regit.txt"
|
||||
S P4=1
|
||||
S P5=""
|
||||
S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
|
||||
D:+RESULT(0)
|
||||
. S $P(RESULT(0),"^",2)=$G(HD)
|
||||
. S $P(RESULT(0),"^",3)=$S(DEFST:$P(^DIC(5,DEFST,0),"^")_"("_DEFST_")",1:"")
|
||||
. S $P(RESULT(0),"^",4)=$S(+DEFTMP:$P(^DIE(DEFTMP,0),"^")_"("_DEFTMP_")",1:DEFTMP)
|
||||
. S $P(RESULT(0),"^",5)=DUZ
|
||||
I $O(AR(0)) S RESULT(1)="[TEMPLATES]"
|
||||
S N=0 F S N=$O(AR(N)) Q:'+N D
|
||||
. Q:$E(AR(N))="*"
|
||||
. Q:'+$P(AR(N),"(",2)
|
||||
. Q:$P($G(^DIE(+$P(AR(N),"(",2),0)),"^",4)'=2 ;must be pat file
|
||||
. S RESULT($$INR)=AR(N)
|
||||
S RESULT($$INR)="[ID]"
|
||||
;S N=0 F S N=$O(^DIZ(64850003,N)) Q:'+N S RESULT($$INR)=$P(^(N,0),"^",2)_"("_$P(^(0),"^")_")"
|
||||
;S N=0 F S N=$O(RESULT(N)) Q:'+N K:RESULT(N)="" RESULT(N)
|
||||
I '$O(RESULT(0)) S RESULT(1)="-1^No PATIENT FILE templates found"
|
||||
K AR
|
||||
Q
|
||||
;
|
||||
NPT(RESULT,TNAME) ;
|
||||
; *************************************************
|
||||
; * Incoming: DFN^TEMPLATE NAME(IEN) *
|
||||
; * Process : Get template fields plus any help *
|
||||
; * If +TNAME (a DFN), get DFN data for *
|
||||
; * the template fields (Put data in *
|
||||
; * $P(RESULT(N),"^",3)) *
|
||||
; * Return : RESULT(N), etc *
|
||||
; *************************************************
|
||||
;W " ;Intentional bust for debugging
|
||||
N N,TNUM,FIELDS,F,FNAME,FVALUE,FHELP,FPSC,FNUM
|
||||
S TNUM=+$P(TNAME,"(",2),DFN=+TNAME
|
||||
I 'TNUM S RESULT(0)="0^new patient Template not found" Q
|
||||
S TNAME=$P($P(TNAME,"^",2),"(")
|
||||
S TNAME=$TR(TNAME,"$&*","") ;Clean out TMENU chars
|
||||
I TNAME="GENERIC INS. FRM [WorldVistA]" G GIF
|
||||
S FIELDS=$G(^DIE(TNUM,"DR",1,2))
|
||||
I '$L(FIELDS) Q
|
||||
K RESULT S (FNUM,FCAP)=""
|
||||
F I=1:1:$L(FIELDS,";")-1 D
|
||||
. S F=$P(FIELDS,";",I)
|
||||
. Q:'$D(^DD(2,F)) ;Not existing in this patient file
|
||||
. I F["~" S FNUM=+F,FNAME=$P($P(F,"~"),FNUM,2),F=FNUM K FNUM
|
||||
. S FNAME=$S($L($G(FNAME)):FNAME,$L($G(^DD(2,F,.1))):$P(^(.1),"^"),1:$P(^DD(2,F,0),"^"))
|
||||
. S FVALUE="" ;Patient Data
|
||||
. S FHELP=$G(^DD(2,F,3))
|
||||
. 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)
|
||||
. S FHELP=$TR(FHELP,"'","`")
|
||||
. S FPSC=$P(^DD(2,F,0),"^",3)
|
||||
. S SUBDIC=+$P(^DD(2,F,0),"^",2)
|
||||
. S RESULT($$INR)=FNAME_"^"_F_"^"_FVALUE_"^"_FHELP_"^"_FPSC_$S(SUBDIC:"^1",1:"^0")
|
||||
. S (FNAME,FVALUE,FHELP,FPSC)=""
|
||||
G NPTX:'DFN
|
||||
I DFN D GETS^DIQ(2,DFN_",","**","EN","AR") ;,RESULT(0)=$$DFNID^VWREGITU
|
||||
K FIELD S N=0 F S N=$O(RESULT(N)) Q:'+N S FIELD($P(RESULT(N),"^",2))=""
|
||||
S X="AR" F S X=$Q(@X) Q:X="" D
|
||||
. S FILE=+$P(X,"(",2)
|
||||
. S FIELD=+$P(X,",",$L(X,",")-1)
|
||||
. I $D(FIELD(FIELD)) S FIELD(FIELD)=@X
|
||||
S N=0 F S N=$O(FIELD(N)) Q:'+N D
|
||||
. S N2=0 F S N2=$O(RESULT(N2)) Q:'+N2 I $P(RESULT(N2),"^",2)=N S $P(RESULT(N2),"^",3)=FIELD(N)
|
||||
. S RESULT(0)=$$DFNID^VWREGITU()
|
||||
NPTX K FIELD,AR,FCAP,FILE,SUBDIC,N,N2,DFN
|
||||
Q
|
||||
;
|
||||
PF(RESULT,XPF) ;Pointer file - get the stuff
|
||||
K RESULT,AR
|
||||
N X,N
|
||||
I '$L(XPF) S RESULT(0)="???" Q
|
||||
S XPF="^"_XPF
|
||||
I +$P(XPF,"(",2)=.85 G NAUTPF ;Naughty file!
|
||||
S N=0 F S N=$O(@(XPF_N_")")) Q:'+N S X=$P(^(N,0),"^"),AR(X,N)=X_"("_N_")"
|
||||
S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
||||
K AR
|
||||
Q
|
||||
;
|
||||
NAUTPF ;The "NAUGHTY" pointer file - has a numeric .01 - Bad file !!!
|
||||
S N=0 F S N=$O(@(XPF_N_")")) Q:'+N S X=$P(^(N,0),"^") D
|
||||
. S LANG=$P(^(0),"^",2)
|
||||
. S AR(LANG,N)=LANG_"("_N_")"
|
||||
S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
||||
Q
|
||||
GIF ;Generic Insurance form
|
||||
K RESULT
|
||||
S RESULT($$INR)="Insurance Company^2.312;.01^^^DIC(36,^0"
|
||||
S RESULT($$INR)="Group Plan^2.312;.18^^^IBA(355.3,^0"
|
||||
S RESULT($$INR)="Policy No.^2.312;1^^^^0"
|
||||
;S RESULT($$INR)="Type of Plan^^^^^0"
|
||||
S RESULT($$INR)="Coverage^355.33;40.09^^^IBE(355.1,^0"
|
||||
S RESULT($$INR)="Effective Date^2.312;8^^^^0"
|
||||
S RESULT($$INR)="Expiration Date^.3121;^^^^0"
|
||||
S RESULT($$INR)="Guarantor^^^^^0"
|
||||
S RESULT($$INR)="Signature on File^^^^0:NO;1:YES^0"
|
||||
S RESULT($$INR)="Employer^2.312;2.015^^^^0"
|
||||
S RESULT($$INR)="Billing Address^2.312;2.02^^^^0"
|
||||
S RESULT($$INR)="Billing Address(cont)^2.312;2.03^^^^0"
|
||||
S RESULT($$INR)="Postal Code^2.312;2.07^^^^0"
|
||||
S RESULT($$INR)="City^2.312;2.05^^^^0"
|
||||
S RESULT($$INR)="County/Region/Area^^^^^0"
|
||||
S RESULT($$INR)="State/Province/Region^2.312;2.06^^^DIC(5,^0"
|
||||
Q
|
||||
;
|
||||
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
VWREGIT2 ;Portland/WorldVista/BFP,LLC/Jim Bell, et al... - Post-Install for VWREG
|
||||
;;1.0;WORLD VISTA;**HOME **;;Build 2
|
||||
;
|
||||
;Continued from VWREGIT
|
||||
;
|
||||
;GNU License: See WVLIC.txt
|
||||
;Modified FOIA VISTA,
|
||||
;Copyright 2013 WorldVistA. Licensed under the terms of the GNU
|
||||
Q
|
||||
PRE ;Did this installation happen already? Avoid a re-do?
|
||||
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"
|
||||
W !,"Do you want to continue? NO//" R X:60 S:'$L(X) X="NO" S X=$$UP^XLFSTR(X)
|
||||
I "NON"[X W !,"OK" D ^XUSCLEAN
|
||||
Q
|
||||
;
|
||||
PI ;Post Installation install
|
||||
;Checking for a home directory & file
|
||||
I $O(^XMB(3.8,"B","VW REG ERROR REPORT",0)) W !?5,"Installation has already occurred" Q
|
||||
S AR=1,AR(1)="[TEMPLATES]"
|
||||
S N=0 F S N=$O(^DIE(N)) Q:'+N S X=$P(^(N,0),"^") D
|
||||
. I X["VW " S AR($I(AR))=X_"("_N_")"
|
||||
. I X["[World" S AR($I(AR))=X_"("_N_")"
|
||||
S AR($I(AR))="[ID]"
|
||||
S P4=1,P5="",HD=$ZDIRECTORY_"regparam/",FILE="regit.txt"
|
||||
S X=$$GTF^%ZISH($NA(AR(1)),1,HD,"regit.txt")
|
||||
ZSY "chmod 777 "_$ZDIRECTORY_"regparam/"_FILE ;No sensitive info here
|
||||
Q:$G(TEST) ;Straightening out regit.txt
|
||||
;
|
||||
;; NOTE: The parameter definition is installed but there is no installation for
|
||||
;;the actual parameter and value. Do it here.
|
||||
;parameter value attempt
|
||||
;Set a home directory for editing; SYSTEM (DIC(4,) and DOMAIN (DIC(4.2,) only:"/home/vista/regparam/"
|
||||
S PARD=$O(^XTV(8989.51,"B","VW GUI REG TEMPLATE DIRECTORY",0))
|
||||
I PARD D
|
||||
. L +^XTV(8989.5,0):1 D L -^XTV(8989.5,0)
|
||||
.. S NEW=$O(^XTV(8989.5," "),-1)+1
|
||||
.. S $P(^XTV(8989.5,0),"^",3)=NEW
|
||||
.. S $P(^XTV(8989.5,0),"^",4)=$P(^(0),"^",4)+1
|
||||
.. S $P(^XTV(8989.5,NEW,0),"^")="1;DIC(4,"
|
||||
.. S $P(^XTV(8989.5,NEW,0),"^",2)=PARD
|
||||
.. S $P(^XTV(8989.5,NEW,0),"^",3)=1
|
||||
.. S ^XTV(8989.5,NEW,1)=HD
|
||||
.. S DA=NEW,DIK="^XTV(8989.5," D IX^DIK
|
||||
.. S NEW2=$O(^XTV(8989.5," "),-1)+1
|
||||
.. S $P(^XTV(8989.5,0),"^",3)=NEW2
|
||||
.. S $P(^XTV(8989.5,0),"^",4)=$P(^(0),"^",4)+1
|
||||
.. S $P(^XTV(8989.5,NEW2,0),"^")="9;DIC(4.2,"
|
||||
.. S $P(^XTV(8989.5,NEW2,0),"^",2)=PARD
|
||||
.. S $P(^XTV(8989.5,NEW2,0),"^",3)=1
|
||||
.. S ^XTV(8989.5,NEW2,1)=HD
|
||||
.. S DA=NEW2,DIK="^XTV(8989.5," D IX^DIK
|
||||
;
|
||||
;Mailgroup VW REG ERROR REPORT - add programmer's email
|
||||
S DA(1)=$O(^XMB(3.8,"B","VW REG ERROR REPORT",0))
|
||||
Q:'DA(1)
|
||||
S DIC="^XMB(3.8,"_DA(1)_",6,"
|
||||
S X="jbellco65@gmail.com"
|
||||
S DIC(0)="LZ"
|
||||
D FILE^DICN
|
||||
Q
|
||||
;
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
VWREGIT3 ;VWEHR/BFProd-Jim Bell, et al - World VistA GUI Pat Reg Utility
|
||||
;;1.0;WORLD VISTA;** **;;Build 2
|
||||
;
|
||||
;This routine utility is for patient specific fields and
|
||||
;is used to build input templates for registration
|
||||
;
|
||||
;GNU License: See WVLIC.txt
|
||||
;Modified FOIA VISTA,
|
||||
;Copyright 2013 WorldVistA. Licensed under the terms of the GNU
|
||||
Q
|
||||
;
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
VWREGITP ;BFP/Portland,OR-Jim Bell,et al - Client Registration Utility
|
||||
;2.0;BFP for WorldVistA;**LOCAL**;;;Build 2
|
||||
; *******************************************
|
||||
; * Copyright 2015 ad infinitum et ultra *
|
||||
; * Gets data for existing clients/patients *
|
||||
; * GPL License: See License.txt *
|
||||
; *******************************************
|
||||
Q ;No fall through - jeb
|
||||
;
|
||||
GPD(RESULT,DATA) ;Get patient data
|
||||
; ********************************* 8888***
|
||||
; * DATA_____TEMPLATE(IEN)^FIELDSET^DFN *
|
||||
; * TEMPLATE__The name(IEN) of a *
|
||||
; * stored template *
|
||||
; * FIELDSET_Adhoc fields in a string *
|
||||
; * as ".01;3;5;.131", etc *
|
||||
; * DFN______IEN of patient file(#2) *
|
||||
; * NOTE: TEMPLATE takes precedence *
|
||||
; * over FIELDSET *
|
||||
; *****************************************
|
||||
;
|
||||
K RESULT,AR
|
||||
N VAR,TNUM,FSET,F,DFN
|
||||
I '$L(DATA) S RESULT(0)="No information relayed. Please try again" Q
|
||||
I $P(DATA,"^",3)="" S RESULT(0)="Patient info not relayed. Please try again" Q
|
||||
S VAR="TNUM^ADHOC^DFN" F I=1:1:3 S @$P(VAR,"^",I)=$P(DATA,"^",I)
|
||||
S TNUM=$S(TNUM["(":+$P(TNUM,"(",2),1:TNUM)
|
||||
S DFN=+$P($P(DATA,"^",3),"(",2)
|
||||
S FSET=$S(TNUM:^DIE(TNUM,"DR",1,2),'TNUM&($L(ADHOC)):ADHOC,1:"")
|
||||
D GETS^DIQ(2,DFN_",","**","N","AR")
|
||||
F I=1:1:$L(FSET,";") D
|
||||
. Q:'$L($P(FSET,";",I))
|
||||
. S F=+$P(FSET,";",I)
|
||||
. S RESULT($$INR^VWREGIT)=F_"^"_$G(AR(2,DFN_",",F))
|
||||
Q
|
||||
GPDM(RESULT,DATA) ;
|
||||
; ****************************************************************
|
||||
; * DATA____Parent Text^Parent field #^PATIENT IEN^TEMPLATE(IEN) *
|
||||
; ****************************************************************
|
||||
N F,SUBD,DFN,PIEN,X,RIND,FILE,X,Y,TNUM
|
||||
K MX,MAR,RESULT,AR
|
||||
S DFN=+$P(DATA,"^",3)
|
||||
S F=+$P(DATA,"^",2)
|
||||
S TNUM=+$P($P(DATA,"^",4),"(",2)
|
||||
D GETS^DIQ(2,DFN_",",F_"*;","E","AR")
|
||||
S SUBD=+$P(^DD(2,F,0),"^",2) D:+SUBD ;Multiple field values
|
||||
. S MX="AR("_SUBD_")" F S MX=$Q(@MX) Q:MX=""!(+$P(MX,"(",2)'=SUBD) D:$P(MX,",",$L(MX,",")-1)'=.01
|
||||
.. S FILE=SUBD,PIEN=$P(MX,",",2,$L(MX,",")-1),PIEN=$TR(PIEN,"""","")
|
||||
.. K MAR,IMAR
|
||||
.. D GETS^DIQ(FILE,PIEN,"**","E","MAR")
|
||||
.. D GETS^DIQ(FILE,PIEN,"**","I","IMAR")
|
||||
.. S X=$Q(@"MAR"),Y=$Q(@"IMAR")
|
||||
.. I @X'=@Y S @X=@X_"("_@Y_")"
|
||||
.. S X="MAR" ;,RIND=$$INR^VWREGIT
|
||||
.. S RIND=$$INR^VWREGIT,RESULT(RIND)="" F S X=$Q(@X) Q:X="" S RESULT(RIND)=RESULT(RIND)_@X_"^"
|
||||
K AR,MAR,IMAR,MX
|
||||
Q
|
||||
|
|
@ -0,0 +1,115 @@
|
|||
VWREGITS ;Portland,OR/jeb et al Save utility for VWREG* routines 11/2015
|
||||
;V.2;;**LOCAL**;;;Build 2
|
||||
;c2014 ad infiniti, BellFelder Productions (BF Productions) & WorldVistA
|
||||
;License: See License.txt that with install
|
||||
;No fall thru - jeb
|
||||
Q
|
||||
;
|
||||
;* *****************************************************************
|
||||
;* Data coming in may be for a new case or existing case *
|
||||
;* Incoming: Array LDATA= *
|
||||
;* LDATA(1)=Field^Field number^value^[optional]DFN *
|
||||
;* LDATA(N...)=Field^Field number^value *
|
||||
;* Exception for Multiples: *
|
||||
;* LDATA(N)=Field(SUBDD;Field number):value(IEN)^...etc for every*
|
||||
;* field that is a dependent of the parent *
|
||||
;* Process: *
|
||||
;* 1. call is at Label SAVE *
|
||||
;* 2. Some housekeeping that this programmer needs to do proper *
|
||||
;* string evaluations. *
|
||||
;* 3. Filing of a new case with FILE^DICN. *
|
||||
;* 4. Remaining major fields are filed with DIE *
|
||||
;* 5. Multiples are filed with UPDATE^DIE *
|
||||
;* 6. Existing entries will contain only edited data and will *
|
||||
;* address those fields as in 4 & 5. *
|
||||
;* Bon Appettit, et al. *
|
||||
;*******************************************************************
|
||||
SAVE(RESULT,LDATA) ;
|
||||
K RESULT,^DIZ("DS",$J)
|
||||
M ^DIZ("DS",$J)=LDATA
|
||||
;Q ;Testing
|
||||
N DFN,DIC,DA,DR,VAR,FIELD,N,N1,X,Y,DIE,DIK
|
||||
I $D(LDATA)<10 S RESULT(0)="-1: No data sent for filing. Please contact your IT dept." Q
|
||||
;UPcase everyTHING
|
||||
S XDAT="LDATA" F S XDAT=$Q(@XDAT) Q:XDAT="" S @XDAT=$$UP^XLFSTR(@XDAT)
|
||||
;
|
||||
;Incoming housekeeping
|
||||
S X="LDATA" F I=1:1 S X=$Q(@X) Q:X="" I @X[":",@X[";" S ^DIZ("DS",$J,I)=@X K @X
|
||||
I +$P(@$Q(LDATA),"^",4)!(+$P(@$Q(LDATA),"(",2)) G EXP ;DFN sent by client
|
||||
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)
|
||||
S DFN=$$FIND1^DIC(2,"","M",$P(LDATA(1),"^",3),"","","ERR")
|
||||
G EXP:DFN ;Found patient/client
|
||||
;End housekeeping;
|
||||
;
|
||||
S X=$P(LDATA(1),"^",3) D
|
||||
. S DIC="^DPT(",DIC(0)="LZ" K D0 D FILE^DICN S (DA,DFN)=+Y
|
||||
. S DIC="^AUPNPAT(",DIC(0)="LZ",X=DFN,DINUM=X,DIC(0)="L" D FILE^DICN
|
||||
. S DIE=DIC,DR=.03_"////^S X=DT" D ^DIE
|
||||
. S DR=.11_"////^S X=DUZ" D ^DIE
|
||||
LDPT L +^DPT(DFN):1 G LDPT:'$T
|
||||
S N=1 F S N=$O(LDATA(N)) Q:'+N D
|
||||
. Q:$P(LDATA(N),"^",2)[";"
|
||||
. Q:'+$P(LDATA(N),"^",2) ;Marker of some kind
|
||||
. S FIELD=$P(LDATA(N),"^",2)
|
||||
. S VAR=$P(LDATA(N),"^",3)
|
||||
. I FIELD=.03 D
|
||||
.. S VAR=$$DC(VAR)
|
||||
.. S VARTIME=$P(VAR,".",2),VAR=$P(VAR,".")
|
||||
.. I $L(VARTIME) D
|
||||
... N FDA
|
||||
... S FDA(2,DFN_",",540000.1)=VARTIME
|
||||
... D FILE^DIE("E","FDA")
|
||||
... D CLEAN^DILF
|
||||
. S:VAR["(" VAR=$S($L(VAR,"(")>2:+$P(VAR,"(",$L(VAR,"(")),1:+$P(VAR,"(",2))
|
||||
. S DIE="^DPT(",DR=FIELD_"///"_$S(+VAR:"/",1:"")_"^S X=VAR" D ^DIE
|
||||
L -^DPT(DFN)
|
||||
D M ;File any multiple fields
|
||||
S RESULT(0)="Filed..."
|
||||
K ^DIZ("DS",$J)
|
||||
Q
|
||||
;
|
||||
EXP ;Existing Patient
|
||||
K X,FNAME,FFLD,FVALUE,AR,DIC,DA,DR,DIE,AR
|
||||
S X="LDATA" F S X=$Q(@X) Q:X="" I @X[":" S AR($O(AR(" "),-1)+1)=@X K @X
|
||||
S N=0 F S N=$O(LDATA(N)) Q:'+N S X=LDATA(N) D
|
||||
. S FNAME=$P(X,"^")
|
||||
. S FFLD=$P(X,"^",2)
|
||||
. S FVALUE=$S($P(X,"^",3)["(":+$P(X,"(",2),1:$P(X,"^",3))
|
||||
. S DFN=$P(X,"^",4)
|
||||
. S DIE="^DPT(",DA=DFN,DR=FFLD_"///^S X=FVALUE" D ^DIE
|
||||
D M
|
||||
S RESULT($I(RESULT))="Filed..."
|
||||
K X,FNAME,FFL,FVALUE,DFN,AR,DIE,DA,DR,DIC
|
||||
Q
|
||||
;
|
||||
M ;File any multiples values; DFN should be defined above
|
||||
Q:'$D(^DIZ("DS",$J))
|
||||
M MULTS=^DIZ("DS",$J)
|
||||
K MAR S N=0 F S N=$O(MULTS(N)) Q:'+N D
|
||||
. F J=1:1:$L(MULTS(N),"^")-1 S MAR(J)=$P(MULTS(N),"^",J)
|
||||
. S MX=$O(MAR(0))
|
||||
. S MXFILE=+$P(MAR(MX),"(",2)
|
||||
. S MXFLD=+$P(MAR(MX),";",2)
|
||||
. S MXVAL=$P($P(MAR(MX),":",2),"(")
|
||||
. I MXFLD=.01 S MXDATA(MXFILE,"?+1,"_DFN_",",MXFLD)=MXVAL K IEN D UPDATE^DIE("E","MXDATA","IEN","ERROR") Q:$G(DIERR) D
|
||||
.. S RECORD=$G(IEN(1)),INC=$G(IEN(1,0))
|
||||
.. S J=MX F S J=$O(MAR(J)) Q:'+J D
|
||||
... s MXFILE=+$P(MAR(J),"(",2)
|
||||
... S MXFLD=+$P(MAR(J),";",2)
|
||||
... S MXVAL=$P(MAR(J),":",2),MXVAL=$S(MXVAL["(":$P(MXVAL,"("),1:MXVAL)
|
||||
... S MXDATA(MXFILE,$S(MXFLD=.01:INC,1:"")_"1,"_RECORD_","_DFN_",",MXFLD)=MXVAL
|
||||
... K IEN,ERROR D UPDATE^DIE("E","MXDATA","IEN","ERROR")
|
||||
Q
|
||||
;
|
||||
DC(XDATE) ;Convert DOB to internal
|
||||
N %DT,X
|
||||
S X=XDATE,%DT="T" D ^%DT
|
||||
Q Y
|
||||
;
|
||||
INSUR ;Insurance/Billing
|
||||
Q
|
||||
;
|
||||
K S DA=$P(^DPT(0),"^",3),DIK="^DPT(" D ^DIK
|
||||
S DIK="^AUPNPAT(" D ^DIK
|
||||
Q
|
||||
;
|
||||
|
|
@ -0,0 +1,188 @@
|
|||
VWREGITT ;Portland\Jim Bell, BFP,LLC Input Template Management 2016
|
||||
;2.0**LOCAL** Copyright April 2016 ad infinitum;;;;;Build 1
|
||||
;*****************************************************************
|
||||
;* Licensed under GNU 2.0 or greater - see license.txt file *
|
||||
;* Program/application is for the management of input templates *
|
||||
;* owned by the user (DUZ). *
|
||||
;* REMINDER: All template fields pertain only to the Patient File*
|
||||
;* (#2)! *
|
||||
;*****************************************************************
|
||||
Q ;No fall through
|
||||
;
|
||||
AUTH(TUSER,TNUM) ;Can user edit or is IT CONTROL
|
||||
N TMO
|
||||
S TMO=$O(^DIC(19,"B","VW REG IT CONTROL",0)) I $D(^VA(200,TUSER,203,"B",TMO)) Q 1
|
||||
S TMO=$O(^DIC(19,"B","VW PATIENT REGISTRATION",0))
|
||||
I TMO,$P(^DIE(TNUM,0),"^",5)=TUSER Q 1
|
||||
Q 0
|
||||
;
|
||||
INR() Q $O(RESULT(" "),-1)+1
|
||||
;
|
||||
CF(FIELD) ;If a computed field, 0, else 1
|
||||
I $P($G(^DD(2,FIELD,0)),"^",2)["C" Q 0
|
||||
Q 1
|
||||
;
|
||||
EGF(RESULT,TNAME) ;Get fields for client editing via TName
|
||||
;*************************
|
||||
;* Incoming___TNAME(IEN) *
|
||||
;*************************
|
||||
K RESULT ;N TNUM,TNAME,PF,SF
|
||||
S TNUM=+$P(TNAME,"(",2)
|
||||
S TNAME=$P(TNAME,"(")
|
||||
I 'TNUM!('$D(^DIE(TNUM))) S RESULT(0)="Template name or number not found in Template file" Q
|
||||
;Check for authorization
|
||||
I '$$AUTH(DUZ,TNUM) S RESULT(0)="Sorry, you are not authorized to edit this template." Q
|
||||
S RESULT(0)="Editing "_TNAME_"("_TNUM_")"
|
||||
S PF=$G(^DIE(TNUM,"DR",1,2))
|
||||
F I=1:1:$L(PF,";") D:$P(PF,";",I)
|
||||
. S RESULT($$INR)=$P(^DD(2,$P(PF,";",I),0),"^")_"("_$P(PF,";",I)_")"
|
||||
. S SDD=+$P(^DD(2,$P(PF,";",I),0),"^",2) D:SDD
|
||||
.. S SDN=1 F S SDN=$O(^DIE(TNUM,"DR",SDN)) Q:'SDN S:$O(^(SDN,0))=SDD SF=^(SDD) D
|
||||
... F J=1:1:$L(SF,";") D:$P(SF,";",J)
|
||||
.... S SFF=$P(^DIE(TNUM,"DR",SDN,SDD),";",J)
|
||||
.... S RESULT($$INR)=" SF "_$P(^DD(SDD,SFF,0),"^")_"("_SFF_";"_SDD_")"
|
||||
Q
|
||||
;
|
||||
SFLDS ;Get sub-fields and dics
|
||||
K MULT N N,X,I,Y
|
||||
S Y="",N=0 F S N=$O(TDATA(N)) Q:'+N D
|
||||
. Q:TDATA(N)'[" SF" ;Still a major field
|
||||
. F I=N:1:$O(TDATA(" "),-1) S X=TDATA(I) Q:X'[" SF" S MULT(+$P(X,";",2),+$P(X,"(",2))=""
|
||||
Q
|
||||
;
|
||||
FIELDS() ;
|
||||
N FLDLIST,N,X,FLD K MULT
|
||||
S FLDLIST=""
|
||||
S N=0 F S N=$O(TDATA(N)) Q:'+N D:TDATA(N)'[" SF"
|
||||
. S FLD=+$P(TDATA(N),"(",2)
|
||||
. Q:'$$CF(+$P(TDATA(N),"(",2)) ;Computed field
|
||||
. S FLDLIST=FLDLIST_FLD_";"
|
||||
;Collate thru for multiple fields:entry looks like " SF "
|
||||
S N=0 F S N=$O(TDATA(N)) Q:'+N D:TDATA(N)[" SF"
|
||||
. S X=$P(TDATA(N)," ",3)
|
||||
. S SDD=+$P(X,";",2)
|
||||
. S SFL=+$P(X,"(",2)
|
||||
. S MULT(SDD,SFL)=""
|
||||
S N=0 F S N=$O(MULT(N)) Q:'+N D S SUB(N)=MF
|
||||
. S MF="",N2=0 F S N2=$O(MULT(N,N2)) Q:'+N2 S MF=MF_N2_";"
|
||||
K MULT
|
||||
Q FLDLIST
|
||||
;
|
||||
RTF(RESULT) ;Send a refresh of regit.txt to client
|
||||
K AR,RESULT
|
||||
D LTF
|
||||
M RESULT=AR
|
||||
K AR
|
||||
Q
|
||||
;
|
||||
LTF ;Load the regit.txt file into AR()
|
||||
S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
|
||||
S FILE="regit.txt"
|
||||
S P4=1
|
||||
S P5=""
|
||||
S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
|
||||
Q
|
||||
;
|
||||
FTF ;File the AR() to regit.txt
|
||||
ZSY "cp "_HD_"regit.txt "_HD_"regitbu.txt"
|
||||
S P4=1,P5="",FILE="regit.txt"
|
||||
S X=$$GTF^%ZISH($NA(AR(1)),1,HD,FILE)
|
||||
Q
|
||||
;
|
||||
ITCNTRL(USER) ;Check for control capability and user authorization
|
||||
N ITCNTRL
|
||||
S ITCNTRL=$O(^DIC(19,"B","VW REG IT CONTROL",0))
|
||||
I 'ITCNTRL D Q 0
|
||||
. S VAL=0
|
||||
. S RESULT(0)="-1^VW REGISTRATION does not appear to be complete."
|
||||
. S RESULT(1)="Please contact your Supervisor or IT support."
|
||||
. S RESULT(2)="Thank you,"
|
||||
. S RESULT(3)="The Management"
|
||||
I '$D(^VA(200,USER,203,"B",ITCNTRL)) D Q 0
|
||||
. S RESULT(0)="-1^User does not have authorization to modify/create"
|
||||
. S RESULT(1)="input templates. Please contact your Supervisor or"
|
||||
. S RESULT(2)="IT support. Or, questions can be referred to Jim"
|
||||
. S RESULT(3)="Bell at jbellco65@gmail.com"
|
||||
. S RESULT(4)="Thank you."
|
||||
Q 1
|
||||
;
|
||||
EN(RESULT,TDATA) ;
|
||||
;************************************************
|
||||
;* Call from Client *
|
||||
;* TDATA Array: *
|
||||
;* 0____Template Name^DUZ^ACTION^WRITEACCESS *
|
||||
;* 1-n__Field name(number) *
|
||||
;************************************************
|
||||
; -- testing --
|
||||
;M ^DIZ("TDATA",$J)=TDATA
|
||||
;Q
|
||||
; -- end testing --
|
||||
;
|
||||
N TNAME,TNUM,ITCNTRL,ACTION,FIELDS,CALLER
|
||||
S CALLER=""
|
||||
S X="TDATA" F S X=$Q(@X) Q:X="" S @X=$$UP^XLFSTR(@X) ;Upcase everyTHING
|
||||
I '$L($G(HD)) S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
|
||||
S WHO=$P(TDATA(0),"^",2)
|
||||
S ITCNTRL=$$ITCNTRL(WHO) ;1=full action;0=create/edit own template(s)
|
||||
S TNUM=+$P($P(TDATA(0),"^"),"(",2)
|
||||
S TNAME=$P($P(TDATA(0),"^"),"(")
|
||||
I TNAME["Editing" S SPEC("Editing ")="",TNAME=$$REPLACE^XLFSTR(TNAME,.SPEC)
|
||||
S ACTION=$P(TDATA(0),"^",3)
|
||||
S WRITEACC=$S($P(TDATA(0),"^",4)="SELF":$P(^VA(200,DUZ,0),"^",4),1:"")
|
||||
S FIELDS=$$FIELDS
|
||||
I '$L(ACTION) S RESULT(0)="-1^No action sent. I don't know what to do." Q
|
||||
D @ACTION
|
||||
Q
|
||||
;
|
||||
CREATE ;Create a new input template
|
||||
;******************************
|
||||
;* Check for computed fields *
|
||||
;******************************
|
||||
K RESULT N %DT,X,Y
|
||||
S %DT="TS",X="NOW" D ^%DT S FDATE=Y
|
||||
S X=TNAME,DIC="^DIE(",DIC(0)="LZ" D FILE^DICN
|
||||
S $P(^DIE(+Y,0),"^",2)=FDATE,$P(^(0),"^",3)="",$P(^(0),"^",4)=2,$P(^(0),"^",5)=DUZ
|
||||
S $P(^DIE(+Y,0),"^",6)=WRITEACC
|
||||
C2 S ^DIE(+Y,"DR",1,2)=FIELDS
|
||||
;Do mult fields here
|
||||
S N=0 F S N=$O(SUB(N)) Q:'+N D
|
||||
. S UP=^DD(N,0,"UP")
|
||||
. I UP=2 S ^DIE(+Y,"DR",$O(^DIE(+Y,"DR"," "),-1)+1,N)=SUB(N)
|
||||
. E S ^DIE(+Y,"DR",$O(^DIE(+Y,"DR"," "),-1),N)=SUB(N)
|
||||
I $P(^DIE(+Y,0),"^")=$P(TDATA(0),"^") S RESULT(0)=$P(Y,"^",2)_" filed"
|
||||
Q:CALLER="EDIT"
|
||||
S TNUM=+Y,TNAME=$P(Y,"^",2)
|
||||
K AR
|
||||
D LTF ;Get the regit.txt file loaded into AR()
|
||||
S LAST=$O(AR(" "),-1)
|
||||
S AR(LAST)=TNAME_"("_TNUM_")"
|
||||
S AR(LAST+1)="[ID]"
|
||||
;M ^DIZ("TDATA","AR",$J)=AR ;Testing
|
||||
D FTF ;File AR() to regit.txt
|
||||
K ^DIZ("TDATA",$J)
|
||||
Q
|
||||
;
|
||||
EDIT ;Edit existing. Check for allowability
|
||||
S Y=TNUM_"^"_TNAME
|
||||
EL L -^DIE(TNUM):1 G EL:'$T
|
||||
S S=1 F S S=$O(^DIE(TNUM,"DR",S)) Q:'+S D
|
||||
. S SUBD=0 F S SUBD=$O(^DIE(TNUM,"DR",S,SUBD)) Q:'+SUBD K ^DIE(TNUM,"DR",S,SUBD)
|
||||
S CALLER="EDIT"
|
||||
D C2
|
||||
L +^DIE(TNUM)
|
||||
S DA=TNUM,DIK="^DIE(" D IX^DIK ;Re-index record just in case...
|
||||
S RESULT(0)=Y_" modification filed..."
|
||||
Q
|
||||
;
|
||||
DELETE ;********************************************
|
||||
K AR
|
||||
N I,J,X
|
||||
S X="TDATA" F S X=$Q(@X) Q:X="" D
|
||||
. Q:'$L($P(@X,"^",3)) ;No entry
|
||||
. K @X
|
||||
M AR=TDATA K TDATA
|
||||
D FTF
|
||||
I X S RESULT(0)="Template menu list updated."
|
||||
E S RESULT(0)="Template list not updated. Advise Template manager to manually update "_HD_"regit.txt"
|
||||
Q
|
||||
|
||||
|
|
@ -0,0 +1,160 @@
|
|||
VWREGITU ;Portland, OR/jeb et al World Vista Registration Utilities
|
||||
;V.2;;**LOCAL**;; 2015;Build 2
|
||||
;;c2014, BellFelder Productions(BF Productions)
|
||||
;No Fall thru - jeb
|
||||
Q
|
||||
;
|
||||
DFNID() ;Set NAME(IEN),TAB,DOB(AGE),TAB,HRN,TAB,PHONE#
|
||||
N DFNID,NAME,X,Y,DOB,HRN,PHONE
|
||||
I 'DFN Q ""
|
||||
S NAME=$P(^DPT(DFN,0),"^")
|
||||
S Y=$$OUTPUT^VWTIME(DFN) X ^DD("DD") S DOB=Y
|
||||
S HRN=$G(^DPT(DFN,540001.1))
|
||||
S PHONE="Phone: "_$P(^DPT(DFN,.13),"^")
|
||||
S DFNID=NAME_$C(9)_DOB_$C(9)_$S($L(HRN):"HRN: "_HRN_$C(9),1:"")_PHONE
|
||||
Q DFNID
|
||||
;
|
||||
HELP(XDIC,XFIELD) ;
|
||||
N N
|
||||
K FHELP
|
||||
S FHELP=$G(^DD(XDIC,XFIELD,3))
|
||||
G:'$L(FHELP) HELPX
|
||||
S FHELP=FHELP_$S($E($L(FHELP))=".":" ",1:". ")
|
||||
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)_" "
|
||||
S FHELP=$TR(FHELP,"'","`")
|
||||
HELPX Q FHELP
|
||||
;
|
||||
M(RESULT,XMF) ;
|
||||
; **********************************************
|
||||
; * XMF_____PARENT FIELD^DFN^TEMPLATE NAME(IEN)*
|
||||
; **********************************************
|
||||
;
|
||||
;W " ;Intentional break
|
||||
K RESULT,AR,TEMPLATE
|
||||
N XMFD,SUBD,SUBD3,SUBD4,SUBD5,F2,F3,F4,F5,DFN,N,X,SUBF,XT,FHELP
|
||||
S TNUM=+$P(XMF,"(",2) ;Template IEN, if any
|
||||
S DFN=+$P(XMF,"^",2) ;Client IEN, if any
|
||||
S XMF=+XMF ;Parent field
|
||||
I '+$P(^DD(2,XMF,0),"^",2) S RESULT(0)=-1 ;Not a parent, eh?!
|
||||
S XMFD=+$P(^(0),"^",2)
|
||||
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)
|
||||
. S SUBD=+$P(^(0),"^",2)
|
||||
. 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)
|
||||
.. S SUBD3=+$P(^(0),"^",2)
|
||||
.. 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)
|
||||
... S SUBD4=+$P(^DD(SUBD3,F3,0),"^",2)
|
||||
... 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)
|
||||
.... S SUBD5=+$P(^(0),"^",2)
|
||||
.... 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)
|
||||
;Clean up of parents IN multiple fields
|
||||
M AR=RESULT K RESULT N DD,F
|
||||
S N=0 F S N=$O(AR(N)) Q:'+N D
|
||||
. S DD=+$P($P(AR(N),"^",2),";") ;Is this a sub DD ?
|
||||
. S F=+$P(AR(N),";",2)
|
||||
. I +$P(^DD(DD,F,0),"^",2) K AR(N)
|
||||
;Clean up fields not in template
|
||||
M TEMPLATE=^DIE(TNUM,"DR")
|
||||
S X=$Q(@"TEMPLATE") K @X ;Remove top, non-multiple subscript
|
||||
S X="AR" F S X=$Q(@X) Q:X="" D
|
||||
. S SUBD=+$P($P(@X,"^",2),";")
|
||||
. S SUBF=+$P(@X,";",2)
|
||||
. F I=1:1:20 I $D(TEMPLATE(I,SUBD)) D
|
||||
.. Q:TEMPLATE(I,SUBD)[SUBF
|
||||
.. K @X
|
||||
S N=0 F S N=$O(AR(N)) Q:'+N S RESULT($$INR)=AR(N)
|
||||
K AR,TEMPLATE
|
||||
Q
|
||||
;
|
||||
DISV(RESULT,DFN) ;Set the Disv GLOBAL
|
||||
K RESULT
|
||||
I '$L(DFN) S RESULT=-1 Q
|
||||
S ^DISV(DUZ,"^DPT(")=+$P(DFN,"(",2),RESULT=1
|
||||
Q
|
||||
;
|
||||
SR(FNAME,FNUM,FVALUE,FHELP,FSETPNTR,FMISC) ;Set values into RESULT()
|
||||
;********************************************************
|
||||
;* FNAME________Field Name *
|
||||
;* FNUM_________Field Number *
|
||||
;* FVALUE_______Data from existing client/patient *
|
||||
;* FHELP________Help text from field *
|
||||
;* FSETPNTR_____Set of codes or Pointer reference *
|
||||
;* FMISC________Locally described designator (not used) *
|
||||
;********************************************************
|
||||
S RESULT($$INR)=FNAME_"^"_FNUM_"^"_FVALUE_"^"_FHELP_"^"_FSETPNTR_"^"_FMISC
|
||||
Q
|
||||
;
|
||||
INR() ;Specific incrementer for RESULT array
|
||||
Q $O(RESULT(" "),-1)+1
|
||||
;
|
||||
ZPC(RESULT,ZIP) ;Get zip,county/area/region,state/province,preferred city
|
||||
K RESULT N STP,CNTP,COUNTY,XZIP
|
||||
S XZIP=ZIP S RESULT(0)="No return" Q:'$L(XZIP)
|
||||
D POSTAL^XIPUTIL(XZIP,.ZIPDATA)
|
||||
I $D(ZIPDATA("ERROR")) Q ;Can't be found
|
||||
S COUNTY=$G(ZIPDATA("COUNTY"))
|
||||
S STP=$G(ZIPDATA("STATE POINTER"))
|
||||
I STP,$L(COUNTY) S CNTP=$O(^DIC(5,STP,1,"B",COUNTY,0))
|
||||
K RESULT(0)
|
||||
S RESULT($$INR)=ZIPDATA("STATE")_"("_STP_")"
|
||||
S RESULT($$INR)=ZIPDATA("COUNTY")_"("_CNTP_")"
|
||||
S RESULT($$INR)=ZIPDATA("CITY")
|
||||
S RESULT($$INR)=ZIPDATA("FIPS CODE")
|
||||
K ZIPDATA
|
||||
Q
|
||||
;
|
||||
SPI(RESULT,DFN) ;Simple patient inquiry display
|
||||
S LINE="----------"
|
||||
S DIC="^DPT(",DA=DFN,DIQ(0)="E",DIQ="AR"
|
||||
S DR=".01:.05;.111:.115;.1171:.1173;.117;.363"
|
||||
D EN^DIQ1
|
||||
S CITY=$G(AR(2,DFN,.114,"E"))
|
||||
S STIEN="",STATE=$G(AR(2,DFN,.115,"E")) S:$L(STATE) STIEN=$O(^DIC(5,"B",STATE,0))
|
||||
S XAGE=$G(AR(2,DFN,.033,"E"))
|
||||
S XAGE=$S(+XAGE:XAGE_" y/o",1:"")
|
||||
;;GET HRN
|
||||
HRN S HRN="",N=$O(^AUPNPAT(DFN,41,0))
|
||||
S HRN=$S('N:HRN,1:$P($G(^AUPNPAT(DFN,41,N,0)),"^",2))
|
||||
S RESULT($$INR)=AR(2,DFN,.01,"E")_" "_AR(2,DFN,.363,"E")_" HRN: "_HRN
|
||||
S RESULT($$INR)="DOB: "_AR(2,DFN,.03,"E")_" ("_XAGE_" "_AR(2,DFN,.02,"E")_")"
|
||||
S RESULT($$INR)="ADDRESS"_LINE_LINE
|
||||
S RESULT($$INR)=$G(AR(2,DFN,.111,"E"))_" "_$G(AR(2,DFN,.112,"E"))
|
||||
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")))
|
||||
S RESULT($$INR)="Walk-ins"_LINE_LINE
|
||||
S RESULT($$INR)="Appointments"_LINE_LINE
|
||||
S RESULT($$INR)="Admissions"_LINE_LINE
|
||||
Q
|
||||
;
|
||||
CONTROL() ;Check for CONTROL status
|
||||
N X S X=$O(^DIC(19,"B","VW REG IT CONTROL",0))
|
||||
I 'X Q 0 ;Ain't no option there
|
||||
Q $S($D(^VA(200,DUZ,203,"B",X)):1,1:0)
|
||||
;
|
||||
MISC(RESULT,VWDD) ;Get simple value from VWDD ID
|
||||
;***************************************************
|
||||
;* VWDD___________________(sub)-Dictionary number *
|
||||
;* Multiple delimiter_____;(Semicolon) *
|
||||
;***************************************************
|
||||
;
|
||||
I '$L(VWDD) S RESULT(0)="No value to evaluate" Q
|
||||
K RESULT
|
||||
N XDD,XDDLOC,N,X
|
||||
G MISCSD:$G(^DD(VWDD,0,"UP"))
|
||||
S CALLER=$S($P(VWDD,"^",2)="INS":1,1:0)
|
||||
S VWDD=$P(VWDD,"^")
|
||||
F I=1:1:$L(VWDD,";") S XDD=+$P(VWDD,";",I) S RESULT($$INR)="["_$P(^DIC(XDD,0),"^")_"]" D MISC1
|
||||
I CALLER S RESULT($$INR)="[GUARANTOR]" D
|
||||
. S X=$P(^DD(2.312,16,0),"^",3)
|
||||
. F I=1:1:$L(X,";") S Y=$P(X,";",I),RESULT($$INR)=$P(Y,":",2)_"("_$P(Y,":")_")"
|
||||
Q
|
||||
;
|
||||
MISC1 S XDDLOC=$G(^DIC(XDD,0,"GL")) D:$L(XDDLOC)
|
||||
. S N=0 F S N=$O(@(XDDLOC_N_")")) Q:'+N D
|
||||
.. I XDDLOC["779.004" S XCNAME=$P(@(XDDLOC_N_",0)"),"^")_" "_$P(^(0),"^",2)_" "_+$G(^("SDS"))_"("_N_")",RESULT($$INR)=XCNAME Q
|
||||
.. S X=$P(@(XDDLOC_N_",0)"),"^")_"("_N_")",RESULT($$INR)=X
|
||||
MX Q
|
||||
;
|
||||
MISCSD ;Sub-dictionary
|
||||
W ^("UP")
|
||||
Q
|
||||
;
|
||||
|
||||
|
|
@ -0,0 +1,326 @@
|
|||
VWREGITX ;VWEHR/BFProd-Jim Bell, et al - World VistA GUI Pat Reg Utility
|
||||
;;;;;;Build 2
|
||||
;;1.0;WORLD VISTA;**LOCAL **;;Build 26
|
||||
;
|
||||
;This routine utility is for patient specific fields and
|
||||
;is used to build input templates for registration
|
||||
;
|
||||
;GNU License: See WVLIC.txt
|
||||
;Modified FOIA VISTA,
|
||||
;Copyright 2013 WorldVistA. Licensed under the terms of the GNU
|
||||
Q
|
||||
;
|
||||
1 ;CallerID = HRN; value is at $P($P(CALLERID,":",2),"^")
|
||||
S HRN=$P($P(CALLERID,":",2),"^")
|
||||
S HRN=$$HRN(HRN)
|
||||
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#."
|
||||
Q
|
||||
;
|
||||
2 ;CallerID = NAME; in ^2@+CALLERID
|
||||
K AR,ARR
|
||||
N HRN,PHONE,DOB,N
|
||||
S NAME=$P(CALLERID,"^",+CALLERID)
|
||||
S XNAME=NAME F S XNAME=$O(^DPT("B",XNAME)) Q:XNAME'[NAME D
|
||||
. S N=0 F S N=$O(^DPT("B",XNAME,N)) Q:'+N S AR($O(AR(" "),-1)+1)=N
|
||||
I $O(AR(" "),-1)=1 D Q
|
||||
. S DFN=AR(1)
|
||||
. S HRN=$$HRN(DFN),HRN=$S($L(HRN):HRN,'$L(HRN):"ID-"_$P($G(^DPT(DFN,.36)),"^",3),1:"------------")
|
||||
. S DOB=$P(^DPT(DFN,0),"^",3),DOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$E(DOB,2,3)
|
||||
. S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE):PHONE,1:"<No entry>")
|
||||
. S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")^"_DOB_"^"_PHONE
|
||||
S N=0 F S N=$O(AR(N)) Q:'+N S ARR($P(^DPT(+AR(N),0),"^"),N)=+AR(N)
|
||||
S X="ARR" F S X=$Q(@X) Q:X="" S DFN=@X D
|
||||
. S HRN=$$HRN(DFN),HRN=$S($L(HRN):HRN,'$L(HRN):"ID-"_$P($G(^DPT(DFN,.36)),"^",3),1:"------------")
|
||||
. S DOB=$P(^DPT(DFN,0),"^",3),DOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$E(DOB,2,3)
|
||||
. S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE):PHONE,1:"<No entry>")
|
||||
. S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")^"_DOB_"^"_PHONE
|
||||
K AR,ARR
|
||||
Q
|
||||
;
|
||||
3 ;CallerID = DOB; in ^3@CALLERID
|
||||
S X=$P(CALLERID,"^",+CALLERID)
|
||||
K %DT,Y,AR
|
||||
N HRN,PHONE,N
|
||||
D ^%DT
|
||||
S N=0 F S N=$O(^DPT("ADOB",Y,N)) Q:'+N S AR($O(AR(" "),-1)+1)=N_"^"_Y
|
||||
I $O(AR(" "),-1)=1 D Q ;Only one find
|
||||
. K RESULT
|
||||
. S DFN=+AR(1)
|
||||
. S HRN=$$HRN(DFN)
|
||||
. I '$L(HRN) S HRN="ID-"_$P($G(^DPT(DFN,.36)),"^",3)
|
||||
. I '$L(HRN) S HRN="------------"
|
||||
. S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE)>0:PHONE,1:"<No entry>")
|
||||
. S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")"_"^"_$P(CALLERID,"^",+CALLERID)_"^"_PHONE
|
||||
K ARR S N=0 F S N=$O(AR(N)) Q:'+N S ARR($P(^DPT(+AR(N),0),"^"),N)=+AR(N)
|
||||
S X="ARR" F S X=$Q(@X) Q:X="" S DFN=@X D
|
||||
. S HRN=$$HRN(DFN)
|
||||
. I '$L(HRN) S HRN=$P($G(^DPT(DFN,.36)),"^",3)_"(ID)"
|
||||
. I '$L(HRN)!(HRN="(ID)") S HRN="------------"
|
||||
. S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE)>0:PHONE,1:"<No entry>")
|
||||
. S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")"_"^"_$P(CALLERID,"^",+CALLERID)_"^"_PHONE
|
||||
K ARR,AR
|
||||
Q
|
||||
;
|
||||
4 ;CallerID = PHONE; IN ^4@+CALLERID
|
||||
S CALLERID=$TR(CALLERID,"- ()","")
|
||||
Q
|
||||
;
|
||||
5 ;CallerID = space-bar; IN ^2@+CALLERID
|
||||
S X=$P(CALLERID,"^",+CALLERID)
|
||||
S DFN=$G(^DISV(DUZ,"^DPT("))
|
||||
I 'DFN S RESULT(0)="Patient-Client not found" Q
|
||||
S AR(1)=DFN G 2+6 ;Direct call
|
||||
Q
|
||||
;
|
||||
DE(RESULT,DATA) ;Forced hard error
|
||||
;W "
|
||||
Q
|
||||
;
|
||||
HRN(IEN) ;Health Record #s from IHS PATIENT
|
||||
N N,HRNIEN,I
|
||||
S HRNIEN=""
|
||||
Q:'$D(^AUPNPAT(IEN)) HRNIEN
|
||||
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)_"|"
|
||||
I $E(HRNIEN,$L(HRNIEN))="|" S HRNIEN=$E(HRNIEN,1,$L(HRNIEN)-1)
|
||||
Q HRNIEN
|
||||
;
|
||||
ALIST(RESULT,ALPHA,CALLERID) ;Alpha request from client
|
||||
;*****************************************************
|
||||
;* ALPHA_____Letter to look up *
|
||||
;* CALLERID__PIECE#:HRN^NAME(IEN)^DOB^PHONE look up *
|
||||
;* RETURN____HRN^NAME^DOB^PHONE(Field .131 in File 2)*
|
||||
;*****************************************************
|
||||
I '$L(ALPHA),'+CALLERID S RESULT(0)="No Alphabetical letter or HRN,Name,DOB,Phone selection..." Q
|
||||
S CALLERID=$$UP^XLFSTR(CALLERID) ;Upcase EVERYTHING
|
||||
I +CALLERID G @+CALLERID
|
||||
N X,I,ANAME,HRN,ADOB,APHONE,Y
|
||||
K RESULT,AR,ARR
|
||||
S X="^DPT(""B"""_","_""""_ALPHA_""")"
|
||||
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,","))
|
||||
S ARN=0 F S ARN=$O(AR(ARN)) Q:'+ARN D
|
||||
. S HRN=$$HRN(ARN)
|
||||
. S:'$L(HRN) HRN="--- "
|
||||
. F JJ=$L(HRN):1:15 S HRN=HRN_" "
|
||||
. S ANAME=$P(^DPT(AR(ARN),0),"^")
|
||||
. S Y=$P(^(0),"^",3)_$S($G(^DPT(AR(ARN),540000)):^(540000),1:"")
|
||||
. D DD^%DT S ADOB=Y
|
||||
. S APHONE=$P($G(^DPT(AR(ARN),.13)),"^")
|
||||
. S ARR(ANAME,ARN)=HRN_"^"_ANAME_"("_AR(ARN)_")^"_ADOB_"^"_APHONE
|
||||
S X="ARR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
||||
Q
|
||||
;
|
||||
PLID(IEN) ;Primary Long ID, used with or in absence of HRN.
|
||||
Q $P($G(^DPT(IEN,.36)),"^",3)
|
||||
;
|
||||
INR() Q $O(RESULT(" "),-1)+1
|
||||
;
|
||||
|
||||
FIXNAME ;
|
||||
N N,X,Y,XIEN,NLENGTH,I
|
||||
S NLENGTH=0,X="AR" F S X=$Q(@X) Q:X="" D
|
||||
. S Y=@X,N=$P(Y,"(")_"("_+$P(Y,"(",2)_")",STR=$P(Y,")",2)
|
||||
. S NLENGTH=$S($L(N)>NLENGTH:$L(N),1:NLENGTH)
|
||||
. F I=NLENGTH:-1:$L(N) S N=N_" "
|
||||
. S Y=N_" "_STR
|
||||
. S @X=Y
|
||||
Q
|
||||
GPL(RESULT,IDDATA) ;Partial patient lists
|
||||
;***********************************************
|
||||
;* IDDATA_____Contains Start^Stop alpha chars *
|
||||
;* RESULT_____Return of results *
|
||||
;***********************************************
|
||||
K RESULT,AR
|
||||
N N,DFN,SSN,DOB,START,STOP,NAME,XDOB ;; ,NL
|
||||
;;Get user's last patient ID
|
||||
S DFN=$G(^DISV(DUZ,"^DPT(")) D:DFN
|
||||
. S NAME=$P(^DPT(DFN,0),"^")
|
||||
. ;S SSN=$P(^(0),"^",9)
|
||||
. S HRN="HRN: "_$$HRN(DFN) ;Health record number
|
||||
. S PLID="ID: "_$$PLID(DFN) ;Primary Long ID
|
||||
. S DOB=$P(^(0),"^",3)
|
||||
. S XDOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$S($E(DOB)<3:19,1:20)_$E(DOB,2,3)
|
||||
. S AR(0)=NAME_"("_DFN_")"_" "_XDOB_" "_$S($L($P(HRN,": ",2)):HRN,$L($P(PLID,": ",2)):PLID,1:"<NO ID ON FILE>")
|
||||
S START=$P(IDDATA,"^")
|
||||
S STOP=$P(IDDATA,"^",2)
|
||||
S STOP=STOP_"z"
|
||||
S STOP=$E($O(^DPT("B",STOP)))
|
||||
S STOP=$S('$L(STOP):$P(IDDATA,"^",2)_"z",1:STOP)
|
||||
S NL=0
|
||||
S N=START F S N=$O(^DPT("B",N)) Q:N=""!($E(N)=STOP) D
|
||||
. S DFN=$O(^(N,0))
|
||||
. S NAME=$P(^DPT(DFN,0),"^")_"("_DFN_")"
|
||||
. ;S SSN=$P(^(0),"^",9),SSN=$S('$L(SSN):" ????",1:SSN)
|
||||
. S HRN="HRN: "_$$HRN(DFN)
|
||||
. S PLID="ID: "_$$PLID(DFN) ;Primary Long ID
|
||||
. S DOB=$P(^DPT(DFN,0),"^",3)
|
||||
. S XDOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$S($E(DOB)<3:19,1:20)_$E(DOB,2,3)
|
||||
. ;W !,$J(DFN,5)," ",$J($E(NAME,1,12),12)," ",$J(SSN,10)," ",XDOB
|
||||
. S AR(NAME,DFN)=NAME_" "_XDOB_" "_$S($L($P(HRN,": ",2)):HRN,$L($P(PLID,": ",2)):PLID,1:"<NO ID ON FILE>")
|
||||
. S (DFN,NAME,SSN,DOB,XDOB)=""
|
||||
D FIXNAME
|
||||
S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
||||
K AR
|
||||
Q
|
||||
;
|
||||
REJECT(FIELD,IEN,SUBDIC) ;Reject Asterisked,Amis,Computed fields,VA specific fields
|
||||
;This subroutine left in for possible future use
|
||||
I $L(IEN),$D(^DIZ(64850001,IEN)) Q 1 ;VA specific data field
|
||||
I FIELD["COMPONENT" Q 1 ;Pain in the butt!
|
||||
I FIELD["(VA)"!(FIELD["(CIVIL)") Q 1 ;VA fields
|
||||
I FIELD["AMIS",FIELD["SEGMENT" Q 1
|
||||
I FIELD["ELIG VERIF" Q 1
|
||||
I FIELD["ENCOUNTER CONVERSION" Q 1
|
||||
I FIELD["PROGRAMMERS U" Q 1
|
||||
I FIELD["WHO " Q 1
|
||||
I FIELD["SC AT"!(FIELD["SC%") Q 1
|
||||
I $E(FIELD)="*" Q 1 ;field marked for deletion
|
||||
I FIELD["10-10" Q 1
|
||||
I $L(IEN),$E($P($G(^DD(2,IEN,0)),"^",2))="C" Q 1 ;computed field
|
||||
I $L($G(SUBDIC)),$E($P($G(^DD(SUBDIC,IEN,0)),"^",2))="C" Q 1 ;computet in sub-dic
|
||||
Q 0 ;Passed
|
||||
;
|
||||
LF(RESULT,FTYPE) ;List of assumed civilian type fields from
|
||||
; Patient file(#2)
|
||||
;*******************************************************************
|
||||
;*The author (me) arbitarily selected fields from the patient file *
|
||||
;* that he (me) considers to be usable by civilian VistA/CPRS users*
|
||||
;* the field count is 284 out of the 700+ fields available in the *
|
||||
;* full patient DD. File is located at ^DIZ(64850002, *
|
||||
;*******************************************************************
|
||||
;
|
||||
S FTYPE=$TR(FTYPE,"*&^%$#@!:;>?/., ","") ;TMenuItem inclusions/jeb
|
||||
;S:$L(FTYPE) FTYPE=$P(^DIZ(64850003,+$P(FTYPE,"(",2),0),"^")
|
||||
S FTYPE=$$UP^XLFSTR(FTYPE)
|
||||
K RESULT
|
||||
N N,X,FIELD,FLDNO,FGRP,M,MX,MF,MFNO,MFGP,MN
|
||||
G FG:$L(FTYPE)
|
||||
; Add patient file fields
|
||||
S N=0 F S N=$O(^DIZ(64850002,N)) Q:'+N D
|
||||
. S X=^(N,0)
|
||||
. S FIELD=$P(X,"^")
|
||||
. S FLDNO=$P(X,"^",2)
|
||||
. S FGRP=$P(X,"^",3)
|
||||
. S RESULT($$INR)=FIELD_"("_FLDNO_")"_":"_FGRP
|
||||
. I $O(^DIZ(64850002,N,"M",0)) D
|
||||
.. S M=0 F S M=$O(^DIZ(64850002,N,"M",M)) Q:'+M D
|
||||
... S MX=^(M,0)
|
||||
... S MF=$P(MX,"^")
|
||||
... S MFNO=$P(MX,"^",2)
|
||||
... S MFGP=$P(MX,"^",3)
|
||||
... S RESULT($$INR)=" SF "_MF_"("_MFNO_")"_":"_MFGP
|
||||
S X="RESULT" F I=1:1 S X=$Q(@X) Q:X=""
|
||||
S RESULT(0)="Field count: "_(I-1)
|
||||
Q
|
||||
;
|
||||
FG ;Fields by GROUP
|
||||
Q:'$L(FTYPE)
|
||||
K RESULT,AHF N LABEL,F,N,I
|
||||
S N=$S(+$P(FTYPE,"(",2):+$P(FTYPE,"(",2),1:$O(^DIZ(64850003,"B",FTYPE,0)))
|
||||
I 'N S RESULT($$INR)="Group not found." G FGX
|
||||
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_")"
|
||||
FGX Q
|
||||
;
|
||||
FGNA(RESULT,KIND) ;Fields by sort designator
|
||||
;**********************************
|
||||
;* KIND *
|
||||
;* G____Group,Field *
|
||||
;* N____Field# *
|
||||
;* A____Alphabetical (Default) *
|
||||
;* RESULT__Returned array *
|
||||
;**********************************
|
||||
K RESULT
|
||||
I KIND="G" D G FGNAX
|
||||
. K AR
|
||||
. S N=0 F S N=$O(^DIZ(64850002,N)) Q:'+N S X=^(N,0) D
|
||||
.. S GRP=$P(X,"^",3)
|
||||
.. S FN=$P(X,"^",2)
|
||||
.. S FIELD=$P(X,"^")
|
||||
.. S AR(GRP,FN)=FIELD_"("_FN_")"
|
||||
.. I $O(^DIZ(64850002,N,"M",0)) D
|
||||
... S MN=0 F S MN=$O(^DIZ(64850002,N,"M",MN)) Q:'+MN D
|
||||
.... S MX=^(MN,0)
|
||||
.... S MFN=+$P(MX,"^",2)
|
||||
.... S MFLD=$P(MX,"^")
|
||||
.... S AR(GRP,FN,MFN)=" SF "_$P(MX,"^")_"("_$P(MX,"^",2)_")"
|
||||
. S G="" F S G=$O(AR(G)) Q:G="" S RESULT($$INR)="--- "_G_" ---" D
|
||||
.. 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)
|
||||
I KIND="N" D G FGNAX
|
||||
. K AR,RESULT
|
||||
. S N=0 F S N=$O(^DIZ(64850002,N)) Q:'+N S X=^(N,0) D
|
||||
.. S GRP=$P(X,"^",3)
|
||||
.. S FN=$P(X,"^",2)
|
||||
.. S FIELD=$P(X,"^")
|
||||
.. S AR(FN)=FIELD_"("_FN_")"
|
||||
.. I $O(^DIZ(64850002,N,"M",0)) D
|
||||
... S MN=0 F S MN=$O(^DIZ(64850002,N,"M",MN)) Q:'+MN D
|
||||
.... S MX=^(MN,0)
|
||||
.... S MFN=+$P(MX,"^",2)
|
||||
.... S MFLD=$P(MX,"^")
|
||||
.... S AR(FN,MFN)=" SF "_$P(MX,"^")_"("_$P(MX,"^",2)_")"
|
||||
. S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
||||
;Kind = alphabetical
|
||||
S N=0 F S N=$O(^DIZ(64850002,N)) Q:'+N S X=^(N,0) D
|
||||
. S AR($P(X,"^"))=$P(X,"^")_"("_$P(X,"^",2)_")"
|
||||
. I $O(^DIZ(64850002,N,"M",0)) D
|
||||
.. S MN=0 F S MN=$O(^DIZ(64850002,N,"M",MN)) Q:'+MN D
|
||||
... S MX=^(MN,0)
|
||||
... S MFN=+$P(MX,"^",2)
|
||||
... S MFLD=$P(MX,"^")
|
||||
... S AR($P(X,"^"),MFLD)=" SF "_$P(MX,"^")_"("_$P(MX,"^",2)_")"
|
||||
S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
||||
FGNAX ;K AR
|
||||
Q
|
||||
;
|
||||
RETGRP(RESULT) ;Return Group IDs
|
||||
K RESULT
|
||||
S N=0 F S N=$O(^DIZ(64850003,N)) Q:'+N S RESULT($$INR)=$P(^(N,0),"^",2)_"("_N_")"
|
||||
Q
|
||||
;
|
||||
AHF(RESULT,AHF) ;Ad hoc field selection "Finished" pressed/jeb
|
||||
;*****************************************************
|
||||
;* AFH ARRAY: *
|
||||
;* AHF(0)____DFN *
|
||||
;* AHF ARRAY_FIELD(NO) OR FIELD(NO;SUB-DIC) *
|
||||
;*****************************************************
|
||||
;W " ;the END
|
||||
K ^DIZ("AHF") M ^DIZ("AHF")=AHF
|
||||
K RESULT
|
||||
N FIELD,FNO,DFNDR
|
||||
S DFNDR=""
|
||||
S DFN=+AHF(0) K AHF(0)
|
||||
S X="AHF" F S X=$Q(@X) Q:X="" S Y=@X D
|
||||
. S FIELD=$P(Y,"(")
|
||||
. S FNO=+$P(Y,"(",2)
|
||||
. D GFA(FNO)
|
||||
. S RESULT($$INR)=FIELD_"^"_FNO_"^^"_FHELP_"^"_FPSC_"^"_$$MF(FNO)
|
||||
. S DFNDR=DFNDR_FNO_";"
|
||||
I DFN D
|
||||
. K AR N N,Y,F
|
||||
. D GETS^DIQ(2,DFN_",",DFNDR,"E","AR","ERR")
|
||||
. S X="AR" F S X=$Q(@X) Q:X="" D
|
||||
.. S Y=@X
|
||||
.. S F=+$P(X,",",$L(X,",")-1)
|
||||
.. S N=0 F S N=$O(RESULT(N)) Q:'+N I $P(RESULT(N),"^",2)=F S $P(RESULT(N),"^",3)=Y
|
||||
;ToDo: write fill in for the multiple fields
|
||||
K FHELP,FPSC
|
||||
Q
|
||||
;
|
||||
GFA(FNO) ;Get field attributes at piece3 and help
|
||||
S (FHELP,FPSC)=""
|
||||
S FHELP=$G(^DD(2,FNO,3))
|
||||
I FNO'=27.02 S N=0 F S N=$O(^DD(2,FNO,21,N)) Q:'+N S FHELP=FHELP_^(N,0)
|
||||
S FHELP=$TR(FHELP,"'","`")
|
||||
S FPSC=$P(^DD(2,FNO,0),"^",3)
|
||||
Q
|
||||
;
|
||||
MF(X) ;Check for multiple field
|
||||
;*****************************************************
|
||||
;* Reminder: This data set is Patient file only (#2) *
|
||||
;* MYESNO____=1 is a parent *
|
||||
;* =0 is a primary field *
|
||||
;*****************************************************
|
||||
;
|
||||
S MYESNO=$S(+$P(^DD(2,X,0),"^",2):1,1:0)
|
||||
Q MYESNO
|
||||
;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue