Index: VWGUIRegistration/tag/2.0/VWREG_03022017_P1T3_0.KID
===================================================================
--- VWGUIRegistration/tag/2.0/VWREG_03022017_P1T3_0.KID	(revision 1788)
+++ VWGUIRegistration/tag/2.0/VWREG_03022017_P1T3_0.KID	(revision 1788)
@@ -0,0 +1,514 @@
+KIDS Distribution saved on Mar 02, 2017@12:25:03
+Update to VWREGIT.m
+**KIDS**:VWREG_PATCH*1.0T3*0^
+
+**INSTALL NAME**
+VWREG_PATCH*1.0T3*0
+"BLD",8568,0)
+VWREG_PATCH*1.0T3*0^^^3170302^n
+"BLD",8568,1,0)
+^^1^1^3170302^
+"BLD",8568,1,1,0)
+Update to VWREGIT.m to clear an <UNDEF> found during testing
+"BLD",8568,4,0)
+^9.64PA^^
+"BLD",8568,6.3)
+2
+"BLD",8568,"KRN",0)
+^9.67PA^779.2^20
+"BLD",8568,"KRN",.4,0)
+.4
+"BLD",8568,"KRN",.401,0)
+.401
+"BLD",8568,"KRN",.402,0)
+.402
+"BLD",8568,"KRN",.403,0)
+.403
+"BLD",8568,"KRN",.5,0)
+.5
+"BLD",8568,"KRN",.84,0)
+.84
+"BLD",8568,"KRN",3.6,0)
+3.6
+"BLD",8568,"KRN",3.8,0)
+3.8
+"BLD",8568,"KRN",9.2,0)
+9.2
+"BLD",8568,"KRN",9.8,0)
+9.8
+"BLD",8568,"KRN",9.8,"NM",0)
+^9.68A^1^1
+"BLD",8568,"KRN",9.8,"NM",1,0)
+VWREGIT^^0^B34639192
+"BLD",8568,"KRN",9.8,"NM","B","VWREGIT",1)
+
+"BLD",8568,"KRN",19,0)
+19
+"BLD",8568,"KRN",19.1,0)
+19.1
+"BLD",8568,"KRN",101,0)
+101
+"BLD",8568,"KRN",409.61,0)
+409.61
+"BLD",8568,"KRN",771,0)
+771
+"BLD",8568,"KRN",779.2,0)
+779.2
+"BLD",8568,"KRN",870,0)
+870
+"BLD",8568,"KRN",8989.51,0)
+8989.51
+"BLD",8568,"KRN",8989.52,0)
+8989.52
+"BLD",8568,"KRN",8994,0)
+8994
+"BLD",8568,"KRN","B",.4,.4)
+
+"BLD",8568,"KRN","B",.401,.401)
+
+"BLD",8568,"KRN","B",.402,.402)
+
+"BLD",8568,"KRN","B",.403,.403)
+
+"BLD",8568,"KRN","B",.5,.5)
+
+"BLD",8568,"KRN","B",.84,.84)
+
+"BLD",8568,"KRN","B",3.6,3.6)
+
+"BLD",8568,"KRN","B",3.8,3.8)
+
+"BLD",8568,"KRN","B",9.2,9.2)
+
+"BLD",8568,"KRN","B",9.8,9.8)
+
+"BLD",8568,"KRN","B",19,19)
+
+"BLD",8568,"KRN","B",19.1,19.1)
+
+"BLD",8568,"KRN","B",101,101)
+
+"BLD",8568,"KRN","B",409.61,409.61)
+
+"BLD",8568,"KRN","B",771,771)
+
+"BLD",8568,"KRN","B",779.2,779.2)
+
+"BLD",8568,"KRN","B",870,870)
+
+"BLD",8568,"KRN","B",8989.51,8989.51)
+
+"BLD",8568,"KRN","B",8989.52,8989.52)
+
+"BLD",8568,"KRN","B",8994,8994)
+
+"BLD",8568,"QDEF")
+^^^^NO^^^^NO^^NO
+"BLD",8568,"QUES",0)
+^9.62^^
+"BLD",8568,"REQB",0)
+^9.611^^
+"MBREQ")
+0
+"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")
+1
+"RTN","VWREGIT")
+0^1^B34639192
+"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 2
+"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"
+"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)
+ 
+"VER")
+8.0^22.2
+**END**
+**END**