Released EAS*1*100 SEQ #82 Extracted from mail message **KIDS**:EAS*1.0*100^ **INSTALL NAME** EAS*1.0*100 "BLD",7637,0) EAS*1.0*100^ENROLLMENT APPLICATION SYSTEM^0^3100412^y "BLD",7637,1,0) ^^8^8^3100412^^^^ "BLD",7637,1,1,0) This patch will fix issues that were caused due to patch EAS*1.0*81 "BLD",7637,1,2,0) for the 1010EZ web application. "BLD",7637,1,3,0) Also, the statement "A monthly amount can be entered "BLD",7637,1,4,0) with an '*' after it." is taken out of the double "BLD",7637,1,5,0) question mark help text for ALL OTHER INCOME "BLD",7637,1,6,0) field (.17) of file INDIVIDUAL ANNUAL INCOME (408.21). "BLD",7637,1,7,0) This patch also fixes the correct filing of the relation of the child "BLD",7637,1,8,0) if the child is a step son or daughter. "BLD",7637,4,0) ^9.64PA^^ "BLD",7637,6.3) 6 "BLD",7637,"ABPKG") n "BLD",7637,"KRN",0) ^9.67PA^779.2^20 "BLD",7637,"KRN",.4,0) .4 "BLD",7637,"KRN",.401,0) .401 "BLD",7637,"KRN",.402,0) .402 "BLD",7637,"KRN",.403,0) .403 "BLD",7637,"KRN",.5,0) .5 "BLD",7637,"KRN",.84,0) .84 "BLD",7637,"KRN",3.6,0) 3.6 "BLD",7637,"KRN",3.8,0) 3.8 "BLD",7637,"KRN",9.2,0) 9.2 "BLD",7637,"KRN",9.8,0) 9.8 "BLD",7637,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",7637,"KRN",9.8,"NM",1,0) EASEZI^^0^B43951690 "BLD",7637,"KRN",9.8,"NM",2,0) EASECDD^^0^B51118284 "BLD",7637,"KRN",9.8,"NM",3,0) EASEZF3^^0^B21439689 "BLD",7637,"KRN",9.8,"NM","B","EASECDD",2) "BLD",7637,"KRN",9.8,"NM","B","EASEZF3",3) "BLD",7637,"KRN",9.8,"NM","B","EASEZI",1) "BLD",7637,"KRN",19,0) 19 "BLD",7637,"KRN",19.1,0) 19.1 "BLD",7637,"KRN",101,0) 101 "BLD",7637,"KRN",409.61,0) 409.61 "BLD",7637,"KRN",771,0) 771 "BLD",7637,"KRN",779.2,0) 779.2 "BLD",7637,"KRN",870,0) 870 "BLD",7637,"KRN",8989.51,0) 8989.51 "BLD",7637,"KRN",8989.52,0) 8989.52 "BLD",7637,"KRN",8994,0) 8994 "BLD",7637,"KRN","B",.4,.4) "BLD",7637,"KRN","B",.401,.401) "BLD",7637,"KRN","B",.402,.402) "BLD",7637,"KRN","B",.403,.403) "BLD",7637,"KRN","B",.5,.5) "BLD",7637,"KRN","B",.84,.84) "BLD",7637,"KRN","B",3.6,3.6) "BLD",7637,"KRN","B",3.8,3.8) "BLD",7637,"KRN","B",9.2,9.2) "BLD",7637,"KRN","B",9.8,9.8) "BLD",7637,"KRN","B",19,19) "BLD",7637,"KRN","B",19.1,19.1) "BLD",7637,"KRN","B",101,101) "BLD",7637,"KRN","B",409.61,409.61) "BLD",7637,"KRN","B",771,771) "BLD",7637,"KRN","B",779.2,779.2) "BLD",7637,"KRN","B",870,870) "BLD",7637,"KRN","B",8989.51,8989.51) "BLD",7637,"KRN","B",8989.52,8989.52) "BLD",7637,"KRN","B",8994,8994) "BLD",7637,"QUES",0) ^9.62^^ "BLD",7637,"REQB",0) ^9.611^3^3 "BLD",7637,"REQB",1,0) EAS*1.0*81^1 "BLD",7637,"REQB",2,0) EAS*1.0*40^1 "BLD",7637,"REQB",3,0) EAS*1.0*57^1 "BLD",7637,"REQB","B","EAS*1.0*40",2) "BLD",7637,"REQB","B","EAS*1.0*57",3) "BLD",7637,"REQB","B","EAS*1.0*81",1) "MBREQ") 0 "PKG",552,-1) 1^1 "PKG",552,0) ENROLLMENT APPLICATION SYSTEM^EAS^ENROLLMENT "PKG",552,20,0) ^9.402P^1^1 "PKG",552,20,1,0) 2^^EASXDR "PKG",552,20,1,1) "PKG",552,20,"B",2,1) "PKG",552,22,0) ^9.49I^1^1 "PKG",552,22,1,0) 1.0^3010315^3010410^66481 "PKG",552,22,1,"PAH",1,0) 100^3100412^1258 "PKG",552,22,1,"PAH",1,1,0) ^^8^8^3100412 "PKG",552,22,1,"PAH",1,1,1,0) This patch will fix issues that were caused due to patch EAS*1.0*81 "PKG",552,22,1,"PAH",1,1,2,0) for the 1010EZ web application. "PKG",552,22,1,"PAH",1,1,3,0) Also, the statement "A monthly amount can be entered "PKG",552,22,1,"PAH",1,1,4,0) with an '*' after it." is taken out of the double "PKG",552,22,1,"PAH",1,1,5,0) question mark help text for ALL OTHER INCOME "PKG",552,22,1,"PAH",1,1,6,0) field (.17) of file INDIVIDUAL ANNUAL INCOME (408.21). "PKG",552,22,1,"PAH",1,1,7,0) This patch also fixes the correct filing of the relation of the child "PKG",552,22,1,"PAH",1,1,8,0) if the child is a step son or daughter. "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") 3 "RTN","EASECDD") 0^2^B51118284^B51743119 "RTN","EASECDD",1,0) EASECDD ;ALB/LBD - Executable help for fields in file #408.21 ;4 SEP 2001 "RTN","EASECDD",2,0) ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,34,40,100**;Mar 15, 2001;Build 6 "RTN","EASECDD",3,0) ; "RTN","EASECDD",4,0) 8 ; Social Security "RTN","EASECDD",5,0) W !,?8,"Enter in this field the annual amount of Social Security" "RTN","EASECDD",6,0) W !,?8,"received during the current calendar year." "RTN","EASECDD",7,0) W !!,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",8,0) S X="?" "RTN","EASECDD",9,0) Q "RTN","EASECDD",10,0) 9 ; US Civil Service "RTN","EASECDD",11,0) W !,?8,"Enter in this field the annual amount of U.S. Civil Service" "RTN","EASECDD",12,0) W !,?8,"received during the current calendar year." "RTN","EASECDD",13,0) W !!,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",14,0) S X="?" "RTN","EASECDD",15,0) Q "RTN","EASECDD",16,0) 10 ; US Railroad Retirement "RTN","EASECDD",17,0) W !,?8,"Enter in this field the annual amount of U.S. Railroad Retirement" "RTN","EASECDD",18,0) W !,?8,"received during the current calendar year." "RTN","EASECDD",19,0) W !!,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",20,0) S X="?" "RTN","EASECDD",21,0) Q "RTN","EASECDD",22,0) 11 ; Military Retirement "RTN","EASECDD",23,0) W !,?8,"Enter in this field the annual amount of Military Retirement" "RTN","EASECDD",24,0) W !,?8,"received during the current calendar year." "RTN","EASECDD",25,0) W !!,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",26,0) S X="?" "RTN","EASECDD",27,0) Q "RTN","EASECDD",28,0) 12 ; Unemployment Compensation "RTN","EASECDD",29,0) W !,?8,"Enter in this field the annual amount of Unemployment Compensation" "RTN","EASECDD",30,0) W !,?8,"received during the current calendar year." "RTN","EASECDD",31,0) W !!,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",32,0) S X="?" "RTN","EASECDD",33,0) Q "RTN","EASECDD",34,0) 13 ; Other Retirement "RTN","EASECDD",35,0) W !,?8,"Enter in this field the annual amount of Other Retirement received" "RTN","EASECDD",36,0) W !,?8,"during the current calendar year. This includes company, state," "RTN","EASECDD",37,0) W !,?8,"local, etc." "RTN","EASECDD",38,0) W !!,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",39,0) S X="?" "RTN","EASECDD",40,0) Q "RTN","EASECDD",41,0) 14 ; Total Income from Employment "RTN","EASECDD",42,0) W !,?8,"Enter in this field the annual amount of Gross Income received during" "RTN","EASECDD",43,0) W !,?8,"the current year. This includes, but is not limited to, wages and" "RTN","EASECDD",44,0) W !,?8,"income from a business, bonuses, tips, severance pay, accrued" "RTN","EASECDD",45,0) W !,?8,"benefits, cash gifts." "RTN","EASECDD",46,0) W !!,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",47,0) S X="?" "RTN","EASECDD",48,0) Q "RTN","EASECDD",49,0) 15 ; Interest, Dividend or Annuity (Original 10-10EC) "RTN","EASECDD",50,0) ; Net Income from Farm, Ranch or Business (Revised 10-10EC) "RTN","EASECDD",51,0) ; Display a different message for the revised 10-10EC form. "RTN","EASECDD",52,0) ; Modified for LTC IV (EAS*1*40) "RTN","EASECDD",53,0) I $G(DGFORM) D "RTN","EASECDD",54,0) .W !,?8,"Enter in this field the annual amount of Net Income received during" "RTN","EASECDD",55,0) .W !,?8,"the current calendar year from the operation of a farm, ranch," "RTN","EASECDD",56,0) .W !,?8,"property or business." "RTN","EASECDD",57,0) I '$G(DGFORM) D "RTN","EASECDD",58,0) .W !,?8,"Enter in this field the annual amount of Interest and Dividend" "RTN","EASECDD",59,0) .W !,?8,"Income received during the current calendar year (i.e., interest" "RTN","EASECDD",60,0) .W !,?8,"income, standard dividend income from non tax deferred annuities)." "RTN","EASECDD",61,0) W !!,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",62,0) S X="?" "RTN","EASECDD",63,0) Q "RTN","EASECDD",64,0) 16 ; Workers Comp or Black Lung "RTN","EASECDD",65,0) W !,?8,"Enter in this field the annual amount of Workers Compensation or" "RTN","EASECDD",66,0) W !,?8,"Black Lung Benefits received during the current calendar year." "RTN","EASECDD",67,0) W !!,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",68,0) S X="?" "RTN","EASECDD",69,0) Q "RTN","EASECDD",70,0) 17 ; All Other Income "RTN","EASECDD",71,0) ; Display a different message for the revised 10-10EC form. "RTN","EASECDD",72,0) ; Modified for LTC IV (EAS*1*40) "RTN","EASECDD",73,0) I $G(DGFORM) D "RTN","EASECDD",74,0) .W !,?8,"Enter in this field the annual amount of All Other Income received" "RTN","EASECDD",75,0) .W !,?8,"during the current calendar year, including retirement and pension" "RTN","EASECDD",76,0) .W !,?8,"income, Social Security Retirement and Social Security Disability" "RTN","EASECDD",77,0) .W !,?8,"income, compensation benefits such as unemployment, Workers and" "RTN","EASECDD",78,0) .W !,?8,"Black Lung, or VA disability. Also cash gifts, court mandated" "RTN","EASECDD",79,0) .W !,?8,"payments, inheritance amounts, tort settlement payments, interest" "RTN","EASECDD",80,0) .W !,?8,"and dividends, including tax exempt earnings and distributions from" "RTN","EASECDD",81,0) .W !,?8,"Individual Retirement Accounts (IRAs) or annuities." "RTN","EASECDD",82,0) I '$G(DGFORM) D "RTN","EASECDD",83,0) .W !,?8,"Enter in this field the annual amount of All Other Income" "RTN","EASECDD",84,0) .W !,?8,"received during the current calendar year (i.e., inheritance amounts," "RTN","EASECDD",85,0) .W !,?8,"tort settlement payments)." "RTN","EASECDD",86,0) ;W !!,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",87,0) S X="?" "RTN","EASECDD",88,0) Q "RTN","EASECDD",89,0) 101 ; Medical Expenses "RTN","EASECDD",90,0) W !,?8,"Enter in this field the total amount of unreimbursed medical expenses" "RTN","EASECDD",91,0) W !,?8,"paid by the veteran during the current calendar year. The expenses" "RTN","EASECDD",92,0) W !,?8,"can be for the veteran or for members of the veteran's family." "RTN","EASECDD",93,0) W !,?8,"Reportable medical expenses include amounts paid for the following:" "RTN","EASECDD",94,0) W !,?8,"fees of physicians, dentists, and other providers of health services;" "RTN","EASECDD",95,0) W !,?8,"hospital and nursing home fees; medical insurance premiums (including" "RTN","EASECDD",96,0) W !,?8,"the Medicare premium); drugs and medicines; eyeglasses; any other" "RTN","EASECDD",97,0) W !,?8,"expenses that are reasonable related to medical care. The expenses" "RTN","EASECDD",98,0) W !,?8,"must actually have been paid by the veteran. Do not list expenses" "RTN","EASECDD",99,0) W !,?8,"which have not been paid or which have been paid by someone other" "RTN","EASECDD",100,0) W !,?8,"than the veteran. Do not list expenses which the veteran has paid if" "RTN","EASECDD",101,0) W !,?8,"the veteran expects to receive reimbursement from insurance or some" "RTN","EASECDD",102,0) W !,?8,"other source." "RTN","EASECDD",103,0) W ! "RTN","EASECDD",104,0) W !,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",105,0) S X="?" "RTN","EASECDD",106,0) Q "RTN","EASECDD",107,0) 102 ; Funeral and Burial Expenses "RTN","EASECDD",108,0) ; Modified wording for LTC Phase III (EAS*1*34) "RTN","EASECDD",109,0) W !,?8,"Enter in this field amounts paid by the veteran during the current" "RTN","EASECDD",110,0) W !,?8,"calendar year for funeral or burial expenses of the veteran's" "RTN","EASECDD",111,0) W !,?8,"spouse or child, or pre-paid arrangements for the veteran." "RTN","EASECDD",112,0) W !,?8,"Do not report amounts paid for funeral or burial expenses of other" "RTN","EASECDD",113,0) W !,?8,"relatives such as parents, siblings, etc." "RTN","EASECDD",114,0) W ! "RTN","EASECDD",115,0) W !,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",116,0) S X="?" "RTN","EASECDD",117,0) Q "RTN","EASECDD",118,0) 103 ; Educational Expenses "RTN","EASECDD",119,0) W !,?8,"Enter in this field the total amount paid by the veteran for" "RTN","EASECDD",120,0) W !,?8,"educational expenses during the current calendar year. This" "RTN","EASECDD",121,0) W !,?8,"includes educational expenses for the veteran, spouse and children." "RTN","EASECDD",122,0) W !,?8,"Educational expenses are tuition, fees, and books if enrolled in a" "RTN","EASECDD",123,0) W !,?8,"program of education." "RTN","EASECDD",124,0) W ! "RTN","EASECDD",125,0) W !,?8,"A monthly amount can be entered with an '*' after it.",! "RTN","EASECDD",126,0) S X="?" "RTN","EASECDD",127,0) Q "RTN","EASECDD",128,0) 201 ; Cash "RTN","EASECDD",129,0) ; Display a different message for the revised 10-10EC form. "RTN","EASECDD",130,0) ; Modified for LTC IV (EAS*1*40) "RTN","EASECDD",131,0) W !,?8,"Enter in this field cash and amounts in bank accounts. This" "RTN","EASECDD",132,0) W !,?8,"includes checking accounts, savings accounts, money markets," "RTN","EASECDD",133,0) W !,?8,"interest, dividends from IRA, 401K's, and other tax deferred" "RTN","EASECDD",134,0) W !,?8,"annuities.",! "RTN","EASECDD",135,0) ;If this is the revised 10-10EC form, also print the message for stocks. "RTN","EASECDD",136,0) I $G(DGFORM) G 202 "RTN","EASECDD",137,0) S X="?" "RTN","EASECDD",138,0) Q "RTN","EASECDD",139,0) 202 ; Stock, bonds, mutual funds "RTN","EASECDD",140,0) W !,?8,"Enter in this field the current value of stocks, bonds, mutual" "RTN","EASECDD",141,0) W !,?8,"funds, SEP's, and other retirement accounts (e.g., IRA, 401K," "RTN","EASECDD",142,0) W !,?8,"annuities, self-employed person).",! "RTN","EASECDD",143,0) S X="?" "RTN","EASECDD",144,0) Q "RTN","EASEZF3") 0^3^B21439689^B21135276 "RTN","EASEZF3",1,0) EASEZF3 ;ALB/jap - Filing 1010EZ Data to Patient Database ;10/31/00 13:07 "RTN","EASEZF3",2,0) ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,57,100**;Mar 15, 2001;Build 6 "RTN","EASEZF3",3,0) ; "RTN","EASEZF3",4,0) SP ;file Spouse data "RTN","EASEZF3",5,0) N C,MULTIPLE,FILE,SUBFILE,FLD,XDATA,ACCEPT,SUBIEN,SEX,EZDATA,EAS,ERR "RTN","EASEZF3",6,0) N KEY,X,Y,XLINK,DIC "RTN","EASEZF3",7,0) ;process sequence must be 408.13 - 408.12 - 408.21 - 408.22 "RTN","EASEZF3",8,0) ;set sex of spouse "RTN","EASEZF3",9,0) S KEY=+$$KEY711^EASEZU1("APPLICANT SEX") "RTN","EASEZF3",10,0) S X=$$DATA712^EASEZU1(EASAPP,KEY,1),APSEX=$P(X,U,1),SEX=$S(APSEX="M":"FEMALE",1:"MALE") "RTN","EASEZF3",11,0) S XLINK=$G(FLINK("SP",1,408.13)),PTDATA="" I XLINK D "RTN","EASEZF3",12,0) .S FFF="408.13^408.13^.02" S PTDATA=$$GET^EASEZC1(XLINK,FFF) "RTN","EASEZF3",13,0) .S SP(1,408.13,408.13,.02)=SEX_U_2_U_U_PTDATA_U_XLINK "RTN","EASEZF3",14,0) ; "RTN","EASEZF3",15,0) F FILE=408.13,408.12,408.21,408.22 D "RTN","EASEZF3",16,0) .S MULTIPLE=1,SUBFILE=FILE,FLD="" "RTN","EASEZF3",17,0) .S XLINK=$G(FLINK("SP",MULTIPLE,FILE)) "RTN","EASEZF3",18,0) .;record in file #408.13 is needed for all further data filng "RTN","EASEZF3",19,0) .Q:(FILE'=408.13)&('$G(FLINK("SP",MULTIPLE,408.13))) "RTN","EASEZF3",20,0) .;for data elements with link to database, "RTN","EASEZF3",21,0) .;only file 1010EZ data if accepted by user; "RTN","EASEZF3",22,0) .;data in external format "RTN","EASEZF3",23,0) .I XLINK D "RTN","EASEZF3",24,0) ..;when #408.12 record exists, don't try to update subfile #408.1275 "RTN","EASEZF3",25,0) ..S FLD="" F S FLD=$O(SP(MULTIPLE,FILE,SUBFILE,FLD)) Q:FLD="" D "RTN","EASEZF3",26,0) ...S XDATA=SP(MULTIPLE,FILE,SUBFILE,FLD),ACCEPT=$P(XDATA,U,2) "RTN","EASEZF3",27,0) ...I FILE=408.13,FLD=.09 S XDATA=$TR(XDATA,"-","") "RTN","EASEZF3",28,0) ...I ACCEPT D LINK^EASEZF2(XDATA,FILE,FLD,"SP",MULTIPLE) "RTN","EASEZF3",29,0) .;for data elements with no link to database, "RTN","EASEZF3",30,0) .;always create new record(s) to store 1010EZ data; "RTN","EASEZF3",31,0) .;put data in internal format "RTN","EASEZF3",32,0) .I 'XLINK D "RTN","EASEZF3",33,0) ..K EAS,ERR "RTN","EASEZF3",34,0) ..;supplement data and convert to internal format "RTN","EASEZF3",35,0) ..S FLD="" F S FLD=$O(SP(MULTIPLE,FILE,SUBFILE,FLD)) Q:FLD="" D "RTN","EASEZF3",36,0) ...S EZDATA=$P(SP(MULTIPLE,FILE,SUBFILE,FLD),U,1) "RTN","EASEZF3",37,0) ...S EAS(EASAPP,FILE,"+1,",FLD)=EZDATA "RTN","EASEZF3",38,0) ..I FILE=408.13 D "RTN","EASEZF3",39,0) ...S X=$G(EAS(EASAPP,FILE,"+1,",".03")) I X'="" D ^%DT S EAS(EASAPP,FILE,"+1,",".03")=Y "RTN","EASEZF3",40,0) ...S X=$G(EAS(EASAPP,FILE,"+1,",".09")) I X'="" D "RTN","EASEZF3",41,0) ....S SSN=$TR(X,"-","") S EAS(EASAPP,FILE,"+1,",".09")=SSN "RTN","EASEZF3",42,0) ....I $D(^DGPR(408.13,"SSN",SSN)) S EAS(EASAPP,FILE,"+1,",".09")="" "RTN","EASEZF3",43,0) ...S KEY=+$$KEY711^EASEZU1("APPLICANT SEX") "RTN","EASEZF3",44,0) ...S X=$P($$DATA712^EASEZU1(EASAPP,KEY,1),U,1),SEX=$S(X="M":"F",1:"M") "RTN","EASEZF3",45,0) ...S EAS(EASAPP,FILE,"+1,",".02")=SEX "RTN","EASEZF3",46,0) ...S X=$G(EAS(EASAPP,FILE,"+1,","1.6")) I X'="" D "RTN","EASEZF3",47,0) ....S DIC=5,DIC(0)="X" D ^DIC "RTN","EASEZF3",48,0) ....S EAS(EASAPP,FILE,"+1,","1.6")=$S(+Y:+Y,1:"") "RTN","EASEZF3",49,0) ..I FILE=408.12,$G(FLINK("SP",MULTIPLE,408.13)) D F40812("SP",1) "RTN","EASEZF3",50,0) ..I FILE=408.21,$G(FLINK("SP",MULTIPLE,408.12)) D "RTN","EASEZF3",51,0) ...S EAS(EASAPP,FILE,"+1,",".01")=INCYR "RTN","EASEZF3",52,0) ...S EAS(EASAPP,FILE,"+1,",".02")=FLINK("SP",MULTIPLE,408.12) "RTN","EASEZF3",53,0) ...S EAS(EASAPP,FILE,"+1,","101")=DUZ "RTN","EASEZF3",54,0) ...S EAS(EASAPP,FILE,"+1,","102")=DT "RTN","EASEZF3",55,0) ...S EAS(EASAPP,FILE,"+1,","103")=DUZ "RTN","EASEZF3",56,0) ...S EAS(EASAPP,FILE,"+1,","104")=DT "RTN","EASEZF3",57,0) ..I FILE=408.22,$G(FLINK("SP",MULTIPLE,408.21)) D "RTN","EASEZF3",58,0) ...S EAS(EASAPP,FILE,"+1,",".01")=EASDFN "RTN","EASEZF3",59,0) ...S EAS(EASAPP,FILE,"+1,",".02")=FLINK("SP",MULTIPLE,408.21) "RTN","EASEZF3",60,0) ..I FILE'=408.12 D "RTN","EASEZF3",61,0) ...S FLINK("SP",MULTIPLE,FILE)=$$NOLINK^EASEZF2(.EAS,"SP",MULTIPLE) "RTN","EASEZF3",62,0) ...S FLD="" F S FLD=$O(SP(MULTIPLE,FILE,SUBFILE,FLD)) Q:FLD="" D "RTN","EASEZF3",63,0) ....S $P(SP(MULTIPLE,FILE,SUBFILE,FLD),U,5)=FLINK("SP",MULTIPLE,FILE) "RTN","EASEZF3",64,0) Q "RTN","EASEZF3",65,0) ; "RTN","EASEZF3",66,0) F40812(TYPE,MULT) ;create a new record in file #408.12 "RTN","EASEZF3",67,0) ;input TYPE = "SP" for Souse or "CN" for Child "RTN","EASEZF3",68,0) ; MULT = always 1 for spouse; or "RTN","EASEZF3",69,0) ; 1st subscript of CN array for child "RTN","EASEZF3",70,0) ;can't use normal FileMan data entry "RTN","EASEZF3",71,0) N C,ARR,FILE,SUBFILE,FLD,DGPRIEN,XDATE,SUBIEN,RELATE,XX,X,Y,DA,DIK,EAS,ERR "RTN","EASEZF3",72,0) S DGPRIEN="" "RTN","EASEZF3",73,0) S ARR=TYPE "RTN","EASEZF3",74,0) S FILE=408.12,SUBFILE=408.12 "RTN","EASEZF3",75,0) I TYPE="SP" S RELATE=2 "RTN","EASEZF3",76,0) I TYPE="CN" D "RTN","EASEZF3",77,0) .S X=$P($G(CN(MULT,FILE,SUBFILE,".02")),U,1) "RTN","EASEZF3",78,0) .S RELATE=$S(X="SON":3,X="DAUGHTER":4,X="STEPSON":5,X="STEPDAUGHTER":6,1:99) "RTN","EASEZF3",79,0) ;verify that no record points to known file #408.13 record "RTN","EASEZF3",80,0) S C=FLINK(TYPE,MULT,408.13)_";DGPR(408.13," "RTN","EASEZF3",81,0) I $D(^DGPR(408.12,"C",C)) S DGPRIEN=$O(^DGPR(408.12,"C",C,0)) "RTN","EASEZF3",82,0) ;if it does, quit w/o filing "RTN","EASEZF3",83,0) Q:DGPRIEN "RTN","EASEZF3",84,0) ;otherwise create a new entry "RTN","EASEZF3",85,0) L +^DGPR(408.12,0):30 "RTN","EASEZF3",86,0) K DA,DIK "RTN","EASEZF3",87,0) S DGPRIEN=$P(^DGPR(408.12,0),U,3)+1,$P(^DGPR(408.12,0),U,3)=DGPRIEN "RTN","EASEZF3",88,0) S ^DGPR(408.12,DGPRIEN,0)=EASDFN_U_RELATE_U_C "RTN","EASEZF3",89,0) S DA=DGPRIEN,DIK="^DGPR(408.12,",DIK(1)=".01^" D EN^DIK S DIK(1)=".03" D EN^DIK "RTN","EASEZF3",90,0) S X=$P(^DGPR(408.12,0),U,4),$P(^DGPR(408.12,0),U,4)=X+1 "RTN","EASEZF3",91,0) L -^DGPR(408.12,0) "RTN","EASEZF3",92,0) S FLINK(TYPE,MULT,408.12)=DGPRIEN "RTN","EASEZF3",93,0) ;don't continue if file#408.12 record doesn't exist "RTN","EASEZF3",94,0) Q:'$G(FLINK(TYPE,MULT,408.12)) "RTN","EASEZF3",95,0) ;store the link in subfile #712.01 record "RTN","EASEZF3",96,0) S FLD="" F S FLD=$O(@ARR@(MULT,FILE,SUBFILE,FLD)) Q:FLD="" D "RTN","EASEZF3",97,0) .S SUBIEN=$P(@ARR@(MULT,FILE,SUBFILE,FLD),U,3) "RTN","EASEZF3",98,0) .S $P(@ARR@(MULT,FILE,SUBFILE,FLD),U,5)=FLINK(TYPE,MULT,FILE) "RTN","EASEZF3",99,0) ;there's never more than one array node for subfile #408.1275; for field #.01; "RTN","EASEZF3",100,0) S SUBFILE=408.1275,FLD=".01" "RTN","EASEZF3",101,0) S XX=$G(@ARR@(MULT,FILE,SUBFILE,FLD)) "RTN","EASEZF3",102,0) K EAS "RTN","EASEZF3",103,0) S XDATE=$P(XX,U,1) "RTN","EASEZF3",104,0) S SUBIEN=$P(XX,U,3) "RTN","EASEZF3",105,0) Q:XDATE="" "RTN","EASEZF3",106,0) S X=XDATE D ^%DT S XDATE=Y "RTN","EASEZF3",107,0) S EAS(EASAPP,SUBFILE,"+1,"_FLINK(TYPE,MULT,408.12)_",",".01")=XDATE "RTN","EASEZF3",108,0) S EAS(EASAPP,SUBFILE,"+1,"_FLINK(TYPE,MULT,408.12)_",",".02")=1 "RTN","EASEZF3",109,0) S FLINK(TYPE,MULT,SUBFILE)=$$NOLINK^EASEZF2(.EAS,TYPE,MULT) "RTN","EASEZF3",110,0) Q:FLINK(TYPE,MULT,SUBFILE)="" "RTN","EASEZF3",111,0) ;store link to new subrecord in subfile #712.01 "RTN","EASEZF3",112,0) S $P(@ARR@(MULT,FILE,SUBFILE,FLD),U,5)=FLINK(TYPE,MULT,FILE)_";"_FLINK(TYPE,MULT,SUBFILE) "RTN","EASEZF3",113,0) Q "RTN","EASEZI") 0^1^B43951690^B43721741 "RTN","EASEZI",1,0) EASEZI ;ALB/jap - Database Inquiry & Record Finder for 1010EZ Processing ;10/12/00 13:08 "RTN","EASEZI",2,0) ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,9,44,51,57,70,81,100**;Mar 15, 2001;Build 6 "RTN","EASEZI",3,0) ; "RTN","EASEZI",4,0) DFN(EASAPP,EASDFN) ;match or add 1010EZ applicant to Patient file #2 "RTN","EASEZI",5,0) ; "RTN","EASEZI",6,0) ;input "RTN","EASEZI",7,0) ; EASAPP = application ien in file #712 "RTN","EASEZI",8,0) ;output "RTN","EASEZI",9,0) ; EASDFN = valid ien in file #2; passed by reference "RTN","EASEZI",10,0) ; OR -1 if no patient match made; "RTN","EASEZI",11,0) ; note: this may be an existing patient or one newly created by user action "RTN","EASEZI",12,0) ; "RTN","EASEZI",13,0) ;This entry point it used only for initial match of Applicant with Patient database. "RTN","EASEZI",14,0) ; "RTN","EASEZI",15,0) N DFN,DGNEWPF,DGRPTOUT,EZDATA,KEY,NAME,SSN,DOB,SEX,KEYIEN,ACCEPT,ARRAY,RECD "RTN","EASEZI",16,0) N VETTYPE,NEW,TSSN,REM,N,X,DA,DR,DIE,DIC,DIQ,ALREADY,OUT,FILE,SUBFILE,FLD,ELIGVER,SVCVER,APPTVER "RTN","EASEZI",17,0) Q:'EASAPP "RTN","EASEZI",18,0) ;do not proceed if link to file #2 already established "RTN","EASEZI",19,0) S EASDFN=$P($G(^EAS(712,EASAPP,0)),U,10) Q:EASDFN "RTN","EASEZI",20,0) D FULL^VALM1 W @IOF "RTN","EASEZI",21,0) S EASEZNEW="",ELIGVER=0,SVCVER=0,APPTVER=0 "RTN","EASEZI",22,0) S KEY=$$KEY711^EASEZU1("APPLICANT SEX") "RTN","EASEZI",23,0) S SEX=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1),SEX=$S(SEX="M":"Male",SEX="F":"Female",1:"") "RTN","EASEZI",24,0) S DIQ="ARRAY",DIQ(0)="E",DA=EASAPP,DR="1;2;3;3.3",DIC=712 D EN^DIQ1 "RTN","EASEZI",25,0) S NAME=$G(ARRAY(712,EASAPP,1,"E")) "RTN","EASEZI",26,0) S SSN=$P($G(ARRAY(712,EASAPP,2,"E")),"&",1) "RTN","EASEZI",27,0) S DOB=$P($G(ARRAY(712,EASAPP,2,"E")),"&",2) "RTN","EASEZI",28,0) S RECD=$G(ARRAY(712,EASAPP,3,"E")) "RTN","EASEZI",29,0) S VETTYPE=$G(ARRAY(712,EASAPP,3.3,"E")) "RTN","EASEZI",30,0) W !,"Applicant Data",?24,"Application #: ",EASAPP,?48,"Received: ",RECD,! "RTN","EASEZI",31,0) W !,"Name: ",NAME "RTN","EASEZI",32,0) W !,"SSN: ",SSN,?24,"DOB: ",DOB,?48,"Sex: ",SEX "RTN","EASEZI",33,0) W !,"Veteran Type: ",VETTYPE "RTN","EASEZI",34,0) W !!,"Enter Applicant data as prompted --" "RTN","EASEZI",35,0) ; "RTN","EASEZI",36,0) ;Get Patient file (#2) IEN - DFN "RTN","EASEZI",37,0) ;EAS*1*81 - changes made to allow adding new patient with same name "RTN","EASEZI",38,0) ;as an existing patient "RTN","EASEZI",39,0) N EASANS,Y S EASANS=0 "RTN","EASEZI",40,0) N DIR,DIRUT "RTN","EASEZI",41,0) S DIR(0)="YAO" "RTN","EASEZI",42,0) S DIR("?")="Enter 'Yes' if this patient is the one you want to select." "RTN","EASEZI",43,0) S DIR("A")="IS THIS THE CORRECT PATIENT? " "RTN","EASEZI",44,0) S DIR("B")="YES" "RTN","EASEZI",45,0) F Q:EASANS D K DIR "RTN","EASEZI",46,0) . D GETPAT^DGRPTU("",1,.DFN,.DGNEWPF) I DFN>0,($G(DGNEWPF)=1) S EASANS=1 Q "RTN","EASEZI",47,0) . I DFN'>0 S EASANS=1 Q "RTN","EASEZI",48,0) . I DFN>0,($G(DGNEWPF)'=1) D "RTN","EASEZI",49,0) . . D ^DIR "RTN","EASEZI",50,0) . . I $D(DIRUT) Q "RTN","EASEZI",51,0) . . I Y(0)["Y" S EASANS=1 Q "RTN","EASEZI",52,0) . . I Y(0)["N" K DFN "RTN","EASEZI",53,0) . . I $G(DFN)'>0 D "RTN","EASEZI",54,0) . . W !!?5,"If there are already one or more patients with the same name,",!?5,"re-enter the name in double quotes, for example, ""DOE,JOHN""." "RTN","EASEZI",55,0) Q:($G(DFN)'>0) "RTN","EASEZI",56,0) ;if DGNEWPF=1 then applicant has just been added to file #2 as new patient "RTN","EASEZI",57,0) S NEW="" "RTN","EASEZI",58,0) I DGNEWPF D "RTN","EASEZI",59,0) . S NEW=1 "RTN","EASEZI",60,0) . ;add a remark to file #2 record to help keep track of new patients added by 1010EZ "RTN","EASEZI",61,0) . S REM="NEW PT. FROM ELECTRONIC 10-10EZ -- IN PROCESS" "RTN","EASEZI",62,0) . S DA=DFN,DIE="^DPT(",DR=".091///^S X=REM" "RTN","EASEZI",63,0) . D ^DIE "RTN","EASEZI",64,0) ;if seems to be not new, check remark field just to make sure "RTN","EASEZI",65,0) I NEW="" D "RTN","EASEZI",66,0) . S REM="NEW PT. FROM ELECTRONIC 10-10EZ -- IN PROCESS" "RTN","EASEZI",67,0) . I $P(^DPT(DFN,0),U,10)=REM S NEW=1 "RTN","EASEZI",68,0) ;MPI Query "RTN","EASEZI",69,0) S X="MPIFAPI" X ^%ZOSF("TEST") D "RTN","EASEZI",70,0) . Q:'$T "RTN","EASEZI",71,0) . K MPIFRTN "RTN","EASEZI",72,0) . D MPIQ^MPIFAPI(DFN) "RTN","EASEZI",73,0) . K MPIFRTN,MPIQRYNM "RTN","EASEZI",74,0) ;check for an in-process application already linked to this DFN "RTN","EASEZI",75,0) S OUT=0,ALREADY=0 F S ALREADY=$O(^EAS(712,"AC",DFN,ALREADY)) Q:'ALREADY D Q:OUT "RTN","EASEZI",76,0) . S FILDATE=$P($G(^EAS(712,ALREADY,2)),U,5) "RTN","EASEZI",77,0) . S CLSDATE=$P($G(^EAS(712,ALREADY,2)),U,9) "RTN","EASEZI",78,0) . I 'FILDATE,'CLSDATE S OUT=1 D "RTN","EASEZI",79,0) . . W !!?3,"Sorry... cannot link to selected Patient." "RTN","EASEZI",80,0) . . W !?3,"Application #"_ALREADY_" is already linked to this Patient," "RTN","EASEZI",81,0) . . W !?3,"and is still in-process." "RTN","EASEZI",82,0) . . D PAUSE^VALM1 K FILDATE,CLSDATE "RTN","EASEZI",83,0) Q:OUT "RTN","EASEZI",84,0) D RESET^EASEZI1 "RTN","EASEZI",85,0) Q "RTN","EASEZI",86,0) ; "RTN","EASEZI",87,0) I201(EASDFN,EASARRAY) ;retrieve ien(s) in subfile #2.01 "RTN","EASEZI",88,0) ;input EASDFN = ien to #2 "RTN","EASEZI",89,0) ;output EASARRAY = ien(s) to #2.01 "RTN","EASEZI",90,0) ; each array element = EASDFN;subfile_ien "RTN","EASEZI",91,0) ; "RTN","EASEZI",92,0) N N,IEN "RTN","EASEZI",93,0) S IEN=0,N=0 F S IEN=$O(^DPT(EASDFN,.01,IEN)) Q:'IEN S N=N+1,EASARRAY(N)=EASDFN_";"_IEN "RTN","EASEZI",94,0) Q "RTN","EASEZI",95,0) ; "RTN","EASEZI",96,0) I202(EASDFN,EASARRAY) ;retrieve ien(s) in subfile #2.02 "RTN","EASEZI",97,0) ;input EASDFN = ien to #2 "RTN","EASEZI",98,0) ;output EASARRAY = ien(s) to #2.01 "RTN","EASEZI",99,0) ; each array element = EASDFN;subfile_ien "RTN","EASEZI",100,0) ; "RTN","EASEZI",101,0) N N,IEN "RTN","EASEZI",102,0) S IEN=0,N=0 F S IEN=$O(^DPT(EASDFN,.02,IEN)) Q:'IEN S N=N+1,EASARRAY(N)=EASDFN_";"_IEN "RTN","EASEZI",103,0) Q "RTN","EASEZI",104,0) ; "RTN","EASEZI",105,0) I206(EASDFN,EASARRAY) ;retrieve ien(s) in subfile #2.06 "RTN","EASEZI",106,0) ;input EASDFN = ien to #2 "RTN","EASEZI",107,0) ;output EASARRAY = ien(s) to #2.01 "RTN","EASEZI",108,0) ; each array element = EASDFN;subfile_ien "RTN","EASEZI",109,0) ; "RTN","EASEZI",110,0) N N,IEN "RTN","EASEZI",111,0) S IEN=0,N=0 F S IEN=$O(^DPT(EASDFN,.06,IEN)) Q:'IEN S N=N+1,EASARRAY(N)=EASDFN_";"_IEN "RTN","EASEZI",112,0) Q "RTN","EASEZI",113,0) ; "RTN","EASEZI",114,0) I2101(EASDFN,EASARRAY) ;retrieve ien to subfile #2.101 "RTN","EASEZI",115,0) ;input EASDFN = ien to #2 "RTN","EASEZI",116,0) ;output EASARRAY = most recent ien in #2.101; "RTN","EASEZI",117,0) ; array element = EASDFN;subfile_ien "RTN","EASEZI",118,0) ; "RTN","EASEZI",119,0) N N,IEN,ARR,LAST,EASQUIT,EASICN "RTN","EASEZI",120,0) S EASQUIT=0 "RTN","EASEZI",121,0) S IEN=0,N=0 F S IEN=$O(^DPT(EASDFN,"DIS",IEN)) Q:'IEN!EASQUIT D "RTN","EASEZI",122,0) . ;S RDATE=$P(^DPT(EASDFN,"DIS",IEN,0),U,1),ARR(RDATE)=IEN "RTN","EASEZI",123,0) . S RDATE=$P($G(^DPT(EASDFN,"DIS",IEN,0)),U,1) I RDATE]"" S ARR(RDATE)=IEN "RTN","EASEZI",124,0) . I RDATE']"" D "RTN","EASEZI",125,0) .. K XQA,XQAID,XQAMSG "RTN","EASEZI",126,0) .. S EASICN=$$GETICN^MPIF001(EASDFN) I EASICN]"" S EASICN=$P(EASICN,"V",1) "RTN","EASEZI",127,0) .. S XQA(DUZ)="" "RTN","EASEZI",128,0) .. S XQAID="EAS" "RTN","EASEZI",129,0) .. S XQAMSG="No disposition for "_$P(^DPT(EASDFN,0),"^",1)_" ICN: "_EASICN_" Re-register patient." "RTN","EASEZI",130,0) .. ;S $P(XQADATA,"^",1)="NAME : "_$P(^DPT(EASDFN,0),"^",1) ;PATIENT NAME "RTN","EASEZI",131,0) .. D SETUP^XQALERT "RTN","EASEZI",132,0) ..; S EASQUIT=1 K ^DPT(EASDFN,"DIS",IEN),^DPT("ADA",1,EASDFN),ARR "RTN","EASEZI",133,0) .. S EASQUIT=1 D "RTN","EASEZI",134,0) ... K ARR,DA,DA(1),DIK,EASNODE,EASDT "RTN","EASEZI",135,0) ... S DA=IEN,DA(1)=EASDFN,DIK="^DPT("_EASDFN_",""DIS""," D ^DIK K DIK,DA "RTN","EASEZI",136,0) ... I $D(^DPT("ADA",1,EASDFN)) S EASDT=$O(^DPT("ADA",1,EASDFN,0)),EASNODE="^DPT(""ADA"""_",1,"_EASDFN_","_EASDT_")" K @EASNODE "RTN","EASEZI",137,0) ... Q "RTN","EASEZI",138,0) .. I '$D(IO("Q")) D "RTN","EASEZI",139,0) ... W !!,"No disposition for "_$P(^DPT(EASDFN,0),"^",1)_" ICN: "_EASICN "RTN","EASEZI",140,0) ... W !,"A blank 1010EZ may print. Please re-register the patient and reprint the 1010EZ." "RTN","EASEZI",141,0) ... H 6 "RTN","EASEZI",142,0) ..; D ENQUIT^EASEZPF ; KILLS ALL OF THE ^TMP("EZ" VARIABLES FOR PRINTING1010EZ. "RTN","EASEZI",143,0) ..S EASARRAY(1)="NO DISPOSITION" Q "RTN","EASEZI",144,0) I $D(ARR) D "RTN","EASEZI",145,0) . S LAST=$O(ARR(999999999),-1),IEN=ARR(LAST) "RTN","EASEZI",146,0) . S EASARRAY(1)=EASDFN_";"_IEN "RTN","EASEZI",147,0) Q "RTN","EASEZI",148,0) ; "RTN","EASEZI",149,0) I2711(EASDFN,EASARRAY) ;retrieve ien to file #27.11 "RTN","EASEZI",150,0) ;input EASDFN = ien to #2 "RTN","EASEZI",151,0) ;output EASARRAY = current enrollment ien in #27.11; "RTN","EASEZI",152,0) ; array element = ien "RTN","EASEZI",153,0) N CUR "RTN","EASEZI",154,0) S CUR=$$FINDCUR^DGENA(+EASDFN) "RTN","EASEZI",155,0) S EASARRAY(1)=CUR "RTN","EASEZI",156,0) Q "RTN","EASEZI",157,0) ; "RTN","EASEZI",158,0) I408(EASDFN,EASAPP,EASARRAY) ;retrieve ien(s) to files #408.12,#408.13,#408.21,#408.22 "RTN","EASEZI",159,0) ; "RTN","EASEZI",160,0) ;input EASDFN = ien to #2 "RTN","EASEZI",161,0) ; EASAPP = ien to #712 "RTN","EASEZI",162,0) ;output EASARRAY = ien(s) to files; passed by reference "RTN","EASEZI",163,0) ; array(408,"V",1) = ien_#408.12^ien_#408.13^ien_#408.21^ien#408.22 ;veteran data "RTN","EASEZI",164,0) ; array(408,"S",1) = ien_#408.12^ien_#408.13^ien_#408.21^ien#408.22 ;spouse data "RTN","EASEZI",165,0) ; array(408,"C",multiple) = ien_#408.12^ien_#408.13^ien_#408.21^ien#408.22 ;child data "RTN","EASEZI",166,0) ; where ien_#408.13 = ien;global_root "RTN","EASEZI",167,0) ; "RTN","EASEZI",168,0) N CURINCYR,X,Y,DIC,DA,DR,DIQ,EAS,DEP,REL,IX,JX,KX,I13,SUB1,SUB2,INCYR,PT "RTN","EASEZI",169,0) ; "RTN","EASEZI",170,0) Q:'EASDFN "RTN","EASEZI",171,0) S Y=$P($G(^EAS(712,EASAPP,0)),U,6) I Y="" S Y=DT "RTN","EASEZI",172,0) S %F=5,X=$$FMTE^XLFDT(Y,%F),X=+$P(X,"/",3)-1,%DT="P" D ^%DT S CURINCYR=Y "RTN","EASEZI",173,0) ;find all associated 408 records, even if no actual income test "RTN","EASEZI",174,0) ; get #408.12, #408.13, #408.21, #408.22 iens "RTN","EASEZI",175,0) K EAS S DEP=0 "RTN","EASEZI",176,0) S IX=0 F S IX=$O(^DGPR(408.12,"B",EASDFN,IX)) Q:'IX D "RTN","EASEZI",177,0) . S DIC=408.12,DA=IX,DIQ="EAS",DIQ(0)="I",DR=".02;.03" D EN^DIQ1 "RTN","EASEZI",178,0) . S REL=$G(EAS(408.12,IX,.02,"I")),I13=$G(EAS(408.12,IX,.03,"I")) "RTN","EASEZI",179,0) . S (SUB1,SUB2)="" S:REL=1 SUB1="V",SUB2=1 S:REL=2 SUB1="S",SUB2=1 S:REL>2 SUB1="C",DEP=DEP+1,SUB2=DEP "RTN","EASEZI",180,0) . I SUB1]"" S EASARRAY(408,SUB1,SUB2)=IX_U_I13 D "RTN","EASEZI",181,0) . . S JX=$O(^DGMT(408.21,"C",IX,""),-1) "RTN","EASEZI",182,0) . . I JX D "RTN","EASEZI",183,0) . . . S DIC=408.21,DA=JX,DIQ="EAS",DIQ(0)="I",DR=".01;.02" D EN^DIQ1 "RTN","EASEZI",184,0) . . . S INCYR=$G(EAS(408.21,JX,.01,"I")),PT=$G(EAS(408.21,JX,.02,"I")) "RTN","EASEZI",185,0) . . . Q:PT'=IX "RTN","EASEZI",186,0) . . . Q:(INCYR