KIDS Distribution saved on Mar 19, 2015@12:42:08 Catastrophic Disability Enhancement **KIDS**:DG*5.3*894^IVM*2.0*158^ **INSTALL NAME** DG*5.3*894 "BLD",9535,0) DG*5.3*894^REGISTRATION^0^3150319^y "BLD",9535,1,0) ^^4^4^3141210^^^ "BLD",9535,1,1,0) This patch replaces CD STATUS DIAGNOSES, CD STATUS PROCEDURES and CD "BLD",9535,1,2,0) STATUS CONDITIONS with CD DESCRIPTORS, thus eliminating the use of ICD "BLD",9535,1,3,0) and CPT codes for qualifying CD Reasons. Six new descriptors with a TYPE "BLD",9535,1,4,0) of "DE" are added to the Catastrophic Disability REASONS file #27.17. "BLD",9535,4,0) ^9.64PA^38.6^3 "BLD",9535,4,2,0) 2 "BLD",9535,4,2,2,0) ^9.641^2.401^6 "BLD",9535,4,2,2,2,0) PATIENT (File-top level) "BLD",9535,4,2,2,2,1,0) ^9.6411^.3953^9 "BLD",9535,4,2,2,2,1,.39,0) VETERAN CATASTROPHICALLY DISABLED? "BLD",9535,4,2,2,2,1,.391,0) DECIDED BY "BLD",9535,4,2,2,2,1,.392,0) DATE OF DECISION "BLD",9535,4,2,2,2,1,.393,0) FACILITY MAKING DETERMINATION "BLD",9535,4,2,2,2,1,.394,0) REVIEW DATE "BLD",9535,4,2,2,2,1,.395,0) METHOD OF DETERMINATION "BLD",9535,4,2,2,2,1,.3951,0) DATE VETERAN REQUESTED CD EVAL "BLD",9535,4,2,2,2,1,.3952,0) DATE FACILITY INITIATED REVIEW "BLD",9535,4,2,2,2,1,.3953,0) DATE VETERAN WAS NOTIFIED "BLD",9535,4,2,2,2.396,0) CD STATUS DIAGNOSES (sub-file) "BLD",9535,4,2,2,2.396,1,0) ^9.6411^^ "BLD",9535,4,2,2,2.397,0) CD STATUS PROCEDURES (sub-file) "BLD",9535,4,2,2,2.397,1,0) ^9.6411^^ "BLD",9535,4,2,2,2.398,0) CD STATUS CONDITIONS (sub-file) "BLD",9535,4,2,2,2.398,1,0) ^9.6411^^ "BLD",9535,4,2,2,2.399,0) CD HISTORY DATE (sub-file) "BLD",9535,4,2,2,2.399,1,0) ^9.6411^^0 "BLD",9535,4,2,2,2.401,0) CD STATUS DESCRIPTORS (sub-file) "BLD",9535,4,2,2,2.401,1,0) ^9.6411^^ "BLD",9535,4,2,222) y^n^p^^^^n^^n "BLD",9535,4,2,224) "BLD",9535,4,27.17,0) 27.17 "BLD",9535,4,27.17,222) y^y^f^^y^^y^m^y "BLD",9535,4,27.17,223) "BLD",9535,4,27.17,224) I $$TYPE^DGENA5(Y)="DE" "BLD",9535,4,38.6,0) 38.6 "BLD",9535,4,38.6,222) y^y^f^^n^^y^m^n "BLD",9535,4,38.6,224) I Y=727!(Y=728) "BLD",9535,4,"APDD",2,2) "BLD",9535,4,"APDD",2,2,.39) "BLD",9535,4,"APDD",2,2,.391) "BLD",9535,4,"APDD",2,2,.392) "BLD",9535,4,"APDD",2,2,.393) "BLD",9535,4,"APDD",2,2,.394) "BLD",9535,4,"APDD",2,2,.395) "BLD",9535,4,"APDD",2,2,.3951) "BLD",9535,4,"APDD",2,2,.3952) "BLD",9535,4,"APDD",2,2,.3953) "BLD",9535,4,"APDD",2,2.396) "BLD",9535,4,"APDD",2,2.397) "BLD",9535,4,"APDD",2,2.398) "BLD",9535,4,"APDD",2,2.399) "BLD",9535,4,"APDD",2,2.401) "BLD",9535,4,"B",2,2) "BLD",9535,4,"B",27.17,27.17) "BLD",9535,4,"B",38.6,38.6) "BLD",9535,6.3) 48 "BLD",9535,"ABPKG") n "BLD",9535,"KRN",0) ^9.67PA^779.2^20 "BLD",9535,"KRN",.4,0) .4 "BLD",9535,"KRN",.401,0) .401 "BLD",9535,"KRN",.402,0) .402 "BLD",9535,"KRN",.403,0) .403 "BLD",9535,"KRN",.5,0) .5 "BLD",9535,"KRN",.84,0) .84 "BLD",9535,"KRN",3.6,0) 3.6 "BLD",9535,"KRN",3.8,0) 3.8 "BLD",9535,"KRN",9.2,0) 9.2 "BLD",9535,"KRN",9.8,0) 9.8 "BLD",9535,"KRN",9.8,"NM",0) ^9.68A^11^11 "BLD",9535,"KRN",9.8,"NM",1,0) DGENCD^^0^B32491521 "BLD",9535,"KRN",9.8,"NM",2,0) DGENCD1^^0^B23998759 "BLD",9535,"KRN",9.8,"NM",3,0) DGENCDA^^0^B9760076 "BLD",9535,"KRN",9.8,"NM",4,0) DGENCDA1^^0^B44873485 "BLD",9535,"KRN",9.8,"NM",5,0) DGENCDA2^^0^B12005626 "BLD",9535,"KRN",9.8,"NM",6,0) DGENLCD1^^0^B11542351 "BLD",9535,"KRN",9.8,"NM",7,0) DGENCDU^^0^B2645954 "BLD",9535,"KRN",9.8,"NM",8,0) VAFHLZCD^^0^B35023485 "BLD",9535,"KRN",9.8,"NM",9,0) DGENUPL1^^0^B43841237 "BLD",9535,"KRN",9.8,"NM",10,0) DGENUPL2^^0^B82241171 "BLD",9535,"KRN",9.8,"NM",11,0) DGENA5^^0^B46261857 "BLD",9535,"KRN",9.8,"NM","B","DGENA5",11) "BLD",9535,"KRN",9.8,"NM","B","DGENCD",1) "BLD",9535,"KRN",9.8,"NM","B","DGENCD1",2) "BLD",9535,"KRN",9.8,"NM","B","DGENCDA",3) "BLD",9535,"KRN",9.8,"NM","B","DGENCDA1",4) "BLD",9535,"KRN",9.8,"NM","B","DGENCDA2",5) "BLD",9535,"KRN",9.8,"NM","B","DGENCDU",7) "BLD",9535,"KRN",9.8,"NM","B","DGENLCD1",6) "BLD",9535,"KRN",9.8,"NM","B","DGENUPL1",9) "BLD",9535,"KRN",9.8,"NM","B","DGENUPL2",10) "BLD",9535,"KRN",9.8,"NM","B","VAFHLZCD",8) "BLD",9535,"KRN",19,0) 19 "BLD",9535,"KRN",19.1,0) 19.1 "BLD",9535,"KRN",101,0) 101 "BLD",9535,"KRN",409.61,0) 409.61 "BLD",9535,"KRN",409.61,"NM",0) ^9.68A^1^1 "BLD",9535,"KRN",409.61,"NM",1,0) DGENCD CATASTROPHIC DISABILITY^^0 "BLD",9535,"KRN",409.61,"NM","B","DGENCD CATASTROPHIC DISABILITY",1) "BLD",9535,"KRN",771,0) 771 "BLD",9535,"KRN",771,"NM",0) ^9.68A^^ "BLD",9535,"KRN",779.2,0) 779.2 "BLD",9535,"KRN",870,0) 870 "BLD",9535,"KRN",8989.51,0) 8989.51 "BLD",9535,"KRN",8989.52,0) 8989.52 "BLD",9535,"KRN",8994,0) 8994 "BLD",9535,"KRN","B",.4,.4) "BLD",9535,"KRN","B",.401,.401) "BLD",9535,"KRN","B",.402,.402) "BLD",9535,"KRN","B",.403,.403) "BLD",9535,"KRN","B",.5,.5) "BLD",9535,"KRN","B",.84,.84) "BLD",9535,"KRN","B",3.6,3.6) "BLD",9535,"KRN","B",3.8,3.8) "BLD",9535,"KRN","B",9.2,9.2) "BLD",9535,"KRN","B",9.8,9.8) "BLD",9535,"KRN","B",19,19) "BLD",9535,"KRN","B",19.1,19.1) "BLD",9535,"KRN","B",101,101) "BLD",9535,"KRN","B",409.61,409.61) "BLD",9535,"KRN","B",771,771) "BLD",9535,"KRN","B",779.2,779.2) "BLD",9535,"KRN","B",870,870) "BLD",9535,"KRN","B",8989.51,8989.51) "BLD",9535,"KRN","B",8989.52,8989.52) "BLD",9535,"KRN","B",8994,8994) "BLD",9535,"QUES",0) ^9.62^^ "BLD",9535,"REQB",0) ^9.611^3^3 "BLD",9535,"REQB",1,0) DG*5.3*850^1 "BLD",9535,"REQB",2,0) DG*5.3*610^1 "BLD",9535,"REQB",3,0) DG*5.3*842^1 "BLD",9535,"REQB","B","DG*5.3*610",2) "BLD",9535,"REQB","B","DG*5.3*842",3) "BLD",9535,"REQB","B","DG*5.3*850",1) "DATA",27.17,238,0) Quadriplegia^DE^^1 "DATA",27.17,239,0) Paraplegia^DE^^2 "DATA",27.17,240,0) Persistent Vegetative State^DE^^3 "DATA",27.17,241,0) Legal Blindness^DE^^4 "DATA",27.17,242,0) Amputation, Disarticulation or Detachment^DE^^5 "DATA",27.17,243,0) Deficiencies of Physical or Mental Function^DE^^6 "DATA",38.6,727,0) CD DESCRIPTOR IS NOT VALID^CD STATUS DESCRIPTOR IS NOT VALID^0^0^0^1 "DATA",38.6,727,"D",0) ^^2^2^3141024^ "DATA",38.6,727,"D",1,0) The status descriptor must be a valid descriptor in the CD Reasons File "DATA",38.6,727,"D",2,0) (#27.17). "DATA",38.6,728,0) NO CD DESCRIPTORS SELECTED^CD STATUS REASON IS REQUIRED FOR EACH COND, DX, PROC AND DESC ENTERED^0^0^0^1 "DATA",38.6,728,"D",0) ^^2^2^3141209^ "DATA",38.6,728,"D",1,0) A CD status reason is required for each CD Condition, Diagnosis, "DATA",38.6,728,"D",2,0) Procedure and Descriptor that is entered. "FIA",2) PATIENT "FIA",2,0) ^DPT( "FIA",2,0,0) 2I "FIA",2,0,1) y^n^p^^^^n^^n "FIA",2,0,10) "FIA",2,0,11) "FIA",2,0,"RLRO") "FIA",2,0,"VR") 5.3^DG "FIA",2,2) 1 "FIA",2,2,.39) "FIA",2,2,.391) "FIA",2,2,.392) "FIA",2,2,.393) "FIA",2,2,.394) "FIA",2,2,.395) "FIA",2,2,.3951) "FIA",2,2,.3952) "FIA",2,2,.3953) "FIA",2,2,.396) "FIA",2,2,.397) "FIA",2,2,.398) "FIA",2,2,.399) "FIA",2,2,.401) "FIA",2,2.396) 0 "FIA",2,2.397) 0 "FIA",2,2.398) 0 "FIA",2,2.399) 0 "FIA",2,2.401) 0 "FIA",2,2.409) 0 "FIA",27.17) CATASTROPHIC DISABILITY REASONS "FIA",27.17,0) ^DGEN(27.17, "FIA",27.17,0,0) 27.17IO "FIA",27.17,0,1) y^y^f^^y^^y^m^y "FIA",27.17,0,10) "FIA",27.17,0,11) I $$TYPE^DGENA5(Y)="DE" "FIA",27.17,0,"RLRO") "FIA",27.17,0,"VR") 5.3^DG "FIA",27.17,27.17) 0 "FIA",27.17,27.174) 0 "FIA",27.17,27.176) 0 "FIA",38.6) INCONSISTENT DATA ELEMENTS "FIA",38.6,0) ^DGIN(38.6, "FIA",38.6,0,0) 38.6s "FIA",38.6,0,1) y^y^f^^n^^y^m^n "FIA",38.6,0,10) "FIA",38.6,0,11) I Y=727!(Y=728) "FIA",38.6,0,"RLRO") "FIA",38.6,0,"VR") 5.3^DG "FIA",38.6,38.6) 0 "FIA",38.6,38.61) 0 "KRN",409.61,236,-1) 0^1 "KRN",409.61,236,0) DGENCD CATASTROPHIC DISABILITY^1^^100^4^19^1^1^^DGENCD CATASTROPHIC DISABILITY MENU^Catastrophic Disability^1^^1 "KRN",409.61,236,1) ^VALM HIDDEN ACTIONS "KRN",409.61,236,"ARRAY") ^TMP("DGEN CD",$J) "KRN",409.61,236,"FNL") D EXIT^DGENLCD "KRN",409.61,236,"HDR") D HDR^DGENLCD "KRN",409.61,236,"HLP") D HELP^DGENLCD "KRN",409.61,236,"INIT") D INIT^DGENLCD "MBREQ") 0 "ORD",17,409.61) 409.61;17;1;;;;LME1^XPDIA1;;;LMDEL^XPDIA1 "ORD",17,409.61,0) LIST TEMPLATE "PGL",27.17,0,9,9) ICD VERSION^P80.4'I^ICDS(^0;9^Q "PKG",47,-1) 1^1 "PKG",47,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",47,20,0) ^9.402P^^ "PKG",47,22,0) ^9.49I^1^1 "PKG",47,22,1,0) 5.3^2930813^2960613 "PKG",47,22,1,"PAH",1,0) 894^3150319^101063 "PKG",47,22,1,"PAH",1,1,0) ^^4^4^3150319 "PKG",47,22,1,"PAH",1,1,1,0) This patch replaces CD STATUS DIAGNOSES, CD STATUS PROCEDURES and CD "PKG",47,22,1,"PAH",1,1,2,0) STATUS CONDITIONS with CD DESCRIPTORS, thus eliminating the use of ICD "PKG",47,22,1,"PAH",1,1,3,0) and CPT codes for qualifying CD Reasons. Six new descriptors with a TYPE "PKG",47,22,1,"PAH",1,1,4,0) of "DE" are added to the Catastrophic Disability REASONS file #27.17. "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") 11 "RTN","DGENA5") 0^11^B46261857 "RTN","DGENA5",1,0) DGENA5 ;ISA/Zoltan,ALB/CKN,TEJ - Enrollment API - CD Processing ;8/15/08 11:10am "RTN","DGENA5",2,0) ;;5.3;Registration;**232,688,850,894**;Aug 13, 1993;Build 48 "RTN","DGENA5",3,0) ;Phase II API's Related to Catastrophic Disability. "RTN","DGENA5",4,0) ; "RTN","DGENA5",5,0) ; The following variable names are used consistently in this routine: "RTN","DGENA5",6,0) ; DFN = IEN in PATIENT file (#2). "RTN","DGENA5",7,0) ; REASON = IEN in CATASTROPHIC DISABILITY REASONS file (#2). "RTN","DGENA5",8,0) ; COND = Sub-ien PATIENT(#2) CD STATUS CONDITIONS field (#.398). "RTN","DGENA5",9,0) ; SCORE = Score achieved by veteran on a test (#2, #.398, #1). "RTN","DGENA5",10,0) ; PERM = Permanent Indicator (#2, #.398, #2). "RTN","DGENA5",11,0) ; D2 = Secondary delimiter (optional.) "RTN","DGENA5",12,0) ; "RTN","DGENA5",13,0) ; Processing related to a patient (#2). "RTN","DGENA5",14,0) VCD(DFN) ; Veteran Catastrophically Disabled? (#.39) "RTN","DGENA5",15,0) Q $P($G(^DPT(DFN,.39)),"^",6) "RTN","DGENA5",16,0) CONDHELP(DFN,COND) ; Display help text for a condition. "RTN","DGENA5",17,0) ; Applies to the PATIENT file (#2) CD STATUS CONDITIONS field (#.398) "RTN","DGENA5",18,0) ; Note - Help text stored in 27.17 CD REASONS. "RTN","DGENA5",19,0) N REASON "RTN","DGENA5",20,0) S REASON=$$REASON(DFN,COND) "RTN","DGENA5",21,0) D HELP(REASON) "RTN","DGENA5",22,0) Q "RTN","DGENA5",23,0) CONDINP(DFN,COND,SCORE) ; Validate a score entered by the user for a PATIENT. "RTN","DGENA5",24,0) N REASON "RTN","DGENA5",25,0) S REASON=$$REASON(DFN,COND) "RTN","DGENA5",26,0) Q $$VALID(REASON,SCORE) "RTN","DGENA5",27,0) CONDMET(DFN,COND) ; Determine whether a condition meets the criteria. "RTN","DGENA5",28,0) N SCORE,PERM "RTN","DGENA5",29,0) S REASON=$$REASON(DFN,COND) "RTN","DGENA5",30,0) S SCORE=$$PATSCORE(DFN,COND) "RTN","DGENA5",31,0) S PERM=$$PATPERM(DFN,COND) "RTN","DGENA5",32,0) Q $$RANGEMET(REASON,SCORE,PERM) "RTN","DGENA5",33,0) ; Patient Field Lookup. "RTN","DGENA5",34,0) REASON(DFN,COND) ; Get the CD REASON for this patient, for this condition. "RTN","DGENA5",35,0) N REASON "RTN","DGENA5",36,0) I DFN=""!(COND="") D "RTN","DGENA5",37,0) . S REASON=$G(DGCDREAS) "RTN","DGENA5",38,0) . I REASON="",$G(ITEM)'="" S REASON=$G(DGCDIS("COND",ITEM)) "RTN","DGENA5",39,0) E S REASON=$P($G(^DPT(DFN,.398,COND,0)),"^",1) "RTN","DGENA5",40,0) Q REASON "RTN","DGENA5",41,0) PATSCORE(DFN,COND) ; Get the TEST SCORE for this patient, for this condition. "RTN","DGENA5",42,0) N REASON "RTN","DGENA5",43,0) I DFN=""!(COND="") Q "" "RTN","DGENA5",44,0) S REASON=$P($G(^DPT(DFN,.398,COND,0)),"^",2) "RTN","DGENA5",45,0) Q REASON "RTN","DGENA5",46,0) PATPERM(DFN,COND) ; Get the PERMANENT INDICATOR for this patient+condition. "RTN","DGENA5",47,0) N REASON "RTN","DGENA5",48,0) I DFN=""!(COND="") Q "" "RTN","DGENA5",49,0) S REASON=$P($G(^DPT(DFN,.398,COND,0)),"^",3) "RTN","DGENA5",50,0) Q REASON "RTN","DGENA5",51,0) ; Processing related to catastrophic disability reasons (#27.17) "RTN","DGENA5",52,0) HELP(REASON) ; Display help text from 27.17 CD REASONS. "RTN","DGENA5",53,0) N LINE "RTN","DGENA5",54,0) Q:$$TYPE(REASON)'="C" "RTN","DGENA5",55,0) S LINE=0 "RTN","DGENA5",56,0) W !,"HELP TEXT FOR ",$$NAME(REASON),! "RTN","DGENA5",57,0) F S LINE=$O(^DGEN(27.17,REASON,3,LINE)) Q:'LINE D "RTN","DGENA5",58,0) . W ?3,^DGEN(27.17,REASON,3,LINE,0),! "RTN","DGENA5",59,0) Q "RTN","DGENA5",60,0) VALID(REASON,SCORE) ; Validate a proposed score for a test. "RTN","DGENA5",61,0) N TEST,X "RTN","DGENA5",62,0) S TEST=$$VALSCORE(REASON) "RTN","DGENA5",63,0) S X=SCORE "RTN","DGENA5",64,0) I @TEST Q 1 "RTN","DGENA5",65,0) Q 0 "RTN","DGENA5",66,0) RANGEMET(REASON,SCORE,PERM) ; Determine whether this reason is satisfied. "RTN","DGENA5",67,0) N TEST "RTN","DGENA5",68,0) S TEST=$$RANGE(REASON) "RTN","DGENA5",69,0) I @TEST Q 1 "RTN","DGENA5",70,0) Q 0 "RTN","DGENA5",71,0) ; APIs to access CD REASONS file. "RTN","DGENA5",72,0) NAME(REASON) ; Return NAME (.01) for this CD REASON. "RTN","DGENA5",73,0) Q:'REASON "" "RTN","DGENA5",74,0) Q $P($G(^DGEN(27.17,REASON,0)),"^",1) "RTN","DGENA5",75,0) TYPE(REASON) ; Return TYPE (#1) for this CD REASON. "RTN","DGENA5",76,0) Q:'REASON "" "RTN","DGENA5",77,0) Q $P($G(^DGEN(27.17,REASON,0)),"^",2) "RTN","DGENA5",78,0) VALSCORE(REASON) ; Return VALIDATION (#7) for this CD REASON. "RTN","DGENA5",79,0) ; This determines whether a score is valid at all. "RTN","DGENA5",80,0) Q $G(^DGEN(27.17,REASON,4)) "RTN","DGENA5",81,0) RANGE(REASON) ; Return TEST SCORE RANGE (#5) for this CD REASON. "RTN","DGENA5",82,0) ; This determines whether the score qualifies for CD. "RTN","DGENA5",83,0) Q $G(^DGEN(27.17,REASON,2)) "RTN","DGENA5",84,0) FILENAME(REASON) ; Return the file name to which this CD Reason points. "RTN","DGENA5",85,0) N CODEPTR,DIC,DO "RTN","DGENA5",86,0) S U=$G(U,"^") "RTN","DGENA5",87,0) S CODEPTR=$$CODEPTR(REASON) "RTN","DGENA5",88,0) I CODEPTR="" Q "" "RTN","DGENA5",89,0) S DIC="^"_$P(CODEPTR,";",2) "RTN","DGENA5",90,0) S DIC(0)="" "RTN","DGENA5",91,0) D DO^DIC1 "RTN","DGENA5",92,0) Q $P(DO,"^",1) "RTN","DGENA5",93,0) CODE(REASON) ; Return the HL7 Transmission Code for this CD Reason. "RTN","DGENA5",94,0) Q:'REASON "" "RTN","DGENA5",95,0) Q $P($G(^DGEN(27.17,REASON,0)),"^",4) "RTN","DGENA5",96,0) CODENAME(REASON) ; Return name of code associated with this CD Reason. "RTN","DGENA5",97,0) N CODEPTR,CODEIEN,CODEGLO,CODEPC,CODENAME,CODE "RTN","DGENA5",98,0) S CODEPTR=$$CODEPTR(REASON) "RTN","DGENA5",99,0) I CODEPTR="" Q "" "RTN","DGENA5",100,0) S CODEIEN=$P(CODEPTR,";",1) "RTN","DGENA5",101,0) S CODEGLO=$P(CODEPTR,";",2) "RTN","DGENA5",102,0) S CODEPC=$S(CODEGLO="ICD9(":3,CODEGLO="ICD0(":4,CODEGLO="ICPT(":2) "RTN","DGENA5",103,0) S CODEGLO="^"_CODEGLO_CODEIEN_",0)" "RTN","DGENA5",104,0) S CODE=$P(@CODEGLO,"^",1) "RTN","DGENA5",105,0) S CODENAME=$P(@CODEGLO,"^",CODEPC) "RTN","DGENA5",106,0) Q CODENAME "RTN","DGENA5",107,0) CODEPTR(REASON) ; Internal label--get pointer to CODE. "RTN","DGENA5",108,0) Q $P($G(^DGEN(27.17,REASON,0)),"^",3) "RTN","DGENA5",109,0) LSCREEN(LIMBCODE) ; Used to validate LIMB in screen. "RTN","DGENA5",110,0) N REASON "RTN","DGENA5",111,0) S REASON="" "RTN","DGENA5",112,0) I $G(D0)=""!($G(D1)="") D "RTN","DGENA5",113,0) . S REASON=$G(DGCDREAS) "RTN","DGENA5",114,0) . I REASON="",$G(ITEM)'="" S REASON=$G(DGCDIS("PROC",ITEM)) "RTN","DGENA5",115,0) E S REASON=$P($G(^DPT(D0,.397,D1,0)),"^",1) "RTN","DGENA5",116,0) I REASON="" Q ".RUE.LUE.RLE.LLE.BLE.BLU."[("."_LIMBCODE_".") "RTN","DGENA5",117,0) Q $$LIMBOK(REASON,LIMBCODE) "RTN","DGENA5",118,0) LIMBOK(REASON,LIMBCODE) ; Return 1/0 Affected Extremity OK for this REASON. "RTN","DGENA5",119,0) N LIMBIEN,VALID "RTN","DGENA5",120,0) S VALID=0 "RTN","DGENA5",121,0) S LIMBIEN=0 "RTN","DGENA5",122,0) F S LIMBIEN=$$NEXTLIMB(REASON,LIMBIEN) Q:'LIMBIEN D Q:VALID "RTN","DGENA5",123,0) . I $$LIMBCODE(REASON,LIMBIEN)=LIMBCODE S VALID=1 "RTN","DGENA5",124,0) Q VALID "RTN","DGENA5",125,0) NEXTLIMB(REASON,LIMBIEN) ; Get next possible limb for this REASON. "RTN","DGENA5",126,0) I 'LIMBIEN S LIMBIEN=0 "RTN","DGENA5",127,0) S LIMBIEN=$O(^DGEN(27.17,REASON,1,LIMBIEN)) "RTN","DGENA5",128,0) I 'LIMBIEN S LIMBIEN="" "RTN","DGENA5",129,0) Q LIMBIEN "RTN","DGENA5",130,0) LIMBCODE(REASON,LIMBIEN) ; Return limb code for an affected limb. "RTN","DGENA5",131,0) Q $P($G(^DGEN(27.17,REASON,1,LIMBIEN,0)),"^",1) "RTN","DGENA5",132,0) ; HL7-related changes. "RTN","DGENA5",133,0) HL7TORSN(HL7VAL,D2) ; Return REASON IEN for a HL7 Transmission Value. "RTN","DGENA5",134,0) ; This function returns the IEN or 0 if there is none. "RTN","DGENA5",135,0) S D2=$S(11[$D(D2):D2,11[$D(HLECH):$E(HLECH),1:"~") "RTN","DGENA5",136,0) I $P("KATZ^FOLS^RUG3^FIM^GAF","^",$P(HL7VAL,D2,1))=$P(HL7VAL,D2,2) D "RTN","DGENA5",137,0) . S HL7VAL=$P("KATZ^FOLS^RUG3^FIM^GAF","^",+HL7VAL) "RTN","DGENA5",138,0) E S HL7VAL=$P(HL7VAL,D2) "RTN","DGENA5",139,0) Q:HL7VAL="" 0 "RTN","DGENA5",140,0) Q +$O(^DGEN(27.17,"C",HL7VAL,"")) "RTN","DGENA5",141,0) ; * check the new DESCRIPTOR seq - DG*5.3*894 "RTN","DGENA5",142,0) HL7TODSC(HL7VAL,D2) ; Return DESCRIPTOR IEN for a HL7 Transmission Value. "RTN","DGENA5",143,0) ; This function returns the IEN or 0 if there is none. "RTN","DGENA5",144,0) Q:HL7VAL="" 0 "RTN","DGENA5",145,0) Q +$O(^DGEN(27.17,"C",HL7VAL,"")) "RTN","DGENA5",146,0) RSNTOHL7(REASON,D2) ; Return HL7 Segment Value for this Reason. "RTN","DGENA5",147,0) Q:REASON="" 0 "RTN","DGENA5",148,0) S D2=$S(11[$D(D2):D2,11[$D(HLECH):$E(HLECH),1:"~") "RTN","DGENA5",149,0) N NAME,NUMBER,TABLE,FILE,CODE,HL7VAL "RTN","DGENA5",150,0) I $$TYPE(REASON)="C" D "RTN","DGENA5",151,0) . S CODE=$$CODE(REASON) "RTN","DGENA5",152,0) . Q:CODE="" "RTN","DGENA5",153,0) . S NUMBER=$L($P("KATZ^FOLS^RUG3^FIM^GAF^",CODE),"^") "RTN","DGENA5",154,0) . Q:NUMBER>5 "RTN","DGENA5",155,0) . S TABLE="VA0043" "RTN","DGENA5",156,0) . S HL7VAL=NUMBER_D2_CODE_D2_TABLE "RTN","DGENA5",157,0) E D "RTN","DGENA5",158,0) . S NAME=$$NAME(REASON) "RTN","DGENA5",159,0) . Q:NAME="" "RTN","DGENA5",160,0) . S CODE=$$CODE(REASON) "RTN","DGENA5",161,0) . Q:CODE="" "RTN","DGENA5",162,0) . S FILE=$$FILENAME(REASON) "RTN","DGENA5",163,0) . Q:FILE="" "RTN","DGENA5",164,0) . S HL7VAL=CODE_D2_NAME_D2_FILE "RTN","DGENA5",165,0) ; NOTE: an undefined variable error on the following line may "RTN","DGENA5",166,0) ; result, if someone has tampered with the CATASTROPHIC "RTN","DGENA5",167,0) ; DISABILITY REASONS file (#27.17). "RTN","DGENA5",168,0) Q HL7VAL "RTN","DGENA5",169,0) ; * check the new DESCRIPTOR seq - DG*5.3*894 "RTN","DGENA5",170,0) DSCR2HL7(DGDFN,D2) ; Return HL7 Sequence Value for all Descriptors. "RTN","DGENA5",171,0) S DG2=DGDFN "RTN","DGENA5",172,0) S DGHLENCD="~|\&" "RTN","DGENA5",173,0) K DGTMP,DSCRTOHL7 "RTN","DGENA5",174,0) M DGTMP=^DPT(DG2,.401) "RTN","DGENA5",175,0) I $D(DGTMP) S (I1,I2)=0 F S I1=$O(DGTMP(I1)),I2=I2+1 Q:+I1=0 S DG2717=+DGTMP(I1,0),$P(DSCRTOHL7,$E(DGHLENCD,2),I2)=$$TOHL7() "RTN","DGENA5",176,0) Q $G(DSCRTOHL7,0) "RTN","DGENA5",177,0) TOHL7() ; "RTN","DGENA5",178,0) I $P(^DGEN(27.17,DG2717,0),U,2)="DE" Q $P(^DGEN(27.17,DG2717,0),U,4) "RTN","DGENA5",179,0) Q -1 "RTN","DGENA5",180,0) ; "RTN","DGENA5",181,0) HLTOLIMB(HLVAL,D2) ; Convert HL7 transmission value to Limb code. "RTN","DGENA5",182,0) ; HLVAL = HL7 text of "Affected Extremity" code. "RTN","DGENA5",183,0) ; D2 = Secondary delimiter (for future expansion.) "RTN","DGENA5",184,0) ; NOTE: D2 Parameter is ignored at present, but may be "RTN","DGENA5",185,0) ; required in future if the sequence structure changes. "RTN","DGENA5",186,0) Q $P("RUE-RLE-LUE-LLE-BLE-BLU","-",+HLVAL) "RTN","DGENA5",187,0) LIMBTOHL(LIMB,D2) ; Convert Limb code to HL7 transmission value. "RTN","DGENA5",188,0) ; LIMB = Affected Extremity code: RUE = Right Upper Extremity; "RTN","DGENA5",189,0) ; LLE = Left Lower Extremity; also RLE and LUE. "RTN","DGENA5",190,0) ; D2 = Secondary Delimiter to use in this HL7 sequence. "RTN","DGENA5",191,0) S D2=$S(11[$D(D2):D2,11[$D(HLECH):$E(HLECH),1:"~") "RTN","DGENA5",192,0) N NUMBER,HLVAL "RTN","DGENA5",193,0) I "-RUE-RLE-LUE-LLE-BLE-BLU-"'[("-"_LIMB_"-")!(LIMB["-") Q "" "RTN","DGENA5",194,0) S NUMBER=$L($P("-RUE-RLE-LUE-LLE-BLE-BLU","-"_LIMB_"-"),"-") "RTN","DGENA5",195,0) S HLVAL=NUMBER_D2_LIMB_D2_"VA0042" "RTN","DGENA5",196,0) Q HLVAL "RTN","DGENA5",197,0) PERMTOHL(NUMBER,D2) ; Convert Permanent Status Indicator to HL7 sequence. "RTN","DGENA5",198,0) ; NUMBER = 1 for Permanent, 2 for Not Permanent, 3 for Unknown. "RTN","DGENA5",199,0) ; D2 = Secondary Delimiter to use in this HL7 sequence. "RTN","DGENA5",200,0) S D2=$S(11[$D(D2):D2,11[$D(HLECH):$E(HLECH),1:"~") "RTN","DGENA5",201,0) N PERM,HLVAL "RTN","DGENA5",202,0) S PERM=$P("PERMANENT-NOT PERMANENT-UNKNOWN","-",NUMBER) "RTN","DGENA5",203,0) I PERM="" Q "" "RTN","DGENA5",204,0) S HLVAL=NUMBER_D2_PERM_D2_"VA0045" "RTN","DGENA5",205,0) Q HLVAL "RTN","DGENA5",206,0) METH2HL7(METHOD,D2) ; Convert Method of Determination to HL7 Transmission Value. "RTN","DGENA5",207,0) S D2=$S(11[$D(D2):D2,11[$D(HLECH):$E(HLECH),1:"~") "RTN","DGENA5",208,0) N METHS "RTN","DGENA5",209,0) S METHS="AUTOMATED RECORD REVIEW^MEDICAL RECORD REVIEW^PHYSICAL EXAMINATION" "RTN","DGENA5",210,0) I ".1.2.3."'[("."_METHOD_".") Q "" "RTN","DGENA5",211,0) Q METHOD_D2_$P(METHS,"^",METHOD)_D2_"VA0041" "RTN","DGENA5",212,0) ; "RTN","DGENA5",213,0) ICDVER(CODESYS) ; DG*5.3*850 "RTN","DGENA5",214,0) ; determine if ICD-9 or ICD-10 CD should be used "RTN","DGENA5",215,0) ; To be used in DIC(S) call from input transforms from 2.396;.01 "RTN","DGENA5",216,0) ; and 2.397;.01 "RTN","DGENA5",217,0) ; Requires DA(1) be defined "RTN","DGENA5",218,0) ; output - the correct value in ICDIEN 9 "RTN","DGENA5",219,0) ; ^ICDS("C","10D",30)="" "RTN","DGENA5",220,0) ; ^ICDS("C","ICD",1)="" "RTN","DGENA5",221,0) ; "RTN","DGENA5",222,0) ; ^ICDS("C","10P",31)="" "RTN","DGENA5",223,0) ; ^ICDS("C","ICP",2)="" "RTN","DGENA5",224,0) ; -- DDATE := date of decision "RTN","DGENA5",225,0) ; DGar "RTN","DGENA5",226,0) ; DDCDIS(DATE) := date of decision from Listman Screen, not saved yet "RTN","DGENA5",227,0) ; "RTN","DGENA5",228,0) N DFN1,ICDIEN,DDATE,IMPDATE "RTN","DGENA5",229,0) S CODESYS=$S($G(CODESYS)="D":"10D",$G(CODESYS)="P":"10P",1:"10D") "RTN","DGENA5",230,0) S DFN1=$S($G(DA(1))'="":DA(1),$G(DFN)'="":DFN,1:"") "RTN","DGENA5",231,0) S DDATE=$P($G(^DPT(DFN1,.39)),"^",2) ;Date of decision "RTN","DGENA5",232,0) I $G(DGCDIS("DATE")) S DDATE=DGCDIS("DATE") ;called from code, date not stored yet "RTN","DGENA5",233,0) I DDATE="" S DDATE=DT "RTN","DGENA5",234,0) S IMPDATE=$P($$IMPDATE^DGPTIC10($G(CODESYS)),"^",1) "RTN","DGENA5",235,0) I CODESYS="10D" D "RTN","DGENA5",236,0) . I DDATE>> Catastrophic disability information not valid.<<< ",1:">>> "_ERROR_" <<<") "RTN","DGENCD",45,0) S DIR(0)="Y",DIR("A")="Try again",DIR("B")="YES" "RTN","DGENCD",46,0) D ^DIR "RTN","DGENCD",47,0) Q $S(Y=1:1,1:0) "RTN","DGENCD",48,0) ; "RTN","DGENCD",49,0) PATIENT() ; "RTN","DGENCD",50,0) ;Description: Asks user to select a patient. "RTN","DGENCD",51,0) ; "RTN","DGENCD",52,0) N DFN,QUIT "RTN","DGENCD",53,0) S (DFN,QUIT)="" "RTN","DGENCD",54,0) F D Q:(QUIT!DFN) "RTN","DGENCD",55,0) . D GETPAT^DGRPTU(,,.DFN) "RTN","DGENCD",56,0) . I '(DFN>0) S DFN="",QUIT=1 Q "RTN","DGENCD",57,0) . I DFN,'$$VET^DGENPTA(DFN) D "RTN","DGENCD",58,0) . . W !!,"Catastrophic disability can only be entered for eligible veterans!" "RTN","DGENCD",59,0) . . S DFN="" "RTN","DGENCD",60,0) Q DFN "RTN","DGENCD",61,0) ; "RTN","DGENCD",62,0) EDIT(DGCDIS) ; "RTN","DGENCD",63,0) ;Description: Allows user to enter values in DGCDIS array "RTN","DGENCD",64,0) ; which is passed by reference. "RTN","DGENCD",65,0) N SUB,OK,RESPONSE,FLST,EXIT,SUBEXIT,ITEM,FILENUM,FLDNUM,REQ,VAL "RTN","DGENCD",66,0) S OK=1 "RTN","DGENCD",67,0) F VAL="BY^1","DATE^1","REVDTE^1","METDET^1" D Q:'OK "RTN","DGENCD",68,0) . S SUB=$P(VAL,"^",1) "RTN","DGENCD",69,0) . S REQ=$P(VAL,"^",2) "RTN","DGENCD",70,0) . S FILENUM=$$FILE^DGENCDU(SUB) "RTN","DGENCD",71,0) . S FLDNUM=$$FLD^DGENCDU(SUB) "RTN","DGENCD",72,0) . I '$$PROMPT^DGENU(FILENUM,FLDNUM,DGCDIS(SUB),.RESPONSE,REQ) S OK=0 "RTN","DGENCD",73,0) . E D "RTN","DGENCD",74,0) . . I $P(VAL,"^",1)="BY" S RESPONSE=$$UPPER^DGUTL(RESPONSE) "RTN","DGENCD",75,0) . . S DGCDIS(SUB)=RESPONSE "RTN","DGENCD",76,0) I 'OK Q OK "RTN","DGENCD",77,0) S FLST="DESCR" D "RTN","DGENCD",78,0) . N LOOKUP "RTN","DGENCD",79,0) . S ITEM="",SUB=FLST "RTN","DGENCD",80,0) . F S ITEM=$O(DGCDIS(SUB,ITEM)) Q:ITEM="" S LOOKUP(DGCDIS(SUB,ITEM))=ITEM "RTN","DGENCD",81,0) . S EXIT=0 "RTN","DGENCD",82,0) . S ITEM=1 "RTN","DGENCD",83,0) . W ! "RTN","DGENCD",84,0) . F D Q:EXIT "RTN","DGENCD",85,0) . . S FILENUM=$$FILE^DGENCDU(SUB) "RTN","DGENCD",86,0) . . S FLDNUM=$$FLD^DGENCDU(SUB) "RTN","DGENCD",87,0) . . W ! "RTN","DGENCD",88,0) . . I '$$PROMPT^DGENU(FILENUM,FLDNUM,$G(DGCDIS(SUB,ITEM)),.RESPONSE,0),X="^" S RESPONSE=X "RTN","DGENCD",89,0) . . I X="@",$G(DGCDIS(SUB,ITEM)) K DGCDIS(SUB,ITEM) S EXIT=0,OK=1 D QEXIT Q "RTN","DGENCD",90,0) . . I RESPONSE="" N HIT S HIT=1 D I HIT W !!,"Must enter at least one CD Descriptor or ""^"" to exit" S EXIT=0,OK=1 D QEXIT Q "RTN","DGENCD",91,0) . . . N I F I=ITEM:-1:1 I $G(DGCDIS(SUB,I))'="" S HIT=0 Q "RTN","DGENCD",92,0) . . I SUB="DESCR",RESPONSE'="^",RESPONSE'="",$P(^DGEN(27.17,RESPONSE,0),U,4)=5,'$D(LOOKUP(RESPONSE)) I '$$CKDOAD S RESPONSE="",EXIT=0,OK=1 D QEXIT Q "RTN","DGENCD",93,0) . . I SUB="DESCR",$D(DGCDIS("DESCR")),$G(DGCDIS("DESCR",ITEM))'=RESPONSE N EXIT1,ENTRY S EXIT1=0 D I EXIT1 Q "RTN","DGENCD",94,0) . . . S ENTRY=0 F S ENTRY=$O(DGCDIS("DESCR",ENTRY)) Q:ENTRY="" D Q:EXIT1 "RTN","DGENCD",95,0) . . . . I DGCDIS("DESCR",ENTRY)=RESPONSE D "RTN","DGENCD",96,0) . . . . . W !!,"CD Descriptor previously selected, cannot select same CD Descriptor twice" "RTN","DGENCD",97,0) . . . . . S RESPONSE="",EXIT=0,OK=1,EXIT1=1 "RTN","DGENCD",98,0) . . . I EXIT1 D QEXIT "RTN","DGENCD",99,0) . . I RESPONSE="^"!(RESPONSE=""&$D(DGCDIS(SUB))) N ITEM,CNT D D:'CNT DELETE^DGENCDA1(DFN) Q "RTN","DGENCD",100,0) . . . S EXIT=1,OK=0 "RTN","DGENCD",101,0) . . . S (ITEM,CNT)="" "RTN","DGENCD",102,0) . . . F S ITEM=$O(DGCDIS(SUB,ITEM)) Q:ITEM="" D "RTN","DGENCD",103,0) . . . . I DGCDIS(SUB,ITEM)'=""&(DGCDIS(SUB,ITEM)'="^") S CNT=1 Q "RTN","DGENCD",104,0) . . . . I DGCDIS(SUB,ITEM)="" K DGCDIS(SUB,ITEM) Q "RTN","DGENCD",105,0) . . . . I DGCDIS(SUB,ITEM)="^" K DGCDIS(SUB,ITEM) "RTN","DGENCD",106,0) . . I RESPONSE'="",$D(LOOKUP(RESPONSE)) S ITEM=LOOKUP(RESPONSE) "RTN","DGENCD",107,0) . . E S ITEM=$O(DGCDIS(SUB,""),-1)+1,LOOKUP(RESPONSE)=ITEM "RTN","DGENCD",108,0) . . S DGCDIS(SUB,ITEM)=RESPONSE "RTN","DGENCD",109,0) . . S SUBEXIT=0 "RTN","DGENCD",110,0) . . S ITEM=ITEM+'SUBEXIT "RTN","DGENCD",111,0) I $D(DGCDIS("DESCR")) S DGCDIS("VCD")="Y",OK=1 W !!,"VETERAN IS CATASTROPHICALLY DISABLED",! "RTN","DGENCD",112,0) E I '$D(DGCDIS("DESCR")) D "RTN","DGENCD",113,0) . S DGCDIS("VCD")="N",OK=1 "RTN","DGENCD",114,0) . N I F I="BY","DATE","DTFACIRV","FACDET","METDET","REVDTE","VETREQDT" S DGCDIS(I)="" "RTN","DGENCD",115,0) . W !!,"VETERAN IS NOT CATASTROPHICALLY DISABLED",! "RTN","DGENCD",116,0) Q OK "RTN","DGENCD",117,0) ; "RTN","DGENCD",118,0) CKDOAD() ; Ask qualifying question if descriptor is AMPUTATION, DISARTICULATION OR DETACHMENT "RTN","DGENCD",119,0) N CK "RTN","DGENCD",120,0) F D Q:CK'="" "RTN","DGENCD",121,0) . W !,"Has the Amputation, Disarticulation or Detachment occurred on more " "RTN","DGENCD",122,0) . W !,"than one limb? " "RTN","DGENCD",123,0) . R CK:120 "RTN","DGENCD",124,0) . I CK["?" W !!,"Enter 'YES' or 'NO'.",! S CK="" Q "RTN","DGENCD",125,0) . S CK=$S($E(CK)="Y":1,$E(CK)="y":1,$E(CK)="N":0,$E(CK)="n":0,1:"") "RTN","DGENCD",126,0) I CK=0 W !!,"The Descriptor does not meet the criteria to be added." "RTN","DGENCD",127,0) Q CK "RTN","DGENCD",128,0) ; "RTN","DGENCD",129,0) QEXIT() ; sets an empty DGCDIS entry before exiting "RTN","DGENCD",130,0) S ITEM=$O(DGCDIS(SUB,ITEM)) "RTN","DGENCD",131,0) I ITEM="" S ITEM=$O(DGCDIS(SUB,""),-1)+1,DGCDIS(SUB,ITEM)="" "RTN","DGENCD",132,0) Q "RTN","DGENCD",133,0) ; "RTN","DGENCD",134,0) DBPROC() ; replaces input transform for CD Procedure "RTN","DGENCD",135,0) Q ($P(^DGEN(27.17,+Y,0),U,3)["ICPT")!($P(^DGEN(27.17,+Y,0),U,9)=$$ICDVER^DGENA5("P")) "RTN","DGENCD1") 0^2^B23998759 "RTN","DGENCD1",1,0) DGENCD1 ;ALB/CJM,Zoltan,PHH,BRM,DJS - Catastrophic Disability Protocols; 02/17/2005 "RTN","DGENCD1",2,0) ;;5.3;Registration;**121,232,387,451,610,894**;Aug 13,1993;Build 48 "RTN","DGENCD1",3,0) ; "RTN","DGENCD1",4,0) EN(DFN) ;Entry point for DGENCD CATASTROPHIC DISABILITY protocol "RTN","DGENCD1",5,0) D EN^DGENLCD(DFN) "RTN","DGENCD1",6,0) D:DFN BLD^DGENL "RTN","DGENCD1",7,0) Q "RTN","DGENCD1",8,0) ; "RTN","DGENCD1",9,0) ADDCD ;Entry point for DGENCD ADD/EDIT CATASTROPHIC DISABILITY protocol "RTN","DGENCD1",10,0) ; Input -- DFN Patient IEN "RTN","DGENCD1",11,0) ; Output -- VALMBCK R =Refresh screen "RTN","DGENCD1",12,0) N YN,EXIT,PRI,CDSITE "RTN","DGENCD1",13,0) S VALMBCK="",EXIT=0 "RTN","DGENCD1",14,0) D FULL^VALM1 "RTN","DGENCD1",15,0) I $$CDTYPE^DGENCDA(DFN) D ;was determination by physical exam? "RTN","DGENCD1",16,0) .S CDSITE=$$CHKSITE^DGENCDA(DFN) "RTN","DGENCD1",17,0) .I CDSITE D ;CD was determined by this site "RTN","DGENCD1",18,0) ..D BMES^XPDUTL("This veteran is currently determined to be Catastrophically") "RTN","DGENCD1",19,0) ..D MES^XPDUTL("Disabled. You may not change this evaluation unless it is due") "RTN","DGENCD1",20,0) ..D MES^XPDUTL("to an error in data entry.") "RTN","DGENCD1",21,0) ..S YN=$$YN("Is this edit due to an error in data entry") "RTN","DGENCD1",22,0) ..D:"N^"[$E($G(YN)) "RTN","DGENCD1",23,0) ...D BMES^XPDUTL("Additional CD evaluations are not necessary for this") "RTN","DGENCD1",24,0) ...D MES^XPDUTL("Veteran, as they are currently determined to be CD. If") "RTN","DGENCD1",25,0) ...D MES^XPDUTL("this is an edit due to an error, please return to the") "RTN","DGENCD1",26,0) ...D MES^XPDUTL("Add/Edit action and answer YES to this prompt.") "RTN","DGENCD1",27,0) ...S EXIT=1 "RTN","DGENCD1",28,0) .E D ; CD was determined by another site "RTN","DGENCD1",29,0) ..S SITEINF=$$NS^XUAF4($P(CDSITE,"^",2)) "RTN","DGENCD1",30,0) ..D BMES^XPDUTL("This Catastrophic Disability evaluation was entered at Site:"_$P(SITEINF,"^",2)) "RTN","DGENCD1",31,0) ..D MES^XPDUTL("Please Contact Site "_$P(SITEINF,"^")) "RTN","DGENCD1",32,0) ..D MES^XPDUTL("if it is necessary to edit this evaluation.") "RTN","DGENCD1",33,0) ..S EXIT=1 "RTN","DGENCD1",34,0) ..S DIR(0)="EA",DIR("A")="Press return to continue..." D ^DIR "RTN","DGENCD1",35,0) I EXIT S VALMBCK="R" Q "RTN","DGENCD1",36,0) ; "RTN","DGENCD1",37,0) S PRI=$$PRIORITY^DGENA(DFN) "RTN","DGENCD1",38,0) I PRI,PRI'>4 D "RTN","DGENCD1",39,0) . W:$X ! "RTN","DGENCD1",40,0) . W !,"According to the veteran's current enrollment record, the",! "RTN","DGENCD1",41,0) . W "assignment of a Catastrophically Disabled Status will not",! "RTN","DGENCD1",42,0) . W "improve his/her enrollment priority.",!! "RTN","DGENCD1",43,0) . S YN=$$YN("Do you still want to perform a review") "RTN","DGENCD1",44,0) . I "N^"[$E($G(YN)) S EXIT=1 "RTN","DGENCD1",45,0) I 'EXIT D EDITCD^DGENCD(DFN),INIT^DGENLCD "RTN","DGENCD1",46,0) S VALMBCK="R" "RTN","DGENCD1",47,0) Q "RTN","DGENCD1",48,0) ; "RTN","DGENCD1",49,0) DELETECD ;Entry point for DGENCD DELETE CATASTROPHIC DISABILITY protocol "RTN","DGENCD1",50,0) ; Input -- DFN Patient IEN "RTN","DGENCD1",51,0) ; Output -- VALMBCK R =Refresh screen "RTN","DGENCD1",52,0) N DGCDIS "RTN","DGENCD1",53,0) S VALMBCK="" "RTN","DGENCD1",54,0) D FULL^VALM1 "RTN","DGENCD1",55,0) I $$GET^DGENCDA(DFN,.DGCDIS),'$D(DGCDIS("DESCR")) D "RTN","DGENCD1",56,0) .W !!,">>> No Catastrophic Disabilities exist for this veteran.<<<" "RTN","DGENCD1",57,0) .W !!,"VETERAN IS NOT CATASTROPHICALLY DISABLED" "RTN","DGENCD1",58,0) .S DIR(0)="EA",DIR("A")="Press return to continue..." D ^DIR "RTN","DGENCD1",59,0) .S DGCDIS("VCD")="N" "RTN","DGENCD1",60,0) .N I F I="BY","DATE","DTFACIRV","FACDET","METDET","REVDTE","VETREQDT" S DGCDIS(I)="" ; DG*5.3*894 "RTN","DGENCD1",61,0) E D "RTN","DGENCD1",62,0) .I $$RUSURE(DFN) D "RTN","DGENCD1",63,0) . . S DGCDIS("VCD")="N" "RTN","DGENCD1",64,0) . . N I,ERROR "RTN","DGENCD1",65,0) . . F I="BY","DATE","DTFACIRV","FACDET","METDET","REVDTE","VETREQDT" S DGCDIS(I)="" ; DG*5.3*894 "RTN","DGENCD1",66,0) . . F I=1:1 Q:'$D(DGCDIS("DESCR",I)) K DGCDIS("DESCR",I) "RTN","DGENCD1",67,0) . . I $$STORE^DGENCDA2(DFN,.DGCDIS,.ERROR) "RTN","DGENCD1",68,0) D INIT^DGENLCD "RTN","DGENCD1",69,0) S VALMBCK="R" "RTN","DGENCD1",70,0) Q "RTN","DGENCD1",71,0) ; "RTN","DGENCD1",72,0) RUSURE(DFN) ; "RTN","DGENCD1",73,0) ;Description: Asks user 'Are you sure?' "RTN","DGENCD1",74,0) ;Input: DFN is the patient ien "RTN","DGENCD1",75,0) ;Output: Function Value returns 0 or 1 "RTN","DGENCD1",76,0) ; "RTN","DGENCD1",77,0) N DIR,SITE,SITEINF,DIROUT,DIRUT,DTOUT,DUOUT,NOERR "RTN","DGENCD1",78,0) S SITE=$$CHKSITE^DGENCDA(DFN) "RTN","DGENCD1",79,0) I '$P(SITE,"^") D Q 0 ;CD was not determined at this site "RTN","DGENCD1",80,0) .S SITEINF=$$NS^XUAF4($P(SITE,"^",2)) "RTN","DGENCD1",81,0) .D BMES^XPDUTL("This Catastrophic Disability evaluation was entered at Site:"_$P(SITEINF,"^",2)) "RTN","DGENCD1",82,0) .D MES^XPDUTL("Please Contact Site "_$P(SITEINF,"^")) "RTN","DGENCD1",83,0) .D MES^XPDUTL("if it is necessary to delete this evaluation.") "RTN","DGENCD1",84,0) .S DIR(0)="EA",DIR("A")="Press return to continue..." D ^DIR "RTN","DGENCD1",85,0) ; was this entered in error? "RTN","DGENCD1",86,0) I $$CDTYPE^DGENCDA(DFN) D Q:$G(NOERR) 0 "RTN","DGENCD1",87,0) .D BMES^XPDUTL("This Veteran is currently determined to be Catastrophically Disabled, you") "RTN","DGENCD1",88,0) .D MES^XPDUTL("may not delete this evaluation unless it is due to an error in data entry.") "RTN","DGENCD1",89,0) .S DIR(0)="Y",DIR("B")="NO" "RTN","DGENCD1",90,0) .S DIR("A")="Is this deletion due to an error in data entry" "RTN","DGENCD1",91,0) .D ^DIR "RTN","DGENCD1",92,0) .I $G(DIRUT)!$G(DUOUT)!$G(DIROUT)!$G(DTOUT)!('$G(Y)) S NOERR=1 "RTN","DGENCD1",93,0) .K DIR,Y "RTN","DGENCD1",94,0) ; "RTN","DGENCD1",95,0) S DIR(0)="Y" "RTN","DGENCD1",96,0) S DIR("A")="Are you sure that the Catastrophic Disability should be deleted" "RTN","DGENCD1",97,0) S DIR("B")="NO" "RTN","DGENCD1",98,0) I $$HASCAT^DGENCDA(DFN) D "RTN","DGENCD1",99,0) . W !!,">>> Deleting the Catastrophic Disability information will <<<",! "RTN","DGENCD1",100,0) . W ">>> also delete all supporting fields, including Descriptors. <<<",! "RTN","DGENCD1",101,0) D ^DIR "RTN","DGENCD1",102,0) Q:$D(DIRUT) 0 "RTN","DGENCD1",103,0) Q Y "RTN","DGENCD1",104,0) ; "RTN","DGENCD1",105,0) YN(PROMPT,DFLT) ; Ask user a yes/no question. "RTN","DGENCD1",106,0) S DFLT=$E($G(DFLT,"N")) "RTN","DGENCD1",107,0) N YN,%,%Y "RTN","DGENCD1",108,0) F D Q:"YN^"[YN "RTN","DGENCD1",109,0) . W PROMPT "RTN","DGENCD1",110,0) . S %=$S(DFLT="N":2,DFLT="Y":1,1:0) "RTN","DGENCD1",111,0) . D YN^DICN "RTN","DGENCD1",112,0) . W ! "RTN","DGENCD1",113,0) . S YN=$S(%=-1:"^",%=1:"Y",%=2:"N",1:"?") "RTN","DGENCD1",114,0) . I YN["?" W ?5,"You can just enter 'Y' or 'N'.",!! "RTN","DGENCD1",115,0) Q YN "RTN","DGENCDA") 0^3^B9760076 "RTN","DGENCDA",1,0) DGENCDA ;ALB/CJM,Zoltan,JAN,BRM,TDM,DJS - Catastrophic Disability API - Retrieve Data;May 24, 1999;Nov 14, 2001 ; 9/19/05 11:35am "RTN","DGENCDA",2,0) ;;5.3;Registration;**121,147,232,387,451,653,894**;Aug 13,1993;Build 48 "RTN","DGENCDA",3,0) ; "RTN","DGENCDA",4,0) ; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions. "RTN","DGENCDA",5,0) ; "RTN","DGENCDA",6,0) GET(DFN,DGCDIS) ; "RTN","DGENCDA",7,0) ;Description: Get catastrophic disability information for a patient "RTN","DGENCDA",8,0) ;Input: "RTN","DGENCDA",9,0) ; DFN - Patient IEN "RTN","DGENCDA",10,0) ;Output: "RTN","DGENCDA",11,0) ; DGCDIS - the catastrophic disability array, passed by reference "RTN","DGENCDA",12,0) ; subscripts: "RTN","DGENCDA",13,0) ; "BY" Decided By "RTN","DGENCDA",14,0) ; "DATE" Date of Decision "RTN","DGENCDA",15,0) ; "FACDET" Facility Making Determination "RTN","DGENCDA",16,0) ; "REVDTE" Review Date "RTN","DGENCDA",17,0) ; "VETREQDT" Date Veteran Requested CD Evaluation "RTN","DGENCDA",18,0) ; "DTFACIRV" Date Facility Initiated Review "RTN","DGENCDA",19,0) ; "DTVETNOT" Date Veteran Was Notified "RTN","DGENCDA",20,0) ; "RTN","DGENCDA",21,0) N SUB,ITEM,SITEM,SIEN,IND "RTN","DGENCDA",22,0) K DGCDIS S DGCDIS="" "RTN","DGENCDA",23,0) I '$G(DFN) D Q 0 "RTN","DGENCDA",24,0) . F SUB="VCD","BY","DATE","FACDET","REVDTE","METDET","VETREQDT","DTFACIRV","DTVETNOT" S DGCDIS(SUB)="" "RTN","DGENCDA",25,0) ; .39 VETERAN CATASTROPHICALLY DISABLED? field. "RTN","DGENCDA",26,0) S DGCDIS("VCD")=$P($G(^DPT(DFN,.39)),"^",6) "RTN","DGENCDA",27,0) ; .391 DECIDED BY field. "RTN","DGENCDA",28,0) S DGCDIS("BY")=$P($G(^DPT(DFN,.39)),"^",1) "RTN","DGENCDA",29,0) ; .392 DATE OF DECISION field. "RTN","DGENCDA",30,0) S DGCDIS("DATE")=$P($G(^DPT(DFN,.39)),"^",2) "RTN","DGENCDA",31,0) ; .393 FACILITY MAKING DETERMINATION field. "RTN","DGENCDA",32,0) S DGCDIS("FACDET")=$P($G(^DPT(DFN,.39)),"^",3) "RTN","DGENCDA",33,0) ; .394 REVIEW DATE field. "RTN","DGENCDA",34,0) S DGCDIS("REVDTE")=$P($G(^DPT(DFN,.39)),"^",4) "RTN","DGENCDA",35,0) ; .395 METHOD OF DETERMINATION field. "RTN","DGENCDA",36,0) S DGCDIS("METDET")=$P($G(^DPT(DFN,.39)),"^",5) "RTN","DGENCDA",37,0) ; .3951 DATE VETERAN REQUESTED CD EVAL "RTN","DGENCDA",38,0) S DGCDIS("VETREQDT")=$P($G(^DPT(DFN,.39)),"^",7) "RTN","DGENCDA",39,0) ; .3952 DATE FACILITY INITIATED REVIEW "RTN","DGENCDA",40,0) S DGCDIS("DTFACIRV")=$P($G(^DPT(DFN,.39)),"^",8) "RTN","DGENCDA",41,0) ; .3953 DATE VETERAN WAS NOTIFIED "RTN","DGENCDA",42,0) S DGCDIS("DTVETNOT")=$P($G(^DPT(DFN,.39)),"^",9) "RTN","DGENCDA",43,0) S SIEN=0 "RTN","DGENCDA",44,0) F ITEM=1:1 S SIEN=$O(^DPT(DFN,.396,SIEN)) Q:'SIEN D "RTN","DGENCDA",45,0) . ; .01 CD STATUS DIAGNOSES sub-field. "RTN","DGENCDA",46,0) . S DGCDIS("DIAG",ITEM)=$P($G(^DPT(DFN,.396,SIEN,0)),"^",1) "RTN","DGENCDA",47,0) ; .397 CD STATUS PROCEDURES field (multiple): "RTN","DGENCDA",48,0) S (ITEM,SITEM,SIEN)=0 "RTN","DGENCDA",49,0) F S ITEM=$O(^DPT(DFN,.397,"B",ITEM)) Q:'ITEM D "RTN","DGENCDA",50,0) . S IND=0,SIEN=SIEN+1 "RTN","DGENCDA",51,0) . F S SITEM=$O(^DPT(DFN,.397,"B",ITEM,SITEM)) Q:'SITEM D "RTN","DGENCDA",52,0) . . ; .01 CD STATUS PROCEDURES sub-field. "RTN","DGENCDA",53,0) . . S DGCDIS("PROC",SIEN)=$P($G(^DPT(DFN,.397,SITEM,0)),"^",1) "RTN","DGENCDA",54,0) . . ; 1 AFFECTED EXTREMITY sub-field. "RTN","DGENCDA",55,0) . . S DGCDIS("EXT",SIEN)=$P($G(^DPT(DFN,.397,SITEM,0)),"^",2) "RTN","DGENCDA",56,0) . . S IND=IND+1,DGCDIS("EXT",SIEN,IND)=$P($G(^DPT(DFN,.397,SITEM,0)),"^",2) "RTN","DGENCDA",57,0) ; - .398 CD STATUS CONDITIONS field (multiple): "RTN","DGENCDA",58,0) S SIEN=0 "RTN","DGENCDA",59,0) F ITEM=1:1 S SIEN=$O(^DPT(DFN,.398,SIEN)) Q:'SIEN D "RTN","DGENCDA",60,0) . ; .01 CD STATUS CONDITIONS sub-field. "RTN","DGENCDA",61,0) . S DGCDIS("COND",ITEM)=$P($G(^DPT(DFN,.398,SIEN,0)),"^",1) "RTN","DGENCDA",62,0) . ; 1 SCORE sub-field. "RTN","DGENCDA",63,0) . S DGCDIS("SCORE",ITEM)=$P($G(^DPT(DFN,.398,SIEN,0)),"^",2) "RTN","DGENCDA",64,0) . ; 2 PERMANENT INDICATOR sub-field. "RTN","DGENCDA",65,0) . S DGCDIS("PERM",ITEM)=$P($G(^DPT(DFN,.398,SIEN,0)),"^",3) "RTN","DGENCDA",66,0) S SIEN=0 "RTN","DGENCDA",67,0) F ITEM=1:1 S SIEN=$O(^DPT(DFN,.401,SIEN)) Q:'SIEN D ;DG*5.3*894 "RTN","DGENCDA",68,0) . ; .401 CD DESCRIPTORS field (multiple): "RTN","DGENCDA",69,0) . S DGCDIS("DESCR",ITEM)=$P($G(^DPT(DFN,.401,SIEN,0)),"^",1) "RTN","DGENCDA",70,0) Q 1 "RTN","DGENCDA",71,0) ; "RTN","DGENCDA",72,0) DISABLED(DFN) ; "RTN","DGENCDA",73,0) ;Description: Returns whether the patient is catastrophically disabled. "RTN","DGENCDA",74,0) ; "RTN","DGENCDA",75,0) ;Input: "RTN","DGENCDA",76,0) ; DFN - Patient IEN "RTN","DGENCDA",77,0) ;Output: "RTN","DGENCDA",78,0) ; Function Value - returns 1 if the patient is catastrophically "RTN","DGENCDA",79,0) ; disabled, otherwise 0 "RTN","DGENCDA",80,0) ; "RTN","DGENCDA",81,0) Q $$HASCAT(DFN) "RTN","DGENCDA",82,0) ; "RTN","DGENCDA",83,0) HASCAT(DFN) ; "RTN","DGENCDA",84,0) ;Description: returns 1 if the patient is CATASTROPHICALLY DISABLED "RTN","DGENCDA",85,0) ; "RTN","DGENCDA",86,0) Q:'$G(DFN) 0 "RTN","DGENCDA",87,0) Q $P($G(^DPT(DFN,.39)),"^",6)="Y" "RTN","DGENCDA",88,0) ; "RTN","DGENCDA",89,0) CHKSITE(DFN) ;is this the facility that made the CD determination? "RTN","DGENCDA",90,0) ; "RTN","DGENCDA",91,0) ;Input: "RTN","DGENCDA",92,0) ; DFN - Patient IEN "RTN","DGENCDA",93,0) ;Output: "RTN","DGENCDA",94,0) ; Function Value - returns 1 if CD evaluation was entered at local "RTN","DGENCDA",95,0) ; site, otherwise 0^SITE # "RTN","DGENCDA",96,0) ; "RTN","DGENCDA",97,0) Q:'$G(DFN) 0 "RTN","DGENCDA",98,0) N SITE "RTN","DGENCDA",99,0) S SITE=$$SITE^VASITE "RTN","DGENCDA",100,0) Q:$P($G(^DPT(DFN,.39)),"^",3)=$P(SITE,"^") 1 "RTN","DGENCDA",101,0) Q "0^"_$P($G(^DPT(DFN,.39)),"^",3) "RTN","DGENCDA",102,0) ; "RTN","DGENCDA",103,0) CDTYPE(DFN) ; Was the method of determination "Physical Exam"? "RTN","DGENCDA",104,0) ; "RTN","DGENCDA",105,0) ;Input: "RTN","DGENCDA",106,0) ; DFN - Patient IEN "RTN","DGENCDA",107,0) ;Output: "RTN","DGENCDA",108,0) ; Function Value - returns 1 if CD='Yes' & Method='Physical Exam' "RTN","DGENCDA",109,0) ; otherwise 0 "RTN","DGENCDA",110,0) ; "RTN","DGENCDA",111,0) Q:'$G(DFN) 0 "RTN","DGENCDA",112,0) Q:'$$HASCAT(DFN) 0 "RTN","DGENCDA",113,0) Q $P($G(^DPT(DFN,.39)),"^",5)=3 "RTN","DGENCDA",114,0) ; "RTN","DGENCDA1") 0^4^B44873485 "RTN","DGENCDA1",1,0) DGENCDA1 ;ALB/CJM,RMM Zoltan,JAN,PHH,BRM,CKN,DJS - Catastrophic Disabilty API - File Data;Sep 16, 2002 ; 9/22/05 5:25pm "RTN","DGENCDA1",2,0) ;;5.3;Registration;**121,147,232,302,356,387,475,451,653,894**;Aug 13,1993;Build 48 "RTN","DGENCDA1",3,0) ; "RTN","DGENCDA1",4,0) ; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions. "RTN","DGENCDA1",5,0) ; "RTN","DGENCDA1",6,0) LOCK(DFN) ; "RTN","DGENCDA1",7,0) ;Description: Locks the catastrophic disability record for a patient "RTN","DGENCDA1",8,0) ;Input: "RTN","DGENCDA1",9,0) ; DFN - Patient IEN "RTN","DGENCDA1",10,0) ;Output: "RTN","DGENCDA1",11,0) ; Function Value - returns 1 if the patient is catastrophic disability "RTN","DGENCDA1",12,0) ; record can be locked, otherwise 0 "RTN","DGENCDA1",13,0) I $G(DFN) L +^DPT(DFN,.39):2 "RTN","DGENCDA1",14,0) Q $T "RTN","DGENCDA1",15,0) ; "RTN","DGENCDA1",16,0) UNLOCK(DFN) ; "RTN","DGENCDA1",17,0) ;Description: Unlocks the catastrophic disability record for a patient "RTN","DGENCDA1",18,0) ;Input: "RTN","DGENCDA1",19,0) ; DFN - Patient IEN "RTN","DGENCDA1",20,0) ;Output: "RTN","DGENCDA1",21,0) ; None "RTN","DGENCDA1",22,0) I $G(DFN) L -^DPT(DFN,.39) "RTN","DGENCDA1",23,0) Q "RTN","DGENCDA1",24,0) ; "RTN","DGENCDA1",25,0) CHECK(DGCDIS,ERROR) ; "RTN","DGENCDA1",26,0) ;Description: Validity checks on the catastrophic disability contained "RTN","DGENCDA1",27,0) ; in the DGCDIS array "RTN","DGENCDA1",28,0) ;Input: "RTN","DGENCDA1",29,0) ; DGCDIS - the catastrophic disability array, passed by reference "RTN","DGENCDA1",30,0) ;Output: "RTN","DGENCDA1",31,0) ; Function Value - returns 1 if validation checks passed, 0 otherwise "RTN","DGENCDA1",32,0) ; ERROR - if validation fails an error mssg is returned, pass by "RTN","DGENCDA1",33,0) ; reference "RTN","DGENCDA1",34,0) N VALID,RESULT,EXTERNAL,ITEM,EIEN,EXIT,OK,ISCD,POP,FLD "RTN","DGENCDA1",35,0) S ERROR="" "RTN","DGENCDA1",36,0) Q:DGCDIS("VCD")="@" 1 ;this is a deletion "RTN","DGENCDA1",37,0) Q:DGCDIS("VCD")="N" 1 ;NO value for VCD "RTN","DGENCDA1",38,0) D ;drops out of block if invalid condition found "RTN","DGENCDA1",39,0) . S VALID=0 ; Usually invalid if it exits early. "RTN","DGENCDA1",40,0) . ; CD Flag must have a value if any other CD field is populated "RTN","DGENCDA1",41,0) . S POP=0 "RTN","DGENCDA1",42,0) . I DGCDIS("VCD")="" D Q:POP "RTN","DGENCDA1",43,0) . . F FLD="BY","DATE","FACDET","REVDTE","METDET" D Q:POP "RTN","DGENCDA1",44,0) . . . I $G(DGCDIS(FLD))]"" S POP=1 "RTN","DGENCDA1",45,0) . . I POP S ERROR="'VETERAN CATASTROPHICALLY DISABLED?' FIELD MUST HAVE A RESPONSE" Q "RTN","DGENCDA1",46,0) . ; Decided by. "RTN","DGENCDA1",47,0) . I DGCDIS("VCD")'="",$G(DGCDIS("BY"))="" S ERROR="CATASTROPHIC DISABILITY 'DECIDED BY' REQUIRED" Q "RTN","DGENCDA1",48,0) . I $G(DGCDIS("BY"))'="",($L(DGCDIS("BY"))<3)!($L(DGCDIS("BY"))>35) S ERROR="CATASTROPHIC DISABILITY 'DECIDED BY' NOT VALID" Q "RTN","DGENCDA1",49,0) . I $$UPPER^DGUTL($G(DGCDIS("BY")))="HINQ" S ERROR="CATASTROPHIC DISABILITY 'DECIDED BY' CAN NOT BE 'HINQ'" Q "RTN","DGENCDA1",50,0) . ; Date of Decision "RTN","DGENCDA1",51,0) . S OK=1,EXTERNAL="" "RTN","DGENCDA1",52,0) . I DGCDIS("VCD")'="",$G(DGCDIS("DATE"))="" S ERROR="'DATE OF CATASTOPHIC DISABILITY DECISION' REQUIRED" Q "RTN","DGENCDA1",53,0) . I $G(DGCDIS("DATE"))'="" D "RTN","DGENCDA1",54,0) . . I 'DGCDIS("DATE") S OK=0 Q "RTN","DGENCDA1",55,0) . . S EXTERNAL=$$EXTERNAL^DILFD(2,.392,"",DGCDIS("DATE")) "RTN","DGENCDA1",56,0) . . I EXTERNAL="" S OK=0 "RTN","DGENCDA1",57,0) . . D CHK^DIE(2,.392,,EXTERNAL,.RESULT) "RTN","DGENCDA1",58,0) . . I RESULT="^" S OK=0 "RTN","DGENCDA1",59,0) . I 'OK S ERROR="'DATE OF CATASTOPHIC DISABILITY DECISION' NOT VALID" Q "RTN","DGENCDA1",60,0) . ; Facility Making Determination. "RTN","DGENCDA1",61,0) . I DGCDIS("VCD")'=""!(DGCDIS("FACDET")'=""),$$EXTERNAL^DILFD(2,.393,"",$G(DGCDIS("FACDET")))="" S ERROR="'FACILITY MAKING CATASTROPHIC DISABILITY DETERMINATION' NOT VALID" Q "RTN","DGENCDA1",62,0) . ; Review Date "RTN","DGENCDA1",63,0) . I DGCDIS("VCD")'="",$G(DGCDIS("REVDTE"))="" S ERROR="'CATASTROPHIC DISABILITY REVIEW DATE' REQUIRED" Q "RTN","DGENCDA1",64,0) . I DGCDIS("REVDTE")'="" D Q:ERROR'="" "RTN","DGENCDA1",65,0) . . S EXTERNAL=$$EXTERNAL^DILFD(2,.394,"",DGCDIS("REVDTE")) "RTN","DGENCDA1",66,0) . . I EXTERNAL="" S ERROR="'CATASTROPHIC DISABILITY REVIEW DATE' NOT VALID" Q "RTN","DGENCDA1",67,0) . . D CHK^DIE(2,.394,,EXTERNAL,.RESULT) "RTN","DGENCDA1",68,0) . . I RESULT="^" S ERROR="'CATASTROPHIC DISABILTY REVIEW DATE' INVALID" Q "RTN","DGENCDA1",69,0) . . I $G(DGCDIS("DATE")),DGCDIS("REVDTE")>DGCDIS("DATE") S ERROR="'CD REVIEW DATE' GREATER THAN 'CD DATE OF DETERMINATION'." Q "RTN","DGENCDA1",70,0) . ; Method of Determination "RTN","DGENCDA1",71,0) . I $G(DGCDIS("METDET"))="",DGCDIS("VCD")'="" S ERROR="'METHOD OF DETERMINATION' IS A REQUIRED VALUE." Q "RTN","DGENCDA1",72,0) . I "..2.3."'[("."_$G(DGCDIS("METDET"))_".") S ERROR="'METHOD OF DETERMINATION' NOT VALID" Q "RTN","DGENCDA1",73,0) . S ITEM="",EXIT=0 "RTN","DGENCDA1",74,0) . ; Descriptor "RTN","DGENCDA1",75,0) . F S ITEM=$O(DGCDIS("DESCR",ITEM)) Q:'ITEM Q:EXIT D "RTN","DGENCDA1",76,0) . . I DGCDIS("DESCR",ITEM)="" Q "RTN","DGENCDA1",77,0) . . I $$TYPE^DGENA5(DGCDIS("DESCR",ITEM))'="DE" S EXIT=1,ERROR="'CD DESCRIPTOR' NOT VALID" "RTN","DGENCDA1",78,0) . Q:EXIT "RTN","DGENCDA1",79,0) . ; Diagnoses "RTN","DGENCDA1",80,0) . F S ITEM=$O(DGCDIS("DIAG",ITEM)) Q:'ITEM Q:EXIT D "RTN","DGENCDA1",81,0) . . I DGCDIS("DIAG",ITEM)="" Q "RTN","DGENCDA1",82,0) . . I $$TYPE^DGENA5(DGCDIS("DIAG",ITEM))'="D" S EXIT=1,ERROR="'CD STATUS DIAGNOSES' NOT VALID" "RTN","DGENCDA1",83,0) . Q:EXIT "RTN","DGENCDA1",84,0) . ; Procedures "RTN","DGENCDA1",85,0) . F S ITEM=$O(DGCDIS("PROC",ITEM)) Q:'ITEM Q:EXIT D "RTN","DGENCDA1",86,0) . . I DGCDIS("PROC",ITEM)="" Q "RTN","DGENCDA1",87,0) . . I $$TYPE^DGENA5(DGCDIS("PROC",ITEM))'="P" S EXIT=1,ERROR="'CD STATUS PROCEDURE' NOT VALID" Q "RTN","DGENCDA1",88,0) . . S EIEN="" F S EIEN=$O(DGCDIS("EXT",ITEM,EIEN)) Q:EIEN="" D "RTN","DGENCDA1",89,0) . . . I '$$LIMBOK^DGENA5(DGCDIS("PROC",ITEM),DGCDIS("EXT",ITEM,EIEN)) S EXIT=1,ERROR="'CD STATUS AFFECTED EXTREMITY' INVALID" "RTN","DGENCDA1",90,0) . Q:EXIT "RTN","DGENCDA1",91,0) . ; Conditions "RTN","DGENCDA1",92,0) . F S ITEM=$O(DGCDIS("COND",ITEM)) Q:'ITEM Q:EXIT D "RTN","DGENCDA1",93,0) . . I DGCDIS("COND",ITEM)="" Q "RTN","DGENCDA1",94,0) . . I $$TYPE^DGENA5(DGCDIS("COND",ITEM))'="C" S EXIT=1,ERROR="'' NOT VALID" Q "RTN","DGENCDA1",95,0) . . I '$$VALID^DGENA5(DGCDIS("COND",ITEM),DGCDIS("SCORE",ITEM)) S EXIT=1,ERROR="'CD CONDITION SCORE' NOT VALID" Q "RTN","DGENCDA1",96,0) . . I ".1.2.3."'[("."_DGCDIS("PERM",ITEM)_".") S ERROR="'PERMANENT STATUS INDICATOR' NOT VALID" Q "RTN","DGENCDA1",97,0) . Q:EXIT "RTN","DGENCDA1",98,0) . ; No reason present? "RTN","DGENCDA1",99,0) . I DGCDIS("VCD")="Y",('$D(DGCDIS("DESCR"))&('$D(DGCDIS("DIAG")))&('$D(DGCDIS("PROC")))&('$D(DGCDIS("COND")))) S ERROR="'CD REASON' NOT PRESENT" Q "RTN","DGENCDA1",100,0) . S VALID=1 "RTN","DGENCDA1",101,0) Q VALID "RTN","DGENCDA1",102,0) ; "RTN","DGENCDA1",103,0) ISCD(DGCDIS) ; Returns 1/0, is the patient CD? "RTN","DGENCDA1",104,0) ; DGCDIS("DESCR",N)=CD REASON for Descriptor. "RTN","DGENCDA1",105,0) ; DGCDIS("DIAG",N)=CD REASON for Diagnosis. "RTN","DGENCDA1",106,0) ; DGCDIS("COND",N)=CD REASON for Condition. "RTN","DGENCDA1",107,0) ; DGCDIS("SCORE",N)=SCORE (for condition.) "RTN","DGENCDA1",108,0) ; DGCDIS("PERM",N)=Permanent Indicator (for condition). "RTN","DGENCDA1",109,0) ; DGCDIS("PROC",N)=CD REASON for procedure. "RTN","DGENCDA1",110,0) ; DGCDIS("EXT",N)=Affected Extremity (for procedure.) "RTN","DGENCDA1",111,0) N CD S CD=0 ; True if patient is CD. "RTN","DGENCDA1",112,0) N SUB,LIMB,LCODE,EXT,LIEN,EXCLUDE "RTN","DGENCDA1",113,0) S SUB="" "RTN","DGENCDA1",114,0) ; DG*5.3*894 - Add Descriptor "RTN","DGENCDA1",115,0) F S SUB=$O(DGCDIS("DESCR",SUB)) Q:SUB="" D "RTN","DGENCDA1",116,0) . I $$TYPE^DGENA5($G(DGCDIS("DESCR",SUB)))'="DE" Q "RTN","DGENCDA1",117,0) . S CD=CD+1 "RTN","DGENCDA1",118,0) F S SUB=$O(DGCDIS("DIAG",SUB)) Q:SUB="" D "RTN","DGENCDA1",119,0) . I $$TYPE^DGENA5($G(DGCDIS("DIAG",SUB)))'="D" Q "RTN","DGENCDA1",120,0) . S CD=CD+1 "RTN","DGENCDA1",121,0) F S SUB=$O(DGCDIS("PROC",SUB)) Q:SUB="" D "RTN","DGENCDA1",122,0) . I $$TYPE^DGENA5($G(DGCDIS("PROC",SUB)))'="P" Q "RTN","DGENCDA1",123,0) . S LCODE=0 "RTN","DGENCDA1",124,0) . F S LCODE=$O(DGCDIS("EXT",SUB,LCODE)) Q:'LCODE D "RTN","DGENCDA1",125,0) . . S EXT=DGCDIS("EXT",SUB,LCODE) "RTN","DGENCDA1",126,0) . . Q:EXT="" "RTN","DGENCDA1",127,0) . . S LIEN=$O(^DGEN(27.17,DGCDIS("PROC",SUB),1,"B",EXT,0)) "RTN","DGENCDA1",128,0) . . Q:LIEN="" "RTN","DGENCDA1",129,0) . . S LIMB=$$LIMBCODE^DGENA5(DGCDIS("PROC",SUB),LIEN) "RTN","DGENCDA1",130,0) . . I LIMB'=EXT Q "RTN","DGENCDA1",131,0) . . I $D(EXCLUDE(SUB,LIMB)) Q "RTN","DGENCDA1",132,0) . . S EXCLUDE(SUB,LIMB)="" "RTN","DGENCDA1",133,0) . . S CD=CD+.5 "RTN","DGENCDA1",134,0) F S SUB=$O(DGCDIS("COND",SUB)) Q:SUB="" D "RTN","DGENCDA1",135,0) . I $$TYPE^DGENA5($G(DGCDIS("COND",SUB)))'="C" Q "RTN","DGENCDA1",136,0) . I '$$RANGEMET^DGENA5(DGCDIS("COND",SUB),DGCDIS("SCORE",SUB),DGCDIS("PERM",SUB)) Q "RTN","DGENCDA1",137,0) . S CD=CD+1 "RTN","DGENCDA1",138,0) S CD=(CD'<1) "RTN","DGENCDA1",139,0) Q CD "RTN","DGENCDA1",140,0) ; "RTN","DGENCDA1",141,0) ERRDISP(FILE) ; Display error. "RTN","DGENCDA1",142,0) N LINE "RTN","DGENCDA1",143,0) S LINE=0 "RTN","DGENCDA1",144,0) W:$X ! "RTN","DGENCDA1",145,0) W "ERROR updating ",$S(FILE=2.401:"CD DESCRIPTORS",FILE=2.399!(FILE=2.409):"CD HISTORY",1:"PATIENT CD DATA"),! "RTN","DGENCDA1",146,0) F S LINE=$O(DGCDERR("DIERR",1,"TEXT",LINE)) Q:'LINE W ?5,DGCDERR("DIERR",1,"TEXT",LINE),! "RTN","DGENCDA1",147,0) W ! "RTN","DGENCDA1",148,0) Q "RTN","DGENCDA1",149,0) ; "RTN","DGENCDA1",150,0) DELETE(DFN) ; "RTN","DGENCDA1",151,0) ;Description: Delete a catastrophic disability record for a patient "RTN","DGENCDA1",152,0) ;Input: "RTN","DGENCDA1",153,0) ; DFN - Patient IEN "RTN","DGENCDA1",154,0) ;Output: "RTN","DGENCDA1",155,0) ; Function Value - returns 1 if successful, otherwise 0 "RTN","DGENCDA1",156,0) N SUCCESS,DIK,DA "RTN","DGENCDA1",157,0) S SUCCESS=1 "RTN","DGENCDA1",158,0) D ;drops out if invalid condition found "RTN","DGENCDA1",159,0) . I $G(DFN),$D(^DPT(DFN,0)) "RTN","DGENCDA1",160,0) . E S SUCCESS=0 Q "RTN","DGENCDA1",161,0) . I '$$LOCK(DFN) S SUCCESS=0 Q "RTN","DGENCDA1",162,0) . ; "RTN","DGENCDA1",163,0) . N DA,DIK "RTN","DGENCDA1",164,0) . S DA(1)=DFN "RTN","DGENCDA1",165,0) . S DA=.39 "RTN","DGENCDA1",166,0) . S DIK="^DPT("_DFN_","_DA_"," "RTN","DGENCDA1",167,0) . D ^DIK "RTN","DGENCDA1",168,0) . ; "RTN","DGENCDA1",169,0) . N SIEN,SUBFILE "RTN","DGENCDA1",170,0) . F SUBFILE=.401,.396,.397,.398 I $D(^DPT(DFN,SUBFILE)) D "RTN","DGENCDA1",171,0) . . S SIEN=0 "RTN","DGENCDA1",172,0) . . F S SIEN=$O(^DPT(DFN,SUBFILE,SIEN)) Q:SIEN="" Q:SIEN'?.N D "RTN","DGENCDA1",173,0) . . . N DA,DIK "RTN","DGENCDA1",174,0) . . . S DA=SIEN "RTN","DGENCDA1",175,0) . . . S DA(1)=DFN "RTN","DGENCDA1",176,0) . . . S DIK="^DPT("_DFN_","_SUBFILE_"," "RTN","DGENCDA1",177,0) . . . D ^DIK "RTN","DGENCDA1",178,0) . ; "RTN","DGENCDA1",179,0) . N DA,DIK "RTN","DGENCDA1",180,0) . S DA(1)=DFN "RTN","DGENCDA1",181,0) . S DA=2.401 "RTN","DGENCDA1",182,0) . S DIK="^DPT("_DFN_"," "RTN","DGENCDA1",183,0) . D ^DIK "RTN","DGENCDA1",184,0) . ; Note -- CD HISTORY field (#.399) must not be deleted. "RTN","DGENCDA1",185,0) D UNLOCK(DFN) "RTN","DGENCDA1",186,0) Q SUCCESS "RTN","DGENCDA1",187,0) ; "RTN","DGENCDA2") 0^5^B12005626 "RTN","DGENCDA2",1,0) DGENCDA2 ;ALB/CJM,ISA/KWP,Zoltan,JAN,CKN,TGH - Catastrophic Disability API - File Data;May 24, 1999 "RTN","DGENCDA2",2,0) ;;5.3;Registration;**232,387,653,850,894**;Aug 13,1993;Build 48 "RTN","DGENCDA2",3,0) ; "RTN","DGENCDA2",4,0) ; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions. "RTN","DGENCDA2",5,0) ; "RTN","DGENCDA2",6,0) STORE(DFN,DGCDIS,ERROR) ; "RTN","DGENCDA2",7,0) ;Description: Creates a catastrophic disability record for a patient. "RTN","DGENCDA2",8,0) ; Attempts to add catastrophically disabled eligibility code. "RTN","DGENCDA2",9,0) ;Input: "RTN","DGENCDA2",10,0) ; DFN - Patient IEN "RTN","DGENCDA2",11,0) ; DGCDIS - the catastrophic disability array, passed by reference "RTN","DGENCDA2",12,0) ;Output: "RTN","DGENCDA2",13,0) ; Function Value - returns 1 if successful, otherwise 0 "RTN","DGENCDA2",14,0) ; ERROR - if not successful, an error message is returned,pass "RTN","DGENCDA2",15,0) ; by reference "RTN","DGENCDA2",16,0) N SUCCESS,FDA,SUB,HIEN,HSUB,FDB,NIEN,EIEN,DGCDERR "RTN","DGENCDA2",17,0) S SUCCESS=1 "RTN","DGENCDA2",18,0) S ERROR="" "RTN","DGENCDA2",19,0) I DGCDIS("VCD")="N" N I F I="BY","DATE","DTFACIRV","FACDET","METDET","REVDTE","VETREQDT" S DGCD(I)="" ; DG*5.3*894 "RTN","DGENCDA2",20,0) D ;drops out if invalid condition found "RTN","DGENCDA2",21,0) . I $G(DFN),$D(^DPT(DFN,0)) "RTN","DGENCDA2",22,0) . E S SUCCESS=0,ERROR="PATIENT NOT FOUND" Q "RTN","DGENCDA2",23,0) . I '$$LOCK^DGENCDA1(DFN) S SUCCESS=0,ERROR="RECORD IN USE, CAN NOT BE EDITED" Q "RTN","DGENCDA2",24,0) . I '$$CHECK^DGENCDA1(.DGCDIS,.ERROR) S SUCCESS=0 Q "RTN","DGENCDA2",25,0) . S HIEN=$P($G(^DPT(DFN,.399,0)),"^",3)+1 "RTN","DGENCDA2",26,0) . S HIEN=HIEN_","_DFN_"," "RTN","DGENCDA2",27,0) . S FDA(2,DFN_",",.39)=DGCDIS("VCD") "RTN","DGENCDA2",28,0) . S FDB(2.399,HIEN,.39)=DGCDIS("VCD") "RTN","DGENCDA2",29,0) . S FDA(2,DFN_",",.391)=DGCDIS("BY") "RTN","DGENCDA2",30,0) . S FDB(2.399,HIEN,.391)=DGCDIS("BY") "RTN","DGENCDA2",31,0) . S FDA(2,DFN_",",.392)=DGCDIS("DATE") "RTN","DGENCDA2",32,0) . S FDB(2.399,HIEN,.392)=DGCDIS("DATE") "RTN","DGENCDA2",33,0) . S FDA(2,DFN_",",.393)=DGCDIS("FACDET") "RTN","DGENCDA2",34,0) . S FDB(2.399,HIEN,.393)=DGCDIS("FACDET") "RTN","DGENCDA2",35,0) . S FDA(2,DFN_",",.394)=DGCDIS("REVDTE") "RTN","DGENCDA2",36,0) . S FDB(2.399,HIEN,.394)=DGCDIS("REVDTE") "RTN","DGENCDA2",37,0) . S FDA(2,DFN_",",.395)=DGCDIS("METDET") "RTN","DGENCDA2",38,0) . S FDB(2.399,HIEN,.395)=DGCDIS("METDET") "RTN","DGENCDA2",39,0) . S FDA(2,DFN_",",.3951)=DGCDIS("VETREQDT") "RTN","DGENCDA2",40,0) . S FDB(2.399,HIEN,.3951)=DGCDIS("VETREQDT") "RTN","DGENCDA2",41,0) . S FDA(2,DFN_",",.3952)=DGCDIS("DTFACIRV") "RTN","DGENCDA2",42,0) . S FDB(2.399,HIEN,.3952)=DGCDIS("DTFACIRV") "RTN","DGENCDA2",43,0) . S FDA(2,DFN_",",.3953)=DGCDIS("DTVETNOT") "RTN","DGENCDA2",44,0) . S FDB(2.399,HIEN,.3953)=DGCDIS("DTVETNOT") "RTN","DGENCDA2",45,0) . S SUB="",HSUB=0 "RTN","DGENCDA2",46,0) . S NIEN=0 F S SUB=$O(DGCDIS("DESCR",SUB)) Q:'SUB D "RTN","DGENCDA2",47,0) . . I DGCDIS("DESCR",SUB)="" Q "RTN","DGENCDA2",48,0) . . S NIEN=NIEN+1 "RTN","DGENCDA2",49,0) . . S FDB(2.401,NIEN_","_DFN_",",.01)=DGCDIS("DESCR",SUB) "RTN","DGENCDA2",50,0) . . S HSUB=HSUB+1 "RTN","DGENCDA2",51,0) . . S FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("DESCR",SUB) "RTN","DGENCDA2",52,0) . S FDB(2.399,HIEN,.01)=$$NOW^XLFDT "RTN","DGENCDA2",53,0) I SUCCESS D "RTN","DGENCDA2",54,0) . N SUBFDA,SUBFILE,IENS "RTN","DGENCDA2",55,0) . S SUCCESS=$$DELETE^DGENCDA1(DFN) "RTN","DGENCDA2",56,0) . Q:'SUCCESS "RTN","DGENCDA2",57,0) . D UPDATE^DIE("","FDA","","DGCDERR") "RTN","DGENCDA2",58,0) . I $G(DGCDERR) D Q "RTN","DGENCDA2",59,0) . . S ERROR="FILEMAN UNABLE TO PERFORM UPDATE" "RTN","DGENCDA2",60,0) . . S SUCCESS=0 "RTN","DGENCDA2",61,0) . . D ERRDISP^DGENCDA1(2) "RTN","DGENCDA2",62,0) . S SUBFILE="" "RTN","DGENCDA2",63,0) . S ERROR="FILEMAN UPDATE FAILED FOR " "RTN","DGENCDA2",64,0) . F S SUBFILE=$O(FDB(SUBFILE)) Q:SUBFILE="" D Q:'SUCCESS "RTN","DGENCDA2",65,0) . . N IEN,NODE,ITEM "RTN","DGENCDA2",66,0) . . S IEN="" "RTN","DGENCDA2",67,0) . . F ITEM=0:1 S IEN=$O(FDB(SUBFILE,IEN)) Q:'IEN D Q:'SUCCESS "RTN","DGENCDA2",68,0) . . . N DIC,Y,DO,DD,DINUM,DA,NODE "RTN","DGENCDA2",69,0) . . . I SUBFILE'=2.409 D "RTN","DGENCDA2",70,0) . . . . S NODE=SUBFILE-2 "RTN","DGENCDA2",71,0) . . . . S DIC("P")=$P($G(^DD(2,SUBFILE-2,0)),"^",2) "RTN","DGENCDA2",72,0) . . . . S DA(1)=DFN "RTN","DGENCDA2",73,0) . . . E D "RTN","DGENCDA2",74,0) . . . . S NODE=".399,"_$P(IEN,",",2)_",1" "RTN","DGENCDA2",75,0) . . . . S DIC("P")=$P($G(^DD(2.399,.396,0)),"^",2) "RTN","DGENCDA2",76,0) . . . . S DA(1)=$P(IEN,",",2),DA(2)=DFN "RTN","DGENCDA2",77,0) . . . S DIC="^DPT("_DFN_","_NODE_"," "RTN","DGENCDA2",78,0) . . . S DIC(0)="L" "RTN","DGENCDA2",79,0) . . . S X=FDB(SUBFILE,IEN,.01) "RTN","DGENCDA2",80,0) . . . S DINUM=+IEN "RTN","DGENCDA2",81,0) . . . D FILE^DICN "RTN","DGENCDA2",82,0) . . . I Y=-1 S ERROR="FAILED TO ADD ENTRY TO #"_SUBFILE,SUCCESS=0 "RTN","DGENCDA2",83,0) . . Q:'SUCCESS "RTN","DGENCDA2",84,0) . . K SUBFDA "RTN","DGENCDA2",85,0) . . M SUBFDA(SUBFILE)=FDB(SUBFILE) "RTN","DGENCDA2",86,0) . . D FILE^DIE("","SUBFDA","DGCDERR") "RTN","DGENCDA2",87,0) . . I $G(DIERR) D "RTN","DGENCDA2",88,0) . . . S ERROR=ERROR_" #"_SUBFILE "RTN","DGENCDA2",89,0) . . . S SUCCESS=0 "RTN","DGENCDA2",90,0) . . . D ERRDISP^DGENCDA1(SUBFILE) "RTN","DGENCDA2",91,0) . I SUCCESS S ERROR="" "RTN","DGENCDA2",92,0) D CLEAN^DILF "RTN","DGENCDA2",93,0) D UNLOCK^DGENCDA1(DFN) "RTN","DGENCDA2",94,0) Q SUCCESS "RTN","DGENCDU") 0^7^B2645954 "RTN","DGENCDU",1,0) DGENCDU ;ALB/CJM,Zoltan,TGH - Catastrophic Disability Utilities;May 24, 1999 "RTN","DGENCDU",2,0) ;;5.3;Registration;**121,232,894**;Aug 13,1993;Build 48 "RTN","DGENCDU",3,0) ; "RTN","DGENCDU",4,0) ; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions. "RTN","DGENCDU",5,0) ; "RTN","DGENCDU",6,0) EXT(SUB,VAL) ; "RTN","DGENCDU",7,0) ;Description: Given the subscript used in the Catastrophic Disability "RTN","DGENCDU",8,0) ; array and a field value, returns the external representation of the "RTN","DGENCDU",9,0) ; value, as defined in the fields output transform of the PATIENT "RTN","DGENCDU",10,0) ; file. "RTN","DGENCDU",11,0) ;Input: "RTN","DGENCDU",12,0) ; SUB - array subscript defined for the Catastrophic Disability object "RTN","DGENCDU",13,0) ; VAL - field value "RTN","DGENCDU",14,0) ;Output: "RTN","DGENCDU",15,0) ; Function Value - returns the external value of the field "RTN","DGENCDU",16,0) ; "RTN","DGENCDU",17,0) Q:$G(SUB)=""!($G(VAL)="")!($G(SUB)[";") "" "RTN","DGENCDU",18,0) ; "RTN","DGENCDU",19,0) N FLD,FILE "RTN","DGENCDU",20,0) S FLD=$$FLD(SUB) "RTN","DGENCDU",21,0) Q:FLD="" "" "RTN","DGENCDU",22,0) S FILE=$$FILE(SUB) "RTN","DGENCDU",23,0) Q:FILE="" "" "RTN","DGENCDU",24,0) Q $$EXTERNAL^DILFD(FILE,FLD,"F",VAL) "RTN","DGENCDU",25,0) FILE(SUB) ; Return file/subfile number associated with this subscript. "RTN","DGENCDU",26,0) ; SUB = text subscript (such as VCD, BY, DATE, FACDET, etc.) "RTN","DGENCDU",27,0) N SUBLST,FLDLST,FILELST,FILE,PC "RTN","DGENCDU",28,0) D SETVARS "RTN","DGENCDU",29,0) S SUB=";"_SUB_";" "RTN","DGENCDU",30,0) I SUBLST'[SUB Q "" "RTN","DGENCDU",31,0) S PC=$L($P(SUBLST,SUB),";") "RTN","DGENCDU",32,0) S FILE=$P(FILELST,";",PC) "RTN","DGENCDU",33,0) Q FILE "RTN","DGENCDU",34,0) FLD(SUB) ; Return field/subfield number associated with this subscript. "RTN","DGENCDU",35,0) ; SUB = text subscript (such as VCD, BY, DATE, FACDET, etc.) "RTN","DGENCDU",36,0) N SUBLST,FLDLST,FILELST,FLD,PC "RTN","DGENCDU",37,0) D SETVARS "RTN","DGENCDU",38,0) S SUB=";"_SUB_";" "RTN","DGENCDU",39,0) I SUBLST'[SUB Q "" "RTN","DGENCDU",40,0) S PC=$L($P(SUBLST,SUB),";") "RTN","DGENCDU",41,0) S FLD=$P(FLDLST,";",PC) "RTN","DGENCDU",42,0) Q FLD "RTN","DGENCDU",43,0) SUB(FLD,FILE) ; Return subscript for this field (and file) number. "RTN","DGENCDU",44,0) S:'$G(FILE) FILE=2 "RTN","DGENCDU",45,0) N SUBLST,FLDLST,FILELST,PC,SUB "RTN","DGENCDU",46,0) D SETVARS "RTN","DGENCDU",47,0) F PC=1:1:$L(FLDLST,";") I $P(FLDLST,";",PC)=FLD,$P(FILELST,";",PC)=FILE S SUB=$P(SUBLST,";",PC+1) Q "RTN","DGENCDU",48,0) Q SUB "RTN","DGENCDU",49,0) SETVARS ; NOTE -- for easy future maintenance, just modify the following 3 variables. "RTN","DGENCDU",50,0) S SUBLST=";VCD;BY;DATE;FACDET;REVDTE;METDET;DESCR;" "RTN","DGENCDU",51,0) S FILELST="2;2;2;2;2;2;2.401" "RTN","DGENCDU",52,0) S FLDLST=".39;.391;.392;.393;.394;.395;.01" "RTN","DGENCDU",53,0) Q "RTN","DGENLCD1") 0^6^B11542351 "RTN","DGENLCD1",1,0) DGENLCD1 ;ALB/CJM,Zoltan,JAN,TGH - Enrollment Catastrophic Disability- Build List Area;13 JUN 1997 "RTN","DGENLCD1",2,0) ;;5.3;Registration;**121,232,387,850,894**;Aug 13,1993;Build 48 "RTN","DGENLCD1",3,0) ; "RTN","DGENLCD1",4,0) ; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions. "RTN","DGENLCD1",5,0) ; "RTN","DGENLCD1",6,0) EN(DGARY,DFN,DGCNT) ;Entry point to build list area "RTN","DGENLCD1",7,0) ; Input -- DGARY Global array subscript "RTN","DGENLCD1",8,0) ; DFN Patient IEN "RTN","DGENLCD1",9,0) ; Output -- DGCNT Number of lines in the list "RTN","DGENLCD1",10,0) N DGCDIS,DGLINE "RTN","DGENLCD1",11,0) I $$GET^DGENCDA(DFN,.DGCDIS) ;set-up catastrophic disability array "RTN","DGENLCD1",12,0) S DGLINE=1,DGCNT=0 "RTN","DGENLCD1",13,0) D CD(DGARY,DFN,.DGCDIS,.DGLINE,.DGCNT) "RTN","DGENLCD1",14,0) Q "RTN","DGENLCD1",15,0) ; "RTN","DGENLCD1",16,0) CD(DGARY,DFN,DGCDIS,DGLINE,DGCNT) ; "RTN","DGENLCD1",17,0) ;Description: Writes Catastrophic Disabilty info to list. "RTN","DGENLCD1",18,0) ; Input -- DGARY Global array subscript "RTN","DGENLCD1",19,0) ; DFN Patient IEN "RTN","DGENLCD1",20,0) ; DGCDIS Enrollment array "RTN","DGENLCD1",21,0) ; DGLINE Line number "RTN","DGENLCD1",22,0) ; Output -- DGCNT Number of lines in the list "RTN","DGENLCD1",23,0) N DGSTART,HASCAT,PERM "RTN","DGENLCD1",24,0) ; "RTN","DGENLCD1",25,0) S DGSTART=DGLINE ; starting line number "RTN","DGENLCD1",26,0) D SET^DGENL1(DGARY,DGLINE," Catastrophic Disability ",28,IORVON,IORVOFF,,,,.DGCNT) "RTN","DGENLCD1",27,0) S DGLINE=DGLINE+2 "RTN","DGENLCD1",28,0) S HASCAT=$$HASCAT^DGENCDA(DFN) "RTN","DGENLCD1",29,0) D SET^DGENL1(DGARY,DGLINE,$J("Veteran Catastrophically Disabled: ",41)_$S(HASCAT:"YES",1:"NO"),1,,,,,,.DGCNT) "RTN","DGENLCD1",30,0) ; "RTN","DGENLCD1",31,0) S DGLINE=DGLINE+1 "RTN","DGENLCD1",32,0) D SET^DGENL1(DGARY,DGLINE,$J("Date of Decision: ",41)_$$EXT^DGENCDU("DATE",DGCDIS("DATE")),1,,,,,,.DGCNT) "RTN","DGENLCD1",33,0) S DGLINE=DGLINE+1 "RTN","DGENLCD1",34,0) D SET^DGENL1(DGARY,DGLINE,$J("Decided By: ",41)_$$EXT^DGENCDU("BY",DGCDIS("BY")),1,,,,,,.DGCNT) "RTN","DGENLCD1",35,0) S DGLINE=DGLINE+1 "RTN","DGENLCD1",36,0) D SET^DGENL1(DGARY,DGLINE,$J("Facility Making Determination: ",41)_$$EXT^DGENCDU("FACDET",DGCDIS("FACDET")),1,,,,,,.DGCNT) "RTN","DGENLCD1",37,0) S DGLINE=DGLINE+1 "RTN","DGENLCD1",38,0) D SET^DGENL1(DGARY,DGLINE,$J("Review Date: ",41)_$$EXT^DGENCDU("REVDTE",DGCDIS("REVDTE")),1,,,,,,.DGCNT) "RTN","DGENLCD1",39,0) S DGLINE=DGLINE+1 "RTN","DGENLCD1",40,0) D SET^DGENL1(DGARY,DGLINE,$J("Method of Determination: ",41)_$$EXT^DGENCDU("METDET",DGCDIS("METDET")),1,,,,,,.DGCNT) "RTN","DGENLCD1",41,0) ; "RTN","DGENLCD1",42,0) ; Display reasons for CD Determination. "RTN","DGENLCD1",43,0) I '$D(DGCDIS("DESCR")) Q "RTN","DGENLCD1",44,0) S DGLINE=DGLINE+2 "RTN","DGENLCD1",45,0) D SET^DGENL1(DGARY,DGLINE," Reason(s) for CD Determination ",24,IORVON,IORVOFF,,,,.DGCNT) "RTN","DGENLCD1",46,0) S DGLINE=DGLINE+1 "RTN","DGENLCD1",47,0) S (ITEM,SUBITEM)="" "RTN","DGENLCD1",48,0) F S ITEM=$O(DGCDIS("DESCR",ITEM)) Q:ITEM="" D "RTN","DGENLCD1",49,0) . S DGLINE=DGLINE+1 "RTN","DGENLCD1",50,0) . D SET^DGENL1(DGARY,DGLINE,$J("CD Descriptor: ",25)_$$EXT^DGENCDU("DESCR",DGCDIS("DESCR",ITEM)),1,,,,,,.DGCNT) "RTN","DGENLCD1",51,0) Q "RTN","DGENLCD1",52,0) ; "RTN","DGENLCD1",53,0) DISP(Y) ; Patch DG*5.3*850 "RTN","DGENLCD1",54,0) ;called from 2.396 and 2.397 output transform, input y, output y "RTN","DGENLCD1",55,0) N DFN,NODE,TYPE,LONG,OUTPUT,DDATE,IMPDATE,ICDVER "RTN","DGENLCD1",56,0) S DFN=$S($G(DA(1))'="":DA(1),$G(DFN)'="":DFN,1:"") "RTN","DGENLCD1",57,0) S NODE=$G(^DGEN(27.17,+Y,0)),LONG=$G(^DGEN(27.17,+Y,5)) "RTN","DGENLCD1",58,0) S TYPE=$P(NODE,U,2) "RTN","DGENLCD1",59,0) I DFN="" Q $P(NODE,U,1) "RTN","DGENLCD1",60,0) ; "RTN","DGENLCD1",61,0) S DDATE=$P($G(^DPT(DFN,.39)),"^",2) ;Date of decision "RTN","DGENLCD1",62,0) I $G(DGCDIS("DATE")) S DDATE=DGCDIS("DATE") "RTN","DGENLCD1",63,0) I DDATE="" S DDATE=DT "RTN","DGENLCD1",64,0) S IMPDATE=$P($$IMPDATE^DGPTIC10($G(CODESYS)),"^",1) "RTN","DGENLCD1",65,0) S ICDVER=$S(DDATE"N",1->"Y" "RTN","DGENUPL1",123,0) ; "1/0" - "Y"->1,"N"->0 "RTN","DGENUPL1",124,0) ; "INSTITUTION" - needs to convert the station number with suffix to a point to the INSTITUTION file "RTN","DGENUPL1",125,0) ; "ELIGIBILITY" - VAL is a pointer to the national eligibility code file (#8.1), needs to be converted to a local eligibility code (file #8) "RTN","DGENUPL1",126,0) ; "RTN","DGENUPL1",127,0) ; "MT" - VAL is a Means Test Status code, it needs to be converted "RTN","DGENUPL1",128,0) ; to a pointer to the Means Test Status file "RTN","DGENUPL1",129,0) ; Phase II convert code to RSN IEN for DGCDIS object "RTN","DGENUPL1",130,0) ; "CDRSN" data type converts the codes diagnosis,procedure,condition to RSN IEN. (HL7TORSN^DGENA5) "RTN","DGENUPL1",131,0) ; "CDDSCR" data type converts the codes descriptor(s) to DSCR IEN. (HL7TODSC^DGENA5) DG*5.3*894 "RTN","DGENUPL1",132,0) ; "EXT" convert from code to abbreviation "RTN","DGENUPL1",133,0) ; "POS" convert from Period of Service code to a point to Period of Service file "RTN","DGENUPL1",134,0) ; "AGENCY" convert Agency/Allied Country code from file 35 "RTN","DGENUPL1",135,0) ; "PENSIONCD" convert Pension Award/Termination Reason code from file 27.18 "RTN","DGENUPL1",136,0) ;OUTPUT: "RTN","DGENUPL1",137,0) ; Function Value - the result of the conversion "RTN","DGENUPL1",138,0) ; ERROR - set to 1 if an error is detected, 0 otherwise (optional,pass by ref) "RTN","DGENUPL1",139,0) S ERROR=0 "RTN","DGENUPL1",140,0) D "RTN","DGENUPL1",141,0) .I VAL="" Q "RTN","DGENUPL1",142,0) .I VAL="""""" S VAL="@" Q "RTN","DGENUPL1",143,0) .I $G(DATATYPE)="EXT" D Q "RTN","DGENUPL1",144,0) ..S VAL=$$HLTOLIMB^DGENA5(VAL) "RTN","DGENUPL1",145,0) .I $G(DATATYPE)="CDRSN" D Q "RTN","DGENUPL1",146,0) ..S VAL=$$HL7TORSN^DGENA5(VAL) "RTN","DGENUPL1",147,0) .; * check the new DESCRIPTOR seq - DG*5.3*894 "RTN","DGENUPL1",148,0) .I $G(DATATYPE)="CDDSCR" D Q "RTN","DGENUPL1",149,0) ..S VAL=$$HL7TODSC^DGENA5(VAL) "RTN","DGENUPL1",150,0) .I ($G(DATATYPE)="MT") D Q "RTN","DGENUPL1",151,0) ..S VAL=$O(^DG(408.32,"AC",1,VAL,0)) "RTN","DGENUPL1",152,0) ..I 'VAL S ERROR=1 "RTN","DGENUPL1",153,0) .I ($G(DATATYPE)="DATE") D Q "RTN","DGENUPL1",154,0) ..I $L(VAL)'=8 S ERROR=1 Q "RTN","DGENUPL1",155,0) ..S VAL=$$FMDATE^HLFNC(VAL) "RTN","DGENUPL1",156,0) ..I ((VAL'=+VAL)!($L($P(VAL,"."))<7)) S ERROR=1 "RTN","DGENUPL1",157,0) .I ($G(DATATYPE)="TS") D Q "RTN","DGENUPL1",158,0) ..I $L(VAL)<8 S ERROR=1 Q "RTN","DGENUPL1",159,0) ..S VAL=$$FMDATE^HLFNC(VAL) "RTN","DGENUPL1",160,0) ..I ((VAL'=+VAL)!($L($P(VAL,"."))<7)) S ERROR=1 "RTN","DGENUPL1",161,0) .I ($G(DATATYPE)="Y/N") D Q "RTN","DGENUPL1",162,0) ..I VAL=0 S VAL="N" Q "RTN","DGENUPL1",163,0) ..I VAL=1 S VAL="Y" Q "RTN","DGENUPL1",164,0) ..S ERROR=1 "RTN","DGENUPL1",165,0) .I ($G(DATATYPE)="1/0") D Q "RTN","DGENUPL1",166,0) ..I VAL="N" S VAL=0 Q "RTN","DGENUPL1",167,0) ..I VAL="Y" S VAL=1 Q "RTN","DGENUPL1",168,0) ..S ERROR=1 "RTN","DGENUPL1",169,0) .I ($G(DATATYPE)="ELIGIBILITY") D Q "RTN","DGENUPL1",170,0) ..S VAL=$$MAP(VAL) "RTN","DGENUPL1",171,0) ..I 'VAL S ERROR=1 "RTN","DGENUPL1",172,0) .I ($G(DATATYPE)="INSTITUTION") D Q "RTN","DGENUPL1",173,0) ..N OLDVAL "RTN","DGENUPL1",174,0) ..S OLDVAL=VAL "RTN","DGENUPL1",175,0) ..S VAL=$O(^DIC(4,"D",OLDVAL,0)) "RTN","DGENUPL1",176,0) ..I 'VAL S VAL=$O(^DIC(4,"D",(+OLDVAL),0)) "RTN","DGENUPL1",177,0) ..I 'VAL S ERROR=1 "RTN","DGENUPL1",178,0) .I ($G(DATATYPE)="POS") D Q "RTN","DGENUPL1",179,0) ..N OLDVAL "RTN","DGENUPL1",180,0) ..S OLDVAL=VAL "RTN","DGENUPL1",181,0) ..S VAL=$O(^DIC(21,"D",OLDVAL,0)) "RTN","DGENUPL1",182,0) ..I 'VAL S ERROR=1 "RTN","DGENUPL1",183,0) .I ($G(DATATYPE)="AGENCY") D Q "RTN","DGENUPL1",184,0) ..N OLDVAL "RTN","DGENUPL1",185,0) ..S OLDVAL=VAL "RTN","DGENUPL1",186,0) ..S VAL=$O(^DIC(35,"C",OLDVAL,0)) "RTN","DGENUPL1",187,0) ..I 'VAL S ERROR=1 "RTN","DGENUPL1",188,0) .I ($G(DATATYPE)="PENSIONCD") D Q "RTN","DGENUPL1",189,0) ..N OLDVAL "RTN","DGENUPL1",190,0) ..S OLDVAL=VAL "RTN","DGENUPL1",191,0) ..S VAL=$O(^DG(27.18,"C",OLDVAL,0)) "RTN","DGENUPL1",192,0) ..I 'VAL S ERROR=1 "RTN","DGENUPL1",193,0) Q VAL "RTN","DGENUPL1",194,0) ; "RTN","DGENUPL1",195,0) MAP(VALUE) ; "RTN","DGENUPL1",196,0) ;Description: Tries to map an eligibility code from file #8.1 (the national MAS ELIGIBILITY CODE file) to file #8 (the local ELIGIBILITY CODE file) "RTN","DGENUPL1",197,0) ; "RTN","DGENUPL1",198,0) ;Input: VALUE - ien of an entry in file #8.1 "RTN","DGENUPL1",199,0) ; "RTN","DGENUPL1",200,0) ;Output: Function value - NULL if mapping is not found, otherwise returns an ien of entry in file #8 "RTN","DGENUPL1",201,0) ; "RTN","DGENUPL1",202,0) N ECODE,NODE,COUNT,NAME "RTN","DGENUPL1",203,0) ;try to choose a code from file 8 to use that is appropriate "RTN","DGENUPL1",204,0) S (COUNT,ECODE)=0 "RTN","DGENUPL1",205,0) ; "RTN","DGENUPL1",206,0) F S ECODE=$O(^DIC(8,"D",VALUE,ECODE)) Q:'ECODE D "RTN","DGENUPL1",207,0) .S NODE=$G(^DIC(8,ECODE,0)) "RTN","DGENUPL1",208,0) .;put code on list if active "RTN","DGENUPL1",209,0) .I (NODE'=""),'$P(NODE,"^",7) S ECODE(ECODE)=$P(NODE,"^"),COUNT=COUNT+1 "RTN","DGENUPL1",210,0) ; "RTN","DGENUPL1",211,0) ;only one match found, so use it "RTN","DGENUPL1",212,0) Q:COUNT=1 $O(ECODE(0)) "RTN","DGENUPL1",213,0) ; "RTN","DGENUPL1",214,0) ;no match found "RTN","DGENUPL1",215,0) Q:'COUNT "" "RTN","DGENUPL1",216,0) ; "RTN","DGENUPL1",217,0) ;multiple matches found, try to match by name "RTN","DGENUPL1",218,0) I COUNT>1 D "RTN","DGENUPL1",219,0) .S ECODE=0 "RTN","DGENUPL1",220,0) .S NAME=$P($G(^DIC(8.1,VALUE,0)),"^") "RTN","DGENUPL1",221,0) .F S ECODE=$O(ECODE(ECODE)) Q:'ECODE Q:ECODE(ECODE)=NAME "RTN","DGENUPL1",222,0) Q ECODE "RTN","DGENUPL1",223,0) ; "RTN","DGENUPL1",224,0) ACCEPT(MSGID) ; "RTN","DGENUPL1",225,0) ;Description: Writes an ack (AA) to a global to be transmitted later. "RTN","DGENUPL1",226,0) ; "RTN","DGENUPL1",227,0) ;Inputs: "RTN","DGENUPL1",228,0) ; MSGID -message control id of HL7 msg in the MSH segment "RTN","DGENUPL1",229,0) ; "RTN","DGENUPL1",230,0) ;Outputs: none "RTN","DGENUPL1",231,0) ; "RTN","DGENUPL1",232,0) K HL,HLMID,HLMTIEN,HLDT,HLDT1 "RTN","DGENUPL1",233,0) D INIT^HLFNC2(HLEID,.HL) "RTN","DGENUPL1",234,0) D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1) "RTN","DGENUPL1",235,0) S HLEVN=1 "RTN","DGENUPL1",236,0) S MID=HLMID_"-"_HLEVN "RTN","DGENUPL1",237,0) D MSH^HLFNC2(.HL,MID,.HLRES) "RTN","DGENUPL1",238,0) S ^TMP("HLS",$J,1)=HLRES "RTN","DGENUPL1",239,0) ; "RTN","DGENUPL1",240,0) ;it seems HLFS sometimes disappears upon reaching this point "RTN","DGENUPL1",241,0) I $G(HLFS)="" S HLFS="^" "RTN","DGENUPL1",242,0) ; "RTN","DGENUPL1",243,0) S ^TMP("HLS",$J,2)="MSA"_HLFS_"AA"_HLFS_MSGID "RTN","DGENUPL1",244,0) Q "RTN","DGENUPL1",245,0) ; "RTN","DGENUPL1",246,0) MVERRORS ; "RTN","DGENUPL1",247,0) ;Error messages were being deleted from ^TMP("HLS",$J by another package "RTN","DGENUPL1",248,0) ;during the upload. To fix this, errors are written to another "RTN","DGENUPL1",249,0) ;subscript, then moved when the error list is complete. "RTN","DGENUPL1",250,0) ; "RTN","DGENUPL1",251,0) M ^TMP("HLS",$J)=^TMP("IVM","HLS",$J) "RTN","DGENUPL1",252,0) K ^TMP("IVM","HLS",$J) "RTN","DGENUPL1",253,0) Q "RTN","DGENUPL2") 0^10^B82241171 "RTN","DGENUPL2",1,0) DGENUPL2 ;ALB/CJM,RTK,TMK,ISA/KWP/RMM/CKN,EG,ERC,PWC,TDM,TEJ - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 5/19/11 5:00pm "RTN","DGENUPL2",2,0) ;;5.3;REGISTRATION;**147,222,232,310,314,367,397,677,631,675,672,673,716,653,688,838,842,894**;Aug 13,1993;Build 48 "RTN","DGENUPL2",3,0) ; "RTN","DGENUPL2",4,0) ;************************************************************** "RTN","DGENUPL2",5,0) ;The following procedures parse particular segment types. "RTN","DGENUPL2",6,0) ;Input:SEG(),MSGID "RTN","DGENUPL2",7,0) ;Output:DGPAT(),DGELG(),DGENR(),DGCDIS(),DGNTR(),DGOEIF(),ERROR "RTN","DGENUPL2",8,0) ;************************************************************** "RTN","DGENUPL2",9,0) ; "RTN","DGENUPL2",10,0) PID ; "RTN","DGENUPL2",11,0) S DGPAT("SSN")=SEG(19) "RTN","DGENUPL2",12,0) Q "RTN","DGENUPL2",13,0) ; "RTN","DGENUPL2",14,0) ZPD ; "RTN","DGENUPL2",15,0) D ZPD^DGENUPLA ;code removed due to size of DGENUPLA - DG*5.3*688 "RTN","DGENUPL2",16,0) Q "RTN","DGENUPL2",17,0) ; "RTN","DGENUPL2",18,0) ZIE ; "RTN","DGENUPL2",19,0) S DGPAT("INELDATE")=$$CONVERT^DGENUPL1(SEG(2),"DATE",.ERROR) "RTN","DGENUPL2",20,0) I ERROR D Q "RTN","DGENUPL2",21,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIE SEGMENT, SEQ 2",.ERRCOUNT) "RTN","DGENUPL2",22,0) S DGPAT("INELREA")=$$CONVERT^DGENUPL1(SEG(3)) "RTN","DGENUPL2",23,0) S DGPAT("INELDEC")=$$CONVERT^DGENUPL1(SEG(4)) "RTN","DGENUPL2",24,0) Q "RTN","DGENUPL2",25,0) ; "RTN","DGENUPL2",26,0) ZIO ;New segment - DG*5.3*653 "RTN","DGENUPL2",27,0) D ZIO^DGENUPLA ;Code for ZIO has moved to DGENUPLA "RTN","DGENUPL2",28,0) Q "RTN","DGENUPL2",29,0) ; "RTN","DGENUPL2",30,0) ZEL(COUNT) ; "RTN","DGENUPL2",31,0) D ZEL^DGENUPLA(COUNT) ;code for ZEL segment has moved to DGENUPLA "RTN","DGENUPL2",32,0) Q "RTN","DGENUPL2",33,0) ; "RTN","DGENUPL2",34,0) ZEN ; "RTN","DGENUPL2",35,0) N SUB "RTN","DGENUPL2",36,0) S DGENR("DATE")=$$CONVERT^DGENUPL1(SEG(2),"DATE",.ERROR) "RTN","DGENUPL2",37,0) I ERROR D Q "RTN","DGENUPL2",38,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 2",.ERRCOUNT) "RTN","DGENUPL2",39,0) S DGENR("SOURCE")=$$CONVERT^DGENUPL1(SEG(3)) "RTN","DGENUPL2",40,0) S DGENR("STATUS")=$$CONVERT^DGENUPL1(SEG(4)) "RTN","DGENUPL2",41,0) S ERROR=$$PEND(DFN,DGENR("STATUS")) "RTN","DGENUPL2",42,0) I ERROR D Q "RTN","DGENUPL2",43,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"ENROLLMENT STATUS PENDING-ELIGIBILITY IS VERIFIED",.ERRCOUNT) "RTN","DGENUPL2",44,0) S DGENR("REASON")=$$CONVERT^DGENUPL1(SEG(5)) "RTN","DGENUPL2",45,0) S DGENR("REMARKS")=$$CONVERT^DGENUPL1(SEG(6)) "RTN","DGENUPL2",46,0) S DGENR("FACREC")=$$CONVERT^DGENUPL1(SEG(7),"INSTITUTION",.ERROR) "RTN","DGENUPL2",47,0) I ERROR D Q "RTN","DGENUPL2",48,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"FACILITY RECEIVED "_SEG(7)_" NOT FOUND IN THE INSTITUTION FILE",.ERRCOUNT) "RTN","DGENUPL2",49,0) S DGPAT("PREFAC")=$$CONVERT^DGENUPL1(SEG(8),"INSTITUTION",.ERROR) "RTN","DGENUPL2",50,0) I ERROR D Q "RTN","DGENUPL2",51,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"PREFERRED FACILITY "_SEG(8)_" NOT FOUND IN THE INSTITUTION FILE",.ERRCOUNT) "RTN","DGENUPL2",52,0) ; "RTN","DGENUPL2",53,0) S DGENR("PRIORITY")=$$CONVERT^DGENUPL1(SEG(9)) "RTN","DGENUPL2",54,0) S DGENR("EFFDATE")=$$CONVERT^DGENUPL1(SEG(10),"DATE",.ERROR) "RTN","DGENUPL2",55,0) I ERROR D Q "RTN","DGENUPL2",56,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 10",.ERRCOUNT) "RTN","DGENUPL2",57,0) S DGENR("APP")=$$CONVERT^DGENUPL1(SEG(11),"DATE",.ERROR) "RTN","DGENUPL2",58,0) I ERROR D Q "RTN","DGENUPL2",59,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 11",.ERRCOUNT) "RTN","DGENUPL2",60,0) ; "RTN","DGENUPL2",61,0) ;!!!!!! take next line out when HEC begins transmitting application dt "RTN","DGENUPL2",62,0) I DGENR("APP")=""!(DGENR("APP")="@") S DGENR("APP")=DGENR("DATE") "RTN","DGENUPL2",63,0) I DGENR("APP")=""!(DGENR("APP")="@") S DGENR("APP")=DGENR("EFFDATE") "RTN","DGENUPL2",64,0) ; "RTN","DGENUPL2",65,0) S DGENR("END")=$$CONVERT^DGENUPL1(SEG(12),"DATE",.ERROR) "RTN","DGENUPL2",66,0) I ERROR D Q "RTN","DGENUPL2",67,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 12",.ERRCOUNT) "RTN","DGENUPL2",68,0) ;Phase II Parse out Sub-Group (SRS 6[B.4) "RTN","DGENUPL2",69,0) S DGENR("SUBGRP")=$$CONVERT^DGENUPL1(SEG(13)) "RTN","DGENUPL2",70,0) S DGPAT("PFSRC")=$$CONVERT^DGENUPL1(SEG(14)) N PFSRC S PFSRC=DGPAT("PFSRC") "RTN","DGENUPL2",71,0) I PFSRC'="V"&(PFSRC'="E")&(PFSRC'="PA")&(PFSRC'="PI")&(PFSRC'="@")&(PFSRC'="") D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 14",.ERRCOUNT) Q "RTN","DGENUPL2",72,0) ; "RTN","DGENUPL2",73,0) ;want to ignore double quotes sent for enrollment fields "RTN","DGENUPL2",74,0) S SUB="" "RTN","DGENUPL2",75,0) F S SUB=$O(DGENR(SUB)) Q:SUB="" I DGENR(SUB)="@"!(DGENR(SUB)="""""") S DGENR(SUB)="" "RTN","DGENUPL2",76,0) ; "RTN","DGENUPL2",77,0) Q "RTN","DGENUPL2",78,0) ; "RTN","DGENUPL2",79,0) ZMT ; "RTN","DGENUPL2",80,0) I SEG(1)>1 D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"ZMT SEGMENT, SEQ 1, SHOULD SPECIFY MEANS TEST",.ERRCOUNT) S ERROR=1 Q "RTN","DGENUPL2",81,0) S DGELG("MTSTA")=$$CONVERT^DGENUPL1(SEG(3),"MT",.ERROR) "RTN","DGENUPL2",82,0) I ERROR D Q "RTN","DGENUPL2",83,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMT SEGMENT, SEQ 3",.ERRCOUNT) "RTN","DGENUPL2",84,0) Q "RTN","DGENUPL2",85,0) ; "RTN","DGENUPL2",86,0) ZCD ; "RTN","DGENUPL2",87,0) ;Phase II for multiple ZCD's "RTN","DGENUPL2",88,0) I SEG(1)>1 G SKIP "RTN","DGENUPL2",89,0) S DGCDIS("BY")=$$CONVERT^DGENUPL1(SEG(3)) "RTN","DGENUPL2",90,0) S DGCDIS("DATE")=$$CONVERT^DGENUPL1(SEG(5),"DATE",.ERROR) "RTN","DGENUPL2",91,0) I ERROR D Q "RTN","DGENUPL2",92,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 5",.ERRCOUNT) "RTN","DGENUPL2",93,0) S DGCDIS("FACDET")=$$CONVERT^DGENUPL1(SEG(4),"INSTITUTION",.ERROR) "RTN","DGENUPL2",94,0) I ERROR D Q "RTN","DGENUPL2",95,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"FACILITY "_SEG(4)_" MAKING CATASTROPHIC DISABILITY DETERMINATION NOT FOUND IN THE INSTITUTION FILE",.ERRCOUNT) "RTN","DGENUPL2",96,0) S DGCDIS("REVDTE")=$$CONVERT^DGENUPL1(SEG(2),"DATE",.ERROR) "RTN","DGENUPL2",97,0) I ERROR D Q "RTN","DGENUPL2",98,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 2",.ERRCOUNT) "RTN","DGENUPL2",99,0) S DGCDIS("METDET")=$$CONVERT^DGENUPL1($P(SEG(6),$E(HLECH))) "RTN","DGENUPL2",100,0) S DGCDIS("VCD")=$$CONVERT^DGENUPL1(SEG(12)) "RTN","DGENUPL2",101,0) ;SEQ 14 - DATE VETERAN REQUESTED CD EVALUATION "RTN","DGENUPL2",102,0) S DGCDIS("VETREQDT")=$$CONVERT^DGENUPL1(SEG(14),"DATE",.ERROR) "RTN","DGENUPL2",103,0) I ERROR D Q "RTN","DGENUPL2",104,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 14",.ERRCOUNT) "RTN","DGENUPL2",105,0) ;SEQ 15 - DATE FACILITY INITIATED REVIEW "RTN","DGENUPL2",106,0) S DGCDIS("DTFACIRV")=$$CONVERT^DGENUPL1(SEG(15),"DATE",.ERROR) "RTN","DGENUPL2",107,0) I ERROR D Q "RTN","DGENUPL2",108,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 15",.ERRCOUNT) "RTN","DGENUPL2",109,0) ;SEQ 16 - DATE VETERAN WAS NOTIFIED "RTN","DGENUPL2",110,0) S DGCDIS("DTVETNOT")=$$CONVERT^DGENUPL1(SEG(16),"DATE",.ERROR) "RTN","DGENUPL2",111,0) I ERROR D Q "RTN","DGENUPL2",112,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 16",.ERRCOUNT) "RTN","DGENUPL2",113,0) SKIP ; "RTN","DGENUPL2",114,0) ;Phase II Parse out additional fields. CONVERT type of RSN converts the code to IEN for diagnosis,procedure and condition (HL7TORSN^DGENA5). "RTN","DGENUPL2",115,0) ; * check the new DESCRIPTOR sequences - DG*5.3*894 "RTN","DGENUPL2",116,0) N I,D3 ; DG*5.3*894 "RTN","DGENUPL2",117,0) S D3="|" ; DG*5.3*894 "RTN","DGENUPL2",118,0) F I=1:1 Q:$P(SEG(17),D3,I)="" D "RTN","DGENUPL2",119,0) . S DGCDIS("DESCR",I)=$$CONVERT^DGENUPL1($P(SEG(17),D3,I),"CDDSCR") "RTN","DGENUPL2",120,0) ; "RTN","DGENUPL2",121,0) I '$D(DGCDIS("DESCR")) D "RTN","DGENUPL2",122,0) .S DGCDIS("DIAG",SEG(1))=$$CONVERT^DGENUPL1(SEG(7),"CDRSN") "RTN","DGENUPL2",123,0) .S DGCDIS("PROC",SEG(1))=$$CONVERT^DGENUPL1(SEG(8),"CDRSN") "RTN","DGENUPL2",124,0) .S DGCDIS("COND",SEG(1))=$$CONVERT^DGENUPL1(SEG(10),"CDRSN") "RTN","DGENUPL2",125,0) ; "RTN","DGENUPL2",126,0) S DGCDIS("EXT",SEG(1),1)=$$CONVERT^DGENUPL1($P(SEG(9),$E(HLECH)),"EXT") "RTN","DGENUPL2",127,0) S DGCDIS("SCORE",SEG(1))=$$CONVERT^DGENUPL1($P(SEG(11),$E(HLECH))) "RTN","DGENUPL2",128,0) S DGCDIS("PERM",SEG(1))=$$CONVERT^DGENUPL1($P(SEG(13),$E(HLECH))) "RTN","DGENUPL2",129,0) I DGCDIS("VCD")="Y",'$D(DGCDIS("DIAG")),'$D(DGCDIS("PROC")),'$D(DGCDIS("COND")),'$D(DGCDIS("DESCR")) D Q "RTN","DGENUPL2",130,0) .S ERROR=1 D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"NO VALID DIAGNOSIS,PROCEDURE,CONDITION, OR DESCRIPTOR IN THE ZCD SEGMENT",.ERRCOUNT) "RTN","DGENUPL2",131,0) Q "RTN","DGENUPL2",132,0) ; "RTN","DGENUPL2",133,0) ZSP ; "RTN","DGENUPL2",134,0) S DGELG("SC")=$$CONVERT^DGENUPL1(SEG(2),"Y/N",.ERROR) "RTN","DGENUPL2",135,0) I ERROR D Q "RTN","DGENUPL2",136,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 2",.ERRCOUNT) "RTN","DGENUPL2",137,0) S DGELG("SCPER")=$$CONVERT^DGENUPL1(SEG(3)) "RTN","DGENUPL2",138,0) S DGELG("POS")=$$CONVERT^DGENUPL1(SEG(4),"POS",.ERROR) "RTN","DGENUPL2",139,0) I ERROR D Q "RTN","DGENUPL2",140,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 4",.ERRCOUNT) "RTN","DGENUPL2",141,0) S DGELG("EFFDT")=$$CONVERT^DGENUPL1(SEG(11),"DATE",.ERROR) "RTN","DGENUPL2",142,0) I ERROR D Q "RTN","DGENUPL2",143,0) . D ADDERROR^DGENUPL(MSGID,$G(DGELG("EFFDT")),"BAD VALUE, ZSP SEGMENT, SEQ 11",.ERRCOUNT) "RTN","DGENUPL2",144,0) ;if effective date is null, set update value to "@" (delete) "RTN","DGENUPL2",145,0) I DGELG("EFFDT")="" S DGELG("EFFDT")="@" "RTN","DGENUPL2",146,0) ; "RTN","DGENUPL2",147,0) ;added 8/3/98 to reduce #rejects "RTN","DGENUPL2",148,0) ;if HEC sends SC=NO, SC% not sent, and site has value for SC% then delete it "RTN","DGENUPL2",149,0) I DGELG("SC")="N",DGELG("SCPER")="" S DGELG("SCPER")="@" "RTN","DGENUPL2",150,0) ; "RTN","DGENUPL2",151,0) S DGELG("P&T")=$$CONVERT^DGENUPL1(SEG(6),"Y/N",.ERROR) "RTN","DGENUPL2",152,0) I ERROR D Q "RTN","DGENUPL2",153,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 6",.ERRCOUNT) "RTN","DGENUPL2",154,0) S DGELG("UNEMPLOY")=$$CONVERT^DGENUPL1(SEG(7),"Y/N",.ERROR) "RTN","DGENUPL2",155,0) I ERROR D Q "RTN","DGENUPL2",156,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 7",.ERRCOUNT) "RTN","DGENUPL2",157,0) S DGELG("SCAWDATE")=$$CONVERT^DGENUPL1(SEG(8),"DATE",.ERROR) "RTN","DGENUPL2",158,0) I ERROR D Q "RTN","DGENUPL2",159,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 8",.ERRCOUNT) "RTN","DGENUPL2",160,0) S DGELG("P&TDT")=$$CONVERT^DGENUPL1(SEG(10),"DATE",.ERROR) "RTN","DGENUPL2",161,0) I ERROR D "RTN","DGENUPL2",162,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 10 - P&T EFFECTIVE DATE",.ERRCOUNT) "RTN","DGENUPL2",163,0) S DGPAT("DENTC2IN")=$$CONVERT^DGENUPL1(SEG(12),"Y/N",.ERROR) "RTN","DGENUPL2",164,0) I ERROR D Q "RTN","DGENUPL2",165,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 12",.ERRCOUNT) "RTN","DGENUPL2",166,0) S DGPAT("DENTC2DT")=$$CONVERT^DGENUPL1(SEG(13),"DATE",.ERROR) "RTN","DGENUPL2",167,0) I ERROR D Q "RTN","DGENUPL2",168,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 13",.ERRCOUNT) "RTN","DGENUPL2",169,0) Q "RTN","DGENUPL2",170,0) ; "RTN","DGENUPL2",171,0) ZMH ;Purple Heart, OEFOIE, POW "RTN","DGENUPL2",172,0) D ZMH^DGENUPL3 ;Moved to DGENUPL3 - DG*5.3*653 "RTN","DGENUPL2",173,0) Q "RTN","DGENUPL2",174,0) ; "RTN","DGENUPL2",175,0) ZRD ; "RTN","DGENUPL2",176,0) N COUNT,DXCODE,NAME,COND "RTN","DGENUPL2",177,0) S DXCODE=$P(SEG(2),$E(HLECH)) "RTN","DGENUPL2",178,0) I DXCODE="""""" S DXCODE="" "RTN","DGENUPL2",179,0) S NAME=$P(SEG(2),$E(HLECH),2) "RTN","DGENUPL2",180,0) Q:DXCODE="" ;segment does not contain a disability condition "RTN","DGENUPL2",181,0) ; "RTN","DGENUPL2",182,0) S COUNT=1+(+$G(DGELG("RATEDIS"))) "RTN","DGENUPL2",183,0) S (COND,DGELG("RATEDIS",COUNT,"RD"))=$$DCLOOKUP(DXCODE,NAME) "RTN","DGENUPL2",184,0) S DGELG("RATEDIS",COUNT,"PER")=$$CONVERT^DGENUPL1(SEG(3)),DGELG("RATEDIS")=COUNT "RTN","DGENUPL2",185,0) S DGELG("RATEDIS",COUNT,"RDEXT")=$$CONVERT^DGENUPL1(SEG(12)) "RTN","DGENUPL2",186,0) S DGELG("RATEDIS",COUNT,"RDORIG")=$$CONVERT^DGENUPL1(SEG(13),"DATE",.ERROR) "RTN","DGENUPL2",187,0) I ERROR D Q "RTN","DGENUPL2",188,0) . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZRD SEGMENT, S 13",.ERRCOUNT) "RTN","DGENUPL2",189,0) S DGELG("RATEDIS",COUNT,"RDCURR")=$$CONVERT^DGENUPL1(SEG(14),"DATE",.ERROR) "RTN","DGENUPL2",190,0) I ERROR D Q "RTN","DGENUPL2",191,0) . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZRD SEGMENT, S 14",.ERRCOUNT) "RTN","DGENUPL2",192,0) I 'COND D Q "RTN","DGENUPL2",193,0) .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZRD SEGMENT, SEQ 2 - DISABILTY CONDITION LOOKUP FAILED",.ERRCOUNT) "RTN","DGENUPL2",194,0) .S ERROR=1 "RTN","DGENUPL2",195,0) Q "RTN","DGENUPL2",196,0) OBX ; "RTN","DGENUPL2",197,0) D OBX^DGENUPLA ;code for OBX segment moved to DGENUPLA "RTN","DGENUPL2",198,0) Q "RTN","DGENUPL2",199,0) ; "RTN","DGENUPL2",200,0) ;*********** end of segment parsers **** "RTN","DGENUPL2",201,0) ; "RTN","DGENUPL2",202,0) DCLOOKUP(DGCODE,DGNAME) ; "RTN","DGENUPL2",203,0) ; Description: Returns the ien of a Disability Condition (file #31) based on the DGCODE and DGNAME "RTN","DGENUPL2",204,0) ; "RTN","DGENUPL2",205,0) ;Input: "RTN","DGENUPL2",206,0) ; DGCODE - DX Code of the Disability Condition "RTN","DGENUPL2",207,0) ; DGNAME - name of the Disability Condition "RTN","DGENUPL2",208,0) ;Output: "RTN","DGENUPL2",209,0) ; Function Value: ien of the entry found, or 0 otherwise "RTN","DGENUPL2",210,0) ; "RTN","DGENUPL2",211,0) Q:(DGCODE="") 0 "RTN","DGENUPL2",212,0) N NODE,IEN,FOUND "RTN","DGENUPL2",213,0) S (FOUND,IEN)=0 "RTN","DGENUPL2",214,0) F S IEN=$O(^DIC(31,"C",DGCODE,IEN)) Q:'IEN D Q:FOUND "RTN","DGENUPL2",215,0) .S NODE=$G(^DIC(31,IEN,0)) "RTN","DGENUPL2",216,0) .I DGNAME=$P(NODE,"^"),DGCODE=$P(NODE,"^",3) S FOUND=1 "RTN","DGENUPL2",217,0) I 'FOUND S IEN=$O(^DIC(31,"C",DGCODE,0)) "RTN","DGENUPL2",218,0) Q +IEN "RTN","DGENUPL2",219,0) ; "RTN","DGENUPL2",220,0) REGCHECK(DFN) ; "RTN","DGENUPL2",221,0) ; Description: passes patient through the registration consistency checker "RTN","DGENUPL2",222,0) ;Input - "RTN","DGENUPL2",223,0) ; DFN - is a pointer to the Patient File "RTN","DGENUPL2",224,0) ; "RTN","DGENUPL2",225,0) N DGCD,DGCHK,DGDAY,DGEDCN,DGER,DGLST,DGNCK,DGRPCOLD,DGSC,DGTYPE,DGVT,VA,X "RTN","DGENUPL2",226,0) ; "RTN","DGENUPL2",227,0) S DGEDCN=0 "RTN","DGENUPL2",228,0) D ^DGRPC "RTN","DGENUPL2",229,0) Q "RTN","DGENUPL2",230,0) PEND(DFN,DGSTAT) ; "RTN","DGENUPL2",231,0) N DGARR,DGEC,DGERR,DGX "RTN","DGENUPL2",232,0) I $P($G(^DPT(DFN,.361)),U)'="V" Q 0 "RTN","DGENUPL2",233,0) I $G(DGSTAT)="@" Q 0 "RTN","DGENUPL2",234,0) I $G(DGSTAT)']"" Q 0 "RTN","DGENUPL2",235,0) S DGSTAT="^"_DGSTAT_"^" "RTN","DGENUPL2",236,0) Q:"^15^17^"'[DGSTAT 0 "RTN","DGENUPL2",237,0) D GETS^DIQ(2,DFN_",",".301;.302;.361;.36295","IE","DGARR","DGERR") "RTN","DGENUPL2",238,0) I $D(DGERR) Q 0 "RTN","DGENUPL2",239,0) S DGEC=$G(DGARR(2,DFN_",",.361,"I")) "RTN","DGENUPL2",240,0) I $G(DGEC)']"" Q 0 "RTN","DGENUPL2",241,0) S DGEC=$P($G(^DIC(8,DGEC,0)),U,9) "RTN","DGENUPL2",242,0) I $G(DGEC)']"" Q 0 "RTN","DGENUPL2",243,0) I DGEC=5 Q 1 "RTN","DGENUPL2",244,0) I DGEC=3 D Q DGX "RTN","DGENUPL2",245,0) . S DGX=1 "RTN","DGENUPL2",246,0) . I $G(DGARR(2,DFN_",",.301,"I"))'="Y" S DGX=0 Q "RTN","DGENUPL2",247,0) . I +$G(DGARR(2,DFN_",",.302,"I"))>0 S DGX=0 Q "RTN","DGENUPL2",248,0) . I +$G(DGARR(2,DFN_",",.36295,"I"))>0 S DGX=0 Q "RTN","DGENUPL2",249,0) Q 0 "RTN","VAFHLZCD") 0^8^B35023485 "RTN","VAFHLZCD",1,0) VAFHLZCD ;ALB/KCL,Zoltan,JAN,TDM,TEJ,LMD - Create HL7 Catastrophic Disability (ZCD) segment ; 9/19/05 11:31am "RTN","VAFHLZCD",2,0) ;;5.3;Registration;**122,232,387,653,894**;Aug 13, 1993;Build 48 "RTN","VAFHLZCD",3,0) ; "RTN","VAFHLZCD",4,0) ; "RTN","VAFHLZCD",5,0) ; This generic extrinsic function is designed to return the "RTN","VAFHLZCD",6,0) ; HL7 Catastrophic Disability (ZCD) segment. This segment "RTN","VAFHLZCD",7,0) ; contains VA-specific catastrophic disability information "RTN","VAFHLZCD",8,0) ; for a patient. "RTN","VAFHLZCD",9,0) ; "RTN","VAFHLZCD",10,0) EN(DFN,VAFSTR,VAFNUM,VAFHLQ,VAFHLFS) ; -- "RTN","VAFHLZCD",11,0) ; Entry point for creating HL7 Catastrophic Disability (ZCD) segment. "RTN","VAFHLZCD",12,0) ; "RTN","VAFHLZCD",13,0) ; Input(s): "RTN","VAFHLZCD",14,0) ; DFN - internal entry number of Patient (#2) file "RTN","VAFHLZCD",15,0) ; VAFSTR - (optional) string of fields requested, separated by "RTN","VAFHLZCD",16,0) ; commas. If not passed, return all data fields. "RTN","VAFHLZCD",17,0) ; VAFNUM - (optional) sequential number for SET ID (default=1) "RTN","VAFHLZCD",18,0) ; VAFHLQ - (optional) HL7 null variable "RTN","VAFHLZCD",19,0) ; VAFHLFS - (optional) HL7 field separator "RTN","VAFHLZCD",20,0) ; "RTN","VAFHLZCD",21,0) ; Performance Note: "RTN","VAFHLZCD",22,0) ; VAFCDLST - Optional array (created by MAKELST subroutine below.) "RTN","VAFHLZCD",23,0) ; In cases involving multiple ZCD segments, performance "RTN","VAFHLZCD",24,0) ; is enhanced by calling MAKELST to create this array "RTN","VAFHLZCD",25,0) ; before invoking this function. This may not apply "RTN","VAFHLZCD",26,0) ; in cases where BUILD is invoked to create multiple "RTN","VAFHLZCD",27,0) ; ZCD segments. "RTN","VAFHLZCD",28,0) ; "RTN","VAFHLZCD",29,0) ; Other optional input variables: "RTN","VAFHLZCD",30,0) ; HLQ - HL7 default value to use when a sequence is empty. "RTN","VAFHLZCD",31,0) ; HLFS - HL7 default primary delimiter (between sequences.) "RTN","VAFHLZCD",32,0) ; "RTN","VAFHLZCD",33,0) ; Output(s): "RTN","VAFHLZCD",34,0) ; String containing the desired components of the HL7 ZCD segment "RTN","VAFHLZCD",35,0) ; "RTN","VAFHLZCD",36,0) ; NOTE: "RTN","VAFHLZCD",37,0) ; In cases where multiple diagnoses, procedures, and/or conditions "RTN","VAFHLZCD",38,0) ; exist to support a status of CATASTROPHICALLY DISABLED, the "RTN","VAFHLZCD",39,0) ; MAKELST subroutine (see below) is invoked to serialize them "RTN","VAFHLZCD",40,0) ; (along with any related information) into separate ZCD "RTN","VAFHLZCD",41,0) ; segments. This function will return the text of a single "RTN","VAFHLZCD",42,0) ; ZCD segment based on the segment number in VAFNUM. "RTN","VAFHLZCD",43,0) ; "RTN","VAFHLZCD",44,0) N VAFCAT,VAFY,X,SETID,VALOK,SUB "RTN","VAFHLZCD",45,0) ; "RTN","VAFHLZCD",46,0) ; if VAFHLQ or VAFHLFS not passed, use default HL7 variables "RTN","VAFHLZCD",47,0) I $D(VAFHLQ)[0 S VAFHLQ=$G(HLQ) "RTN","VAFHLZCD",48,0) I $G(VAFHLFS)="" S VAFHLFS=$G(HLFS,"^") "RTN","VAFHLZCD",49,0) ; "RTN","VAFHLZCD",50,0) ; if set id not passed, use default "RTN","VAFHLZCD",51,0) S VAFNUM=$S($G(VAFNUM):VAFNUM,1:1) "RTN","VAFHLZCD",52,0) ; "RTN","VAFHLZCD",53,0) ; if DFN not passed, exit "RTN","VAFHLZCD",54,0) I '$G(DFN) S VAFY=1 G ENQ "RTN","VAFHLZCD",55,0) ; "RTN","VAFHLZCD",56,0) ; get catastrophic disability info for a patient into VAFCAT "RTN","VAFHLZCD",57,0) I '$$GET^DGENCDA(DFN,.VAFCAT) S VAFY=1 G ENQ "RTN","VAFHLZCD",58,0) ; If sequence 13="Y" or "N", then sequences 2 through 6 are required. "RTN","VAFHLZCD",59,0) ; If sequence 13="" then sequences 2 through 6 should not be sent. "RTN","VAFHLZCD",60,0) S VALOK=1 "RTN","VAFHLZCD",61,0) I VAFCAT("VCD")'="" F SUB="REVDTE","BY","FACDET","DATE","METDET" I $G(VAFCAT(SUB))="" S VALOK=0 "RTN","VAFHLZCD",62,0) I 'VALOK F SUB="REVDTE","BY","FACDET","DATE","METDET","VCD" S VAFCAT(SUB)="" "RTN","VAFHLZCD",63,0) ; "RTN","VAFHLZCD",64,0) ; if VAFSTR not passed, return all data fields "RTN","VAFHLZCD",65,0) I $G(VAFSTR)="" S VAFSTR="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17" ;DG*5.3*894 "RTN","VAFHLZCD",66,0) ; "RTN","VAFHLZCD",67,0) ; initialize output string and requested data fields "RTN","VAFHLZCD",68,0) S $P(VAFY,VAFHLFS,$L(VAFSTR,","))="" "RTN","VAFHLZCD",69,0) S VAFSTR=","_VAFSTR_"," "RTN","VAFHLZCD",70,0) ; "RTN","VAFHLZCD",71,0) ; Create a list to restrict multiple-valued fields to separate "RTN","VAFHLZCD",72,0) ; segments. For example, if there are any DIAG, PROC and COND "RTN","VAFHLZCD",73,0) ; entries, then no two of those values (or their associated sub- "RTN","VAFHLZCD",74,0) ; fields) may occupy the same ZCD segment. (See MAKELST below "RTN","VAFHLZCD",75,0) ; for implementation details.) "RTN","VAFHLZCD",76,0) I '$D(VAFCDLST) N VAFCDLST D MAKELST(.VAFCDLST,.VAFCAT) "RTN","VAFHLZCD",77,0) ; "RTN","VAFHLZCD",78,0) ; set-up segment data fields "RTN","VAFHLZCD",79,0) ; 1 - Set ID "RTN","VAFHLZCD",80,0) S SETID=$S($G(VAFNUM):VAFNUM,1:1) "RTN","VAFHLZCD",81,0) S $P(VAFY,VAFHLFS,1)=SETID "RTN","VAFHLZCD",82,0) ; 2 - Review Date "RTN","VAFHLZCD",83,0) I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S(VAFCAT("REVDTE")'="":$$HLDATE^HLFNC(VAFCAT("REVDTE")),1:VAFHLQ) "RTN","VAFHLZCD",84,0) ; 3 - Decided By "RTN","VAFHLZCD",85,0) I VAFSTR[",3," S $P(VAFY,VAFHLFS,3)=$S(VAFCAT("BY")'="":VAFCAT("BY"),1:VAFHLQ) "RTN","VAFHLZCD",86,0) ; 4 - Facility Making Determination "RTN","VAFHLZCD",87,0) I VAFSTR[",4," S X=$$STATION^VAFHLFNC(VAFCAT("FACDET")) S $P(VAFY,VAFHLFS,4)=$S(X'="":X,1:VAFHLQ) "RTN","VAFHLZCD",88,0) ; 5 - Date of Decision "RTN","VAFHLZCD",89,0) I VAFSTR[",5," S $P(VAFY,VAFHLFS,5)=$S(VAFCAT("DATE")'="":$$HLDATE^HLFNC(VAFCAT("DATE")),1:VAFHLQ) "RTN","VAFHLZCD",90,0) ; 6 - Method of Determination "RTN","VAFHLZCD",91,0) I VAFSTR[",6," S $P(VAFY,VAFHLFS,6)=$S(VAFCAT("METDET")'="":$$METH2HL7^DGENA5(VAFCAT("METDET")),1:VAFHLQ) "RTN","VAFHLZCD",92,0) ; 17 - Catastrophic Disability Descriptor(s) - DG*5.3*894 "RTN","VAFHLZCD",93,0) K VANO S VANO=1 I VAFSTR[",17,",$D(VAFCAT("DESCR"))>0 S $P(VAFY,VAFHLFS,17)=$$DSCR2HL7^DGENA5(DFN) S:$P(VAFY,VAFHLFS,17)]"" VANO=0 "RTN","VAFHLZCD",94,0) ; 7 - Diagnosis (multiple), DG*5.3*894 "RTN","VAFHLZCD",95,0) I VANO,VAFSTR[",7," S $P(VAFY,VAFHLFS,7)=$S($G(VAFCDLST(SETID,"DIAG"))'="":$$RSNTOHL7^DGENA5(VAFCDLST(SETID,"DIAG")),1:VAFHLQ) "RTN","VAFHLZCD",96,0) ; 8 - Procedure (multiple), DG*5.3*894 "RTN","VAFHLZCD",97,0) I VANO,VAFSTR[",8," S $P(VAFY,VAFHLFS,8)=$S($G(VAFCDLST(SETID,"PROC"))'="":$$RSNTOHL7^DGENA5(VAFCDLST(SETID,"PROC")),1:VAFHLQ) "RTN","VAFHLZCD",98,0) ; 9 - Affected Extremity (Procedure sub-field) "RTN","VAFHLZCD",99,0) I VAFSTR[",9," S $P(VAFY,VAFHLFS,9)=$S($G(VAFCDLST(SETID,"EXT"))'="":$$LIMBTOHL^DGENA5(VAFCDLST(SETID,"EXT")),1:VAFHLQ) "RTN","VAFHLZCD",100,0) ; 10 - Condition (multiple), DG*5.3*894 "RTN","VAFHLZCD",101,0) I VANO,VAFSTR[",10," S $P(VAFY,VAFHLFS,10)=$S($G(VAFCDLST(SETID,"COND"))'="":$$RSNTOHL7^DGENA5(VAFCDLST(SETID,"COND")),1:VAFHLQ) "RTN","VAFHLZCD",102,0) ; 11 - Score (Condition sub-field) "RTN","VAFHLZCD",103,0) I VAFSTR[",11," S $P(VAFY,VAFHLFS,11)=$S($G(VAFCDLST(SETID,"SCORE"))'="":VAFCDLST(SETID,"SCORE"),1:VAFHLQ) "RTN","VAFHLZCD",104,0) ; 12 - Veteran Catastrophically Disabled? "RTN","VAFHLZCD",105,0) I VAFSTR[",12," S $P(VAFY,VAFHLFS,12)=$S(VAFCAT("VCD")'="":VAFCAT("VCD"),1:VAFHLQ) "RTN","VAFHLZCD",106,0) ; 13 - Permanent Indicator (Condition sub-field) "RTN","VAFHLZCD",107,0) I VAFSTR[",13," S $P(VAFY,VAFHLFS,13)=$S($G(VAFCDLST(SETID,"PERM"))'="":$$PERMTOHL^DGENA5(VAFCDLST(SETID,"PERM")),1:VAFHLQ) "RTN","VAFHLZCD",108,0) ; 14 - Date Veteran Requested CD Evaluation "RTN","VAFHLZCD",109,0) I VAFSTR[",14," S $P(VAFY,VAFHLFS,14)=$S(VAFCAT("VETREQDT")'="":$$HLDATE^HLFNC(VAFCAT("VETREQDT")),1:VAFHLQ) "RTN","VAFHLZCD",110,0) ; 15 - Date Facility Initiated Review "RTN","VAFHLZCD",111,0) I VAFSTR[",15," S $P(VAFY,VAFHLFS,15)=$S(VAFCAT("DTFACIRV")'="":$$HLDATE^HLFNC(VAFCAT("DTFACIRV")),1:VAFHLQ) "RTN","VAFHLZCD",112,0) ; 16 - Date Veteran Was Notified "RTN","VAFHLZCD",113,0) I VAFSTR[",16," S $P(VAFY,VAFHLFS,16)=$S(VAFCAT("DTVETNOT")'="":$$HLDATE^HLFNC(VAFCAT("DTVETNOT")),1:VAFHLQ) "RTN","VAFHLZCD",114,0) ; "RTN","VAFHLZCD",115,0) S:$E(VAFSTR,1)="," VAFSTR=$E(VAFSTR,2,$L(VAFSTR)) "RTN","VAFHLZCD",116,0) S:$E(VAFSTR,$L(VAFSTR))="," VAFSTR=$E(VAFSTR,1,$L(VAFSTR)-1) "RTN","VAFHLZCD",117,0) ENQ Q "ZCD"_VAFHLFS_$G(VAFY) "RTN","VAFHLZCD",118,0) ; "RTN","VAFHLZCD",119,0) ; Subroutines follow... "RTN","VAFHLZCD",120,0) MAKELST(VAFCDLST,VAFCAT) ; Make list of ZCD Segments. "RTN","VAFHLZCD",121,0) ; Inputs: "RTN","VAFHLZCD",122,0) ; VAFCDLST - By reference (used to hold output array.) "RTN","VAFHLZCD",123,0) ; VAFCAT - By reference, an array containing the patient's CD "RTN","VAFHLZCD",124,0) ; data (as created in $$GET^DGENCDA). "RTN","VAFHLZCD",125,0) ; Output: "RTN","VAFHLZCD",126,0) ; VAFCDLST(Segment#,"DIAG") = CD Diagnosis (pointer to #27.17). "RTN","VAFHLZCD",127,0) ; VAFCDLST(Segment#,"PROC")= CD Procedure(pointer to #27.17). "RTN","VAFHLZCD",128,0) ; VAFCDLST(Segment#,"EXT") = Affected Extremity (for procedure). "RTN","VAFHLZCD",129,0) ; VAFCDLST(Segment#,"COND")= CD Condition (pointer to #27.17). "RTN","VAFHLZCD",130,0) ; VAFCDLST(Segment#,"PERM") = Permanent Indicator (for condition). "RTN","VAFHLZCD",131,0) ; VAFCDLST(Segment#,"SCORE") = Test Score (for condition). "RTN","VAFHLZCD",132,0) ; VAFCDLST(Segment#,"DESCR") = CD Descriptor(for VCD="yes") * DG*5.3*894 "RTN","VAFHLZCD",133,0) ; "RTN","VAFHLZCD",134,0) ; Per Enrollment Phase II SRS (Section 4.2.4) no ZCD segment should "RTN","VAFHLZCD",135,0) ; contain more than one CD Reason (Diagnosis, Procedure, Condition.) "RTN","VAFHLZCD",136,0) ; So this procedure adds each one as a separate ZCD segment. "RTN","VAFHLZCD",137,0) ; "RTN","VAFHLZCD",138,0) N ITEM,SITEM,STR "RTN","VAFHLZCD",139,0) K VAFCDLST "RTN","VAFHLZCD",140,0) S VAFCDLST=0 "RTN","VAFHLZCD",141,0) S (ITEM,SITEM)="" "RTN","VAFHLZCD",142,0) ; Add each Diagnosis as a separate ZCD segment. "RTN","VAFHLZCD",143,0) F S ITEM=$O(VAFCAT("DIAG",ITEM)) Q:ITEM="" D "RTN","VAFHLZCD",144,0) . D ADDNEW(.VAFCDLST,"DIAG",VAFCAT("DIAG",ITEM)) "RTN","VAFHLZCD",145,0) ; Add each Procedure as a separate ZCD segment. "RTN","VAFHLZCD",146,0) F S ITEM=$O(VAFCAT("PROC",ITEM)) Q:ITEM="" D "RTN","VAFHLZCD",147,0) . F S SITEM=$O(VAFCAT("EXT",ITEM,SITEM)) Q:SITEM="" D "RTN","VAFHLZCD",148,0) .. D ADDNEW(.VAFCDLST,"PROC",VAFCAT("PROC",ITEM)) "RTN","VAFHLZCD",149,0) .. D INSERT(.VAFCDLST,"EXT",VAFCAT("EXT",ITEM,SITEM)) "RTN","VAFHLZCD",150,0) ; Add each Condition as a separate ZCD segment. "RTN","VAFHLZCD",151,0) F S ITEM=$O(VAFCAT("COND",ITEM)) Q:ITEM="" D "RTN","VAFHLZCD",152,0) . D ADDNEW(.VAFCDLST,"COND",VAFCAT("COND",ITEM)) "RTN","VAFHLZCD",153,0) . D INSERT(.VAFCDLST,"SCORE",VAFCAT("SCORE",ITEM)) "RTN","VAFHLZCD",154,0) . D INSERT(.VAFCDLST,"PERM",VAFCAT("PERM",ITEM)) "RTN","VAFHLZCD",155,0) I VAFCDLST=0 S VAFCDLST=1 ; At least one ZCD segment. "RTN","VAFHLZCD",156,0) Q "RTN","VAFHLZCD",157,0) ADDNEW(LIST,NAME,ITEM) ; Add an item to the list (internal use only). "RTN","VAFHLZCD",158,0) ; Inputs: "RTN","VAFHLZCD",159,0) ; LIST - By reference, a list of items. "RTN","VAFHLZCD",160,0) ; NAME - Name of one item to add. "RTN","VAFHLZCD",161,0) ; ITEM - Value of item to add. "RTN","VAFHLZCD",162,0) ; Note: a new position is created in the list. "RTN","VAFHLZCD",163,0) S LIST=LIST+1 "RTN","VAFHLZCD",164,0) S LIST(LIST,NAME)=ITEM "RTN","VAFHLZCD",165,0) Q "RTN","VAFHLZCD",166,0) INSERT(LIST,NAME,ITEM) ; Insert item into existing list position (internal). "RTN","VAFHLZCD",167,0) ; LIST - By reference, a list of items. "RTN","VAFHLZCD",168,0) ; NAME - Name of one item to add. "RTN","VAFHLZCD",169,0) ; ITEM - Value of item to add. "RTN","VAFHLZCD",170,0) ; Note: the list should already contain at least one item. "RTN","VAFHLZCD",171,0) S LIST(LIST,NAME)=ITEM "RTN","VAFHLZCD",172,0) Q "RTN","VAFHLZCD",173,0) BUILD(VAFSEGS,DFN,VAFSTR,VAFHLQ,VAFHLFS) ; "RTN","VAFHLZCD",174,0) ; Entry point for creating HL7 Catastrophic Disability (ZCD) segments. "RTN","VAFHLZCD",175,0) ; This is the preferred entry point for building ZCD segments. "RTN","VAFHLZCD",176,0) ; "RTN","VAFHLZCD",177,0) ; Input(s): "RTN","VAFHLZCD",178,0) ; VAFSEGS - Pass-by-reference array to contain all ZCD segments "RTN","VAFHLZCD",179,0) ; for this patient. "RTN","VAFHLZCD",180,0) ; DFN - internal entry number of Patient (#2) file "RTN","VAFHLZCD",181,0) ; VAFSTR - (optional) string of fields requested, separated by "RTN","VAFHLZCD",182,0) ; commas. If not passed, return all data fields. "RTN","VAFHLZCD",183,0) ; VAFHLQ - (optional) HL7 null variable "RTN","VAFHLZCD",184,0) ; VAFHLFS - (optional) HL7 field separator "RTN","VAFHLZCD",185,0) ; "RTN","VAFHLZCD",186,0) ; Output: "RTN","VAFHLZCD",187,0) ; VAFSEGS - By reference, an array containing all ZCD segments. "RTN","VAFHLZCD",188,0) ; Format: VAFSEGS = Number of ZCD Segments "RTN","VAFHLZCD",189,0) ; VAFSEGS(1) = First ZCD Segment "RTN","VAFHLZCD",190,0) ; VAFSEGS(2) = Second ZCD Segment (if any)... "RTN","VAFHLZCD",191,0) ; etc. "RTN","VAFHLZCD",192,0) ; "RTN","VAFHLZCD",193,0) ; NOTE: "RTN","VAFHLZCD",194,0) ; Per Enrollment Phase II SRS (Section 4.2.4) no ZCD segment should "RTN","VAFHLZCD",195,0) ; contain more than one CD Reason (Diagnosis, Procedure, Condition.) "RTN","VAFHLZCD",196,0) ; As a result, multiple ZCD segments will be created if more than "RTN","VAFHLZCD",197,0) ; one of these fields has a value. The MAKELST procedure contains "RTN","VAFHLZCD",198,0) ; logic to enforce this requirement. "RTN","VAFHLZCD",199,0) ; "RTN","VAFHLZCD",200,0) N VAFCDLST ; Temporary array of CD REASON info. "RTN","VAFHLZCD",201,0) K VAFSEGS S VAFSEGS=0 ; Initialize array. "RTN","VAFHLZCD",202,0) ; DFN is required. "RTN","VAFHLZCD",203,0) I '$G(DFN) Q "RTN","VAFHLZCD",204,0) ; get catastrophic disability info for a patient into VAFCAT "RTN","VAFHLZCD",205,0) I '$$GET^DGENCDA(DFN,.VAFCAT) Q "RTN","VAFHLZCD",206,0) ; Create a list VAFCDLST to enforce one CD REASON per segment. "RTN","VAFHLZCD",207,0) D MAKELST(.VAFCDLST,.VAFCAT) "RTN","VAFHLZCD",208,0) I 'VAFCDLST Q "RTN","VAFHLZCD",209,0) ; Create an array of HL7 segments. "RTN","VAFHLZCD",210,0) F VAFSEGS=1:1:VAFCDLST S VAFSEGS(VAFSEGS)=$$EN(DFN,.VAFSTR,VAFSEGS,.VAFHLQ,.VAFHLFS) "RTN","VAFHLZCD",211,0) Q "SEC","^DIC",38.6,38.6,0,"DD") @ "SEC","^DIC",38.6,38.6,0,"DEL") @ "SEC","^DIC",38.6,38.6,0,"LAYGO") @ "SEC","^DIC",38.6,38.6,0,"RD") d "SEC","^DIC",38.6,38.6,0,"WR") @ "UP",2,2.396,-1) 2^.396 "UP",2,2.396,0) 2.396 "UP",2,2.397,-1) 2^.397 "UP",2,2.397,0) 2.397 "UP",2,2.398,-1) 2^.398 "UP",2,2.398,0) 2.398 "UP",2,2.399,-1) 2^.399 "UP",2,2.399,0) 2.399 "UP",2,2.401,-1) 2^.401 "UP",2,2.401,0) 2.401 "UP",2,2.409,-2) 2^.399 "UP",2,2.409,-1) 2.399^1 "UP",2,2.409,0) 2.409 "VER") 8.0^22.0 "^DD",2,2,.39,0) VETERAN CATASTROPHICALLY DISABLED?^S^Y:YES;N:NO;^.39;6^Q "^DD",2,2,.39,1,0) ^.1 "^DD",2,2,.39,1,1,0) 2^VCD^MUMPS "^DD",2,2,.39,1,1,1) D AUTOUPD^DGENA2(DA) "^DD",2,2,.39,1,1,2) D AUTOUPD^DGENA2(DA) "^DD",2,2,.39,1,1,"%D",0) ^.101^2^2^3110301^^ "^DD",2,2,.39,1,1,"%D",1,0) This cross-reference is used to auto-update the patients "^DD",2,2,.39,1,1,"%D",2,0) PATIENT ENROLLMENT (#27.11) record. "^DD",2,2,.39,1,1,"DT") 2990618 "^DD",2,2,.39,1,2,0) 2^AVCDMT^MUMPS "^DD",2,2,.39,1,2,1) N DFN,DGMT,DGNOCOPF,DGREQF,DGWRT,IVMZ10F S DFN=DA D EN^DGMTR "^DD",2,2,.39,1,2,2) N DFN,DGMT,DGNOCOPF,DGREQF,DGWRT,IVMZ10F S DFN=DA D EN^DGMTR "^DD",2,2,.39,1,2,"%D",0) ^^20^20^3110302^ "^DD",2,2,.39,1,2,"%D",1,0) This cross-reference calls the Means Test software. "^DD",2,2,.39,1,2,"%D",2,0) If answered 'YES', then a Means Test is not "^DD",2,2,.39,1,2,"%D",3,0) required and the Rx Copay is exempt. "^DD",2,2,.39,1,2,"%D",4,0) Executing this cross-reference will result in the "^DD",2,2,.39,1,2,"%D",5,0) following file and field changes: "^DD",2,2,.39,1,2,"%D",6,0) "^DD",2,2,.39,1,2,"%D",7,0) ANNUAL MEANS TEST FILE (#408.31) "^DD",2,2,.39,1,2,"%D",8,0) Field: STATUS (#.03) "^DD",2,2,.39,1,2,"%D",9,0) When a veteran is determined to be Catastrophically Disabled, the STATUS "^DD",2,2,.39,1,2,"%D",10,0) field is set to NO LONGER APPLICABLE. "^DD",2,2,.39,1,2,"%D",11,0) When a Catastrophically Disabled veteran is no longer determined to be "^DD",2,2,.39,1,2,"%D",12,0) Catastrophically Disabled, then the STATUS field is set to one of the "^DD",2,2,.39,1,2,"%D",13,0) sixteen possible Means Test statuses. "^DD",2,2,.39,1,2,"%D",14,0) "^DD",2,2,.39,1,2,"%D",15,0) BILLING EXEMPTIONS FILE (#354.1) "^DD",2,2,.39,1,2,"%D",16,0) Field: STATUS (#.04) "^DD",2,2,.39,1,2,"%D",17,0) When a veteran is determined to be Catastrophically Disabled, the STATUS "^DD",2,2,.39,1,2,"%D",18,0) field is set to EXEMPT. "^DD",2,2,.39,1,2,"%D",19,0) When a Catastrophically Disabled veteran is no longer determined to be "^DD",2,2,.39,1,2,"%D",20,0) Catastrophically Disabled, then the STATUS field is set to NON-EXEMPT. "^DD",2,2,.39,1,2,"DT") 3110302 "^DD",2,2,.39,3) Enter a Yes or No for whether the patient is Catastrophically Disabled. "^DD",2,2,.39,21,0) ^.001^2^2^3140912^^^^ "^DD",2,2,.39,21,1,0) This field states whether or not the patient is a veteran who has been "^DD",2,2,.39,21,2,0) determined to meet the criteria for CATASTROPHICALLY DISABLED. "^DD",2,2,.39,"DT") 3110302 "^DD",2,2,.391,0) DECIDED BY^F^^.39;1^K:$L(X)>35!($L(X)<3) X "^DD",2,2,.391,1,0) ^.1 "^DD",2,2,.391,1,1,0) 2^AENR391^MUMPS "^DD",2,2,.391,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.391,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.391,1,1,3) DO NOT DELETE "^DD",2,2,.391,1,1,"%D",0) ^.101^2^2^3050606^^^^ "^DD",2,2,.391,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.391,1,1,"%D",2,0) enrollment. "^DD",2,2,.391,1,1,"DT") 3050606 "^DD",2,2,.391,3) Enter the name of the VA staff physician who made the decision that the patient was catastrophically disabled. "^DD",2,2,.391,4) "^DD",2,2,.391,21,0) ^^2^2^2970520^ "^DD",2,2,.391,21,1,0) The name of the VA staff physician who made the determination that the patient "^DD",2,2,.391,21,2,0) was catastrophically disabled. "^DD",2,2,.391,"DT") 2970520 "^DD",2,2,.392,0) DATE OF DECISION^DX^^.39;2^S %DT="EX" D ^%DT S X=Y K:Y<1 X K:($G(DT)&($G(X)>$G(DT))) X "^DD",2,2,.392,1,0) ^.1 "^DD",2,2,.392,1,1,0) 2^AENR392^MUMPS "^DD",2,2,.392,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.392,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.392,1,1,3) DO NOT DELETE "^DD",2,2,.392,1,1,"%D",0) ^.101^2^2^3050606^^^^ "^DD",2,2,.392,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.392,1,1,"%D",2,0) enrollment. "^DD",2,2,.392,1,1,"DT") 3050606 "^DD",2,2,.392,3) Enter the date the decision was made. "^DD",2,2,.392,21,0) ^^1^1^2970619^^ "^DD",2,2,.392,21,1,0) The date the catastrophic disability determination was made. "^DD",2,2,.392,"DT") 2970820 "^DD",2,2,.393,0) FACILITY MAKING DETERMINATION^P4'^DIC(4,^.39;3^Q "^DD",2,2,.393,1,0) ^.1 "^DD",2,2,.393,1,1,0) 2^AENR393^MUMPS "^DD",2,2,.393,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.393,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.393,1,1,3) DO NOT DELETE "^DD",2,2,.393,1,1,"%D",0) ^.101^2^2^3050606^^^^ "^DD",2,2,.393,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.393,1,1,"%D",2,0) enrollment. "^DD",2,2,.393,1,1,"DT") 3050606 "^DD",2,2,.393,3) Enter the VAMC that made the catastrophic disability determination. "^DD",2,2,.393,21,0) ^^1^1^2970520^ "^DD",2,2,.393,21,1,0) The VAMC that made the catastrophic disability determination. "^DD",2,2,.393,"DT") 2970520 "^DD",2,2,.394,0) REVIEW DATE^D^^.39;4^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",2,2,.394,1,0) ^.1 "^DD",2,2,.394,1,1,0) 2^AENR394^MUMPS "^DD",2,2,.394,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.394,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.394,1,1,3) DO NOT DELETE "^DD",2,2,.394,1,1,"%D",0) ^.101^2^2^3050606^^^^ "^DD",2,2,.394,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.394,1,1,"%D",2,0) enrollment. "^DD",2,2,.394,1,1,"DT") 3050606 "^DD",2,2,.394,3) Enter the date the catastrophic disability determination was made. "^DD",2,2,.394,21,0) ^^2^2^2990702^^^^ "^DD",2,2,.394,21,1,0) The date that a review to determine Catastrophic Disability was made. "^DD",2,2,.394,21,2,0) This review may be a medical record review or physical exam review. "^DD",2,2,.394,"DT") 2970520 "^DD",2,2,.395,0) METHOD OF DETERMINATION^S^2:MEDICAL RECORD REVIEW;3:PHYSICAL EXAMINATION;^.39;5^Q "^DD",2,2,.395,1,0) ^.1 "^DD",2,2,.395,1,1,0) 2^AENR395^MUMPS "^DD",2,2,.395,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.395,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.395,1,1,3) DO NOT DELETE "^DD",2,2,.395,1,1,"%D",0) ^.101^2^2^3050606^^^^ "^DD",2,2,.395,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.395,1,1,"%D",2,0) enrollment. "^DD",2,2,.395,1,1,"DT") 3050606 "^DD",2,2,.395,3) Enter Method of Determination that patient is Catastrophically Disabled. "^DD",2,2,.395,21,0) ^.001^7^7^3140912^^^^ "^DD",2,2,.395,21,1,0) Added in order to document the review method of how the decision "^DD",2,2,.395,21,2,0) to assign a CD status was determined. "^DD",2,2,.395,21,3,0) "^DD",2,2,.395,21,4,0) Determination may be made by reviewing the veteran's medical record "^DD",2,2,.395,21,5,0) or by performing a physical examination of the veteran. "^DD",2,2,.395,21,6,0) In the future, the capability to fully automate the record review "^DD",2,2,.395,21,7,0) process will be added to the system. "^DD",2,2,.395,"DT") 2990629 "^DD",2,2,.3951,0) DATE VETERAN REQUESTED CD EVAL^D^^.39;7^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",2,2,.3951,1,0) ^.1 "^DD",2,2,.3951,1,1,0) 2^AENR3951^MUMPS "^DD",2,2,.3951,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.3951,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.3951,1,1,3) DO NOT DELETE "^DD",2,2,.3951,1,1,"%D",0) ^.101^2^2^3050930^^^^ "^DD",2,2,.3951,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.3951,1,1,"%D",2,0) enrollment. "^DD",2,2,.3951,1,1,"DT") 3050930 "^DD",2,2,.3951,3) Enter date veteran requested Catastrophically Disabled evaluation. "^DD",2,2,.3951,21,0) ^.001^2^2^3140912^^^ "^DD",2,2,.3951,21,1,0) Documents the date the veteran requested Catastrophically Disabled "^DD",2,2,.3951,21,2,0) evaluation. "^DD",2,2,.3951,"DT") 3050930 "^DD",2,2,.3952,0) DATE FACILITY INITIATED REVIEW^D^^.39;8^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",2,2,.3952,1,0) ^.1 "^DD",2,2,.3952,1,1,0) 2^AENR3952^MUMPS "^DD",2,2,.3952,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.3952,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.3952,1,1,3) DO NOT DELETE "^DD",2,2,.3952,1,1,"%D",0) ^.101^2^2^3050930^^^^ "^DD",2,2,.3952,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.3952,1,1,"%D",2,0) enrollment. "^DD",2,2,.3952,1,1,"DT") 3050930 "^DD",2,2,.3952,3) Enter the date the VA facility initiated the Catastrophically Disabled review. "^DD",2,2,.3952,21,0) ^^2^2^3140912^ "^DD",2,2,.3952,21,1,0) Documents the date the VA facility initiated the Catastrophically "^DD",2,2,.3952,21,2,0) Disabled review. "^DD",2,2,.3952,"DT") 3140912 "^DD",2,2,.3953,0) DATE VETERAN WAS NOTIFIED^D^^.39;9^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",2,2,.3953,1,0) ^.1 "^DD",2,2,.3953,1,1,0) 2^AENR3953^MUMPS "^DD",2,2,.3953,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.3953,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.3953,1,1,3) DO NOT DELETE "^DD",2,2,.3953,1,1,"%D",0) ^.101^2^2^3050930^^^^ "^DD",2,2,.3953,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.3953,1,1,"%D",2,0) enrollment. "^DD",2,2,.3953,1,1,"DT") 3050930 "^DD",2,2,.3953,3) Enter the date the veteran was notified of the Catastrophically Disabled decision. "^DD",2,2,.3953,21,0) ^^2^2^3140912^ "^DD",2,2,.3953,21,1,0) Documents the date the veteran was notified of the Catastrophically "^DD",2,2,.3953,21,2,0) Disabled decision by the VA facility. "^DD",2,2,.3953,"DT") 3140912 "^DD",2,2,.396,0) CD STATUS DIAGNOSES^2.396P^^.396;0 "^DD",2,2,.396,12) Must point to a CD REASON that is a diagnosis. "^DD",2,2,.396,12.1) S DIC("S")="I $P(^DGEN(27.17,Y,0),U,2)=""D""" "^DD",2,2,.396,21,0) ^.001^4^4^3140910^^^^ "^DD",2,2,.396,21,1,0) This file contains one or more Diagnoses, which "^DD",2,2,.396,21,2,0) provide the Catastrophic Disability Reasons "^DD",2,2,.396,21,3,0) the patient has been found to be catastrophically disabled. "^DD",2,2,.396,21,4,0) "^DD",2,2,.397,0) CD STATUS PROCEDURES^2.397P^^.397;0 "^DD",2,2,.397,10) "^DD",2,2,.397,12) Must select a CD REASON that is a valid procedure. "^DD",2,2,.397,12.1) S DIC("S")="I $P(^DGEN(27.17,Y,0),U,2)=""P""" "^DD",2,2,.397,21,0) ^^1^1^3120210^ "^DD",2,2,.397,21,1,0) The status procedure must be a valid procedure in the CD Reasons File (#27.17). "^DD",2,2,.398,0) CD STATUS CONDITIONS^2.398P^^.398;0 "^DD",2,2,.398,12) Must specify a CD REASON that is a condition. "^DD",2,2,.398,12.1) S DIC("S")="I $P(^DGEN(27.17,Y,0),U,2)=""C""" "^DD",2,2,.398,21,0) ^^3^3^3140818^ "^DD",2,2,.398,21,1,0) This field contains one or more Conditions, which provide the "^DD",2,2,.398,21,2,0) Catastrophic Disability Reasons the patient has been found to be "^DD",2,2,.398,21,3,0) catastrophically disabled. "^DD",2,2,.399,0) CD HISTORY DATE^2.399DA^^.399;0 "^DD",2,2,.399,21,0) ^.001^1^1^3140912^^^^ "^DD",2,2,.399,21,1,0) Documents the Catastrophically Disabled History dates for the patient. "^DD",2,2,.401,0) CD DESCRIPTORS^2.401P^^.401;0 "^DD",2,2,.401,21,0) ^.001^3^3^3150316^^^^ "^DD",2,2,.401,21,1,0) This field contains one or more Descriptors, which provide the "^DD",2,2,.401,21,2,0) Catastrophic Disability Reasons the patient has been found to be "^DD",2,2,.401,21,3,0) catastrophically disabled. "^DD",2,2,.401,"DT") 3141001 "^DD",2,2.396,0) CD STATUS DIAGNOSES SUB-FIELD^^.01^1 "^DD",2,2.396,0,"DT") 3140819 "^DD",2,2.396,0,"IX","AENR01",2.396,.01) "^DD",2,2.396,0,"IX","B",2.396,.01) "^DD",2,2.396,0,"NM","CD STATUS DIAGNOSES") "^DD",2,2.396,0,"UP") 2 "^DD",2,2.396,.01,0) CD STATUS DIAGNOSES^M*P27.17'XOI^DGEN(27.17,^0;1^S DIC("S")="I $$TYPE^DGENA5(Y)=""D""&($P(^DGEN(27.17,+Y,0),U,9)=$$ICDVER^DGENA5(""D""))" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X "^DD",2,2.396,.01,1,0) ^.1 "^DD",2,2.396,.01,1,1,0) 2.396^B "^DD",2,2.396,.01,1,1,1) S ^DPT(DA(1),.396,"B",$E(X,1,30),DA)="" "^DD",2,2.396,.01,1,1,2) K ^DPT(DA(1),.396,"B",$E(X,1,30),DA) "^DD",2,2.396,.01,1,2,0) 2.396^AENR01^MUMPS "^DD",2,2.396,.01,1,2,1) D EVENT^IVMPLOG($G(DA(1))) "^DD",2,2.396,.01,1,2,2) D EVENT^IVMPLOG($G(DA(1))) "^DD",2,2.396,.01,1,2,3) DO NOT DELETE "^DD",2,2.396,.01,1,2,"%D",0) ^.101^2^2^3050913^^^^ "^DD",2,2.396,.01,1,2,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2.396,.01,1,2,"%D",2,0) enrollment. "^DD",2,2.396,.01,1,2,"DT") 3050913 "^DD",2,2.396,.01,2) S Y(0)=Y S Y=$$DISP^DGENLCD1(Y) "^DD",2,2.396,.01,2.1) S Y=$$DISP^DGENLCD1(Y) "^DD",2,2.396,.01,3) Select a CD diagnosis. "^DD",2,2.396,.01,12) Must specify a CD REASON that is a diagnosis and the diagnosis coding system must match the value stored in the CD Reasons file. "^DD",2,2.396,.01,12.1) S DIC("S")="I $$TYPE^DGENA5(Y)=""D""&($P(^DGEN(27.17,+Y,0),U,9)=$$ICDVER^DGENA5(""D""))" "^DD",2,2.396,.01,21,0) ^^2^2^3130828^ "^DD",2,2.396,.01,21,1,0) This is a diagnosis which determines that the veteran is catastrophically "^DD",2,2.396,.01,21,2,0) disabled. "^DD",2,2.396,.01,"DT") 3140910 "^DD",2,2.397,0) CD STATUS PROCEDURES SUB-FIELD^^1^2 "^DD",2,2.397,0,"DT") 3140819 "^DD",2,2.397,0,"IX","AENR01",2.397,.01) "^DD",2,2.397,0,"IX","AENR1",2.397,1) "^DD",2,2.397,0,"IX","B",2.397,.01) "^DD",2,2.397,0,"NM","CD STATUS PROCEDURES") "^DD",2,2.397,0,"UP") 2 "^DD",2,2.397,.01,0) CD STATUS PROCEDURES^M*P27.17'XOI^DGEN(27.17,^0;1^S DIC("S")="I $$TYPE^DGENA5(Y)=""P"" I ($P(^DGEN(27.17,+Y,0),U,3)[""ICPT"")!($P(^DGEN(27.17,+Y,0),U,9)=$$ICDVER^DGENA5(""P""))" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X "^DD",2,2.397,.01,1,0) ^.1 "^DD",2,2.397,.01,1,1,0) 2.397^B "^DD",2,2.397,.01,1,1,1) S ^DPT(DA(1),.397,"B",$E(X,1,30),DA)="" "^DD",2,2.397,.01,1,1,2) K ^DPT(DA(1),.397,"B",$E(X,1,30),DA) "^DD",2,2.397,.01,1,2,0) 2.397^AENR01^MUMPS "^DD",2,2.397,.01,1,2,1) D EVENT^IVMPLOG($G(DA(1))) "^DD",2,2.397,.01,1,2,2) D EVENT^IVMPLOG($G(DA(1))) "^DD",2,2.397,.01,1,2,3) DO NOT DELETE "^DD",2,2.397,.01,1,2,"%D",0) ^.101^2^2^3050913^^^^ "^DD",2,2.397,.01,1,2,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2.397,.01,1,2,"%D",2,0) enrollment. "^DD",2,2.397,.01,1,2,"DT") 3050913 "^DD",2,2.397,.01,2) S Y(0)=Y S Y=$$DISP^DGENLCD1(Y) "^DD",2,2.397,.01,2.1) S Y=$$DISP^DGENLCD1(Y) "^DD",2,2.397,.01,3) Enter the status procedure code from the CD Reasons File (#27.17). "^DD",2,2.397,.01,12) Must specify a CD REASON that is a procedure. The code must be a CPT code or the procedure coding system must match the value stored in the CD Reasons file. "^DD",2,2.397,.01,12.1) S DIC("S")="I $$TYPE^DGENA5(Y)=""P"" I ($P(^DGEN(27.17,+Y,0),U,3)[""ICPT"")!($P(^DGEN(27.17,+Y,0),U,9)=$$ICDVER^DGENA5(""P""))" "^DD",2,2.397,.01,21,0) ^^3^3^3130828^ "^DD",2,2.397,.01,21,1,0) This is for storage of either CPT procedure or ICD procedure codes. ICD "^DD",2,2.397,.01,21,2,0) codes must be for the correct coding system, as determined by procedure "^DD",2,2.397,.01,21,3,0) date and stored in file 27.17 piece 9. "^DD",2,2.397,.01,"DT") 3140912 "^DD",2,2.397,1,0) AFFECTED EXTREMITY^R*SI^RUE:Right Upper Extremity;LUE:Left Upper Extremity;RLE:Right Lower Extremity;LLE:Left Lower Extremity;BLE:Bilateral Lower Extremity;BUE:Bilateral Upper Extremity;^0;2^Q "^DD",2,2.397,1,1,0) ^.1 "^DD",2,2.397,1,1,1,0) 2.397^AENR1^MUMPS "^DD",2,2.397,1,1,1,1) D EVENT^IVMPLOG($G(DA(1))) "^DD",2,2.397,1,1,1,2) D EVENT^IVMPLOG($G(DA(1))) "^DD",2,2.397,1,1,1,3) DO NOT DELETE "^DD",2,2.397,1,1,1,"%D",0) ^.101^2^2^3050913^^^^ "^DD",2,2.397,1,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2.397,1,1,1,"%D",2,0) enrollment. "^DD",2,2.397,1,1,1,"DT") 3050913 "^DD",2,2.397,1,3) Choose the affected extremity. "^DD",2,2.397,1,12) Must select an affected extremity that is valid for the procedure. "^DD",2,2.397,1,12.1) S DIC("S")="I $$LSCREEN^DGENA5(Y)" "^DD",2,2.397,1,21,0) ^^1^1^3130828^ "^DD",2,2.397,1,21,1,0) This is the affected extremity for this procedure. "^DD",2,2.397,1,"DT") 3140910 "^DD",2,2.398,0) CD STATUS CONDITIONS SUB-FIELD^^2^3 "^DD",2,2.398,0,"DT") 2990617 "^DD",2,2.398,0,"IX","AENR01",2.398,.01) "^DD",2,2.398,0,"IX","AENR1",2.398,1) "^DD",2,2.398,0,"IX","AENR2",2.398,2) "^DD",2,2.398,0,"IX","B",2.398,.01) "^DD",2,2.398,0,"NM","CD STATUS CONDITIONS") "^DD",2,2.398,0,"UP") 2 "^DD",2,2.398,.01,0) CD STATUS CONDITIONS^M*P27.17'I^DGEN(27.17,^0;1^S DIC("S")="I $$TYPE^DGENA5(Y)=""C""" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",2,2.398,.01,1,0) ^.1 "^DD",2,2.398,.01,1,1,0) 2.398^B "^DD",2,2.398,.01,1,1,1) S ^DPT(DA(1),.398,"B",$E(X,1,30),DA)="" "^DD",2,2.398,.01,1,1,2) K ^DPT(DA(1),.398,"B",$E(X,1,30),DA) "^DD",2,2.398,.01,1,2,0) 2.398^AENR01^MUMPS "^DD",2,2.398,.01,1,2,1) D EVENT^IVMPLOG($G(DA(1))) "^DD",2,2.398,.01,1,2,2) D EVENT^IVMPLOG($G(DA(1))) "^DD",2,2.398,.01,1,2,3) DO NOT DELETE "^DD",2,2.398,.01,1,2,"%D",0) ^.101^2^2^3050913^^^^ "^DD",2,2.398,.01,1,2,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2.398,.01,1,2,"%D",2,0) enrollment. "^DD",2,2.398,.01,1,2,"DT") 3050913 "^DD",2,2.398,.01,3) Enter the status conditions code from the CD Reasons File (#27.17). "^DD",2,2.398,.01,12) Must specify a CD REASON that is a condition. "^DD",2,2.398,.01,12.1) S DIC("S")="I $$TYPE^DGENA5(Y)=""C""" "^DD",2,2.398,.01,21,0) ^^10^10^3140818^^^ "^DD",2,2.398,.01,21,1,0) The veteran shall be determined Catastrophically Disabled if "^DD",2,2.398,.01,21,2,0) he/she has one of the following conditions: "^DD",2,2.398,.01,21,3,0) - Dependent in three or more ADLs, with at least three of the "^DD",2,2.398,.01,21,4,0) dependencies being permanent, using the Katz Scale. "^DD",2,2.398,.01,21,5,0) - A score of 10 or lower using the Folstein Mini-Mental State "^DD",2,2.398,.01,21,6,0) Examination. "^DD",2,2.398,.01,21,7,0) - A score of 2 or lower on at least 4 of the 13 motor items "^DD",2,2.398,.01,21,8,0) using the Functional Independence Measure (FIM) "^DD",2,2.398,.01,21,9,0) - A score of 30 or lower using the Global Assessment of Functions "^DD",2,2.398,.01,21,10,0) in (GAF) "^DD",2,2.398,.01,"DT") 3140912 "^DD",2,2.398,1,0) SCORE^RNJ3,0XI^^0;2^K:'$$CONDINP^DGENA5($G(D0),$G(D1),X) X "^DD",2,2.398,1,1,0) ^.1 "^DD",2,2.398,1,1,1,0) 2.398^AENR1^MUMPS "^DD",2,2.398,1,1,1,1) D EVENT^IVMPLOG($G(DA(1))) "^DD",2,2.398,1,1,1,2) D EVENT^IVMPLOG($G(DA(1))) "^DD",2,2.398,1,1,1,3) DO NOT DELETE "^DD",2,2.398,1,1,1,"%D",0) ^.101^2^2^3050913^^^^ "^DD",2,2.398,1,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2.398,1,1,1,"%D",2,0) enrollment. "^DD",2,2.398,1,1,1,"DT") 3050913 "^DD",2,2.398,1,3) "^DD",2,2.398,1,4) D CONDHELP^DGENA5($G(D0),$G(D1)) "^DD",2,2.398,1,21,0) ^^4^4^3140818^^^^ "^DD",2,2.398,1,21,1,0) NOTE: This field does not always contain the veteran's raw test "^DD",2,2.398,1,21,2,0) score. Sometimes you must enter specific information about the "^DD",2,2.398,1,21,3,0) score that may apply to the determination of Catastrophic Disability. "^DD",2,2.398,1,21,4,0) See the help text above for more details. "^DD",2,2.398,1,23,0) ^^3^3^2990520^ "^DD",2,2.398,1,23,1,0) The exact criteria for the score are determined by the CATASTROPHIC "^DD",2,2.398,1,23,2,0) DISABILITY REASONS file (#27.17). That file also contains the help "^DD",2,2.398,1,23,3,0) text for responding to SCORE. "^DD",2,2.398,1,"DT") 3140818 "^DD",2,2.398,2,0) PERMANENT INDICATOR^RSI^1:PERMANENT;2:NOT PERMANENT;3:UNKNOWN;^0;3^Q "^DD",2,2.398,2,1,0) ^.1 "^DD",2,2.398,2,1,1,0) 2.398^AENR2^MUMPS "^DD",2,2.398,2,1,1,1) D EVENT^IVMPLOG($G(DA(1))) "^DD",2,2.398,2,1,1,2) D EVENT^IVMPLOG($G(DA(1))) "^DD",2,2.398,2,1,1,3) DO NOT DELETE "^DD",2,2.398,2,1,1,"%D",0) ^.101^2^2^3050913^^^^ "^DD",2,2.398,2,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2.398,2,1,1,"%D",2,0) enrollment. "^DD",2,2.398,2,1,1,"DT") 3050913 "^DD",2,2.398,2,3) Enter the Permanent Indicator associated with the Catastrophic Disability Condition. "^DD",2,2.398,2,21,0) ^^2^2^3140818^ "^DD",2,2.398,2,21,1,0) This field contains the Permanent Indicator, which documents the "^DD",2,2.398,2,21,2,0) Catastrophic Disability Conditions. "^DD",2,2.398,2,"DT") 3140818 "^DD",2,2.399,0) CD HISTORY DATE SUB-FIELD^^.396^11 "^DD",2,2.399,0,"DT") 3140912 "^DD",2,2.399,0,"IX","B",2.399,.01) "^DD",2,2.399,0,"NM","CD HISTORY DATE") "^DD",2,2.399,0,"UP") 2 "^DD",2,2.399,.01,0) CD HISTORY DATE^D^^0;1^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X "^DD",2,2.399,.01,1,0) ^.1 "^DD",2,2.399,.01,1,1,0) 2.399^B "^DD",2,2.399,.01,1,1,1) S ^DPT(DA(1),.399,"B",$E(X,1,30),DA)="" "^DD",2,2.399,.01,1,1,2) K ^DPT(DA(1),.399,"B",$E(X,1,30),DA) "^DD",2,2.399,.01,3) Enter the CD History Date. This is a system entered data element. "^DD",2,2.399,.01,21,0) ^^2^2^3140915^ "^DD",2,2.399,.01,21,1,0) This sub-file stores the history of the PATIENT's Catastrophic Disability "^DD",2,2.399,.01,21,2,0) Eligibility information. "^DD",2,2.399,.01,"DT") 3140915 "^DD",2,2.399,.39,0) VETERAN CATASTROPHICALLY DISABLED?^RS^Y:YES;N:NO;^0;7^Q "^DD",2,2.399,.39,3) Enter the Catastrophically Disabled status of the patient. "^DD",2,2.399,.39,21,0) ^^1^1^3140912^ "^DD",2,2.399,.39,21,1,0) Documents the Catastrophically Disabled status in the CD History. "^DD",2,2.399,.39,"DT") 2990525 "^DD",2,2.399,.391,0) DECIDED BY^F^^0;2^K:$L(X)>35!($L(X)<3) X "^DD",2,2.399,.391,3) Answer must be 3-35 characters in length. "^DD",2,2.399,.391,21,0) ^^1^1^2990524^ "^DD",2,2.399,.391,21,1,0) Captures a historical value of DECIDED BY (#.391) field in PATIENT file. "^DD",2,2.399,.391,"DT") 2990524 "^DD",2,2.399,.392,0) DATE OF DECISION^D^^0;3^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",2,2.399,.392,3) Enter the date the decision was made. "^DD",2,2.399,.392,21,0) ^.001^1^1^3140912^^ "^DD",2,2.399,.392,21,1,0) Captures historical value of PATIENT field #.392 DATE OF DECISION. "^DD",2,2.399,.392,"DT") 2990524 "^DD",2,2.399,.393,0) FACILITY MAKING DETERMINATION^P4'^DIC(4,^0;4^Q "^DD",2,2.399,.393,3) Enter the Facility Making the Determination of the patient's Catastrophically Disabled status. "^DD",2,2.399,.393,21,0) ^.001^2^2^3140912^^ "^DD",2,2.399,.393,21,1,0) Captures a historical value of the FACILITY MAKING DETERMINATION field "^DD",2,2.399,.393,21,2,0) (#.393) of the PATIENT file. "^DD",2,2.399,.393,"DT") 2990524 "^DD",2,2.399,.394,0) REVIEW DATE^D^^0;5^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",2,2.399,.394,3) Enter the Review Date of the Catastrophically Disabled status of the patient. "^DD",2,2.399,.394,21,0) ^.001^2^2^3140912^^ "^DD",2,2.399,.394,21,1,0) Captures a historical value of the PATIENT file's REVIEW DATE field "^DD",2,2.399,.394,21,2,0) (#.394). "^DD",2,2.399,.394,"DT") 2990524 "^DD",2,2.399,.395,0) METHOD OF DETERMINATION^S^1:AUTOMATED RECORD REVIEW;2:MEDICAL RECORD REVIEW;3:PHYSICAL EXAMINATION;^0;6^Q "^DD",2,2.399,.395,3) Enter the Method of Determination of the Catastrophically Disabled status of the patient. "^DD",2,2.399,.395,21,0) ^.001^2^2^3140912^^ "^DD",2,2.399,.395,21,1,0) This sub-field stores the historical value of the PATIENT file's METHOD "^DD",2,2.399,.395,21,2,0) OF DETERMINATION field (#.395). "^DD",2,2.399,.395,"DT") 2990524 "^DD",2,2.399,.3951,0) DATE VETERAN REQUESTED CD EVAL^D^^0;8^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",2,2.399,.3951,3) Enter the Date the Veteran Requested CD Evaluation for CD History. "^DD",2,2.399,.3951,21,0) ^^1^1^3140912^ "^DD",2,2.399,.3951,21,1,0) Documents the Date the Veteran Requested CD Evaluation for CD History. "^DD",2,2.399,.3951,"DT") 3050915 "^DD",2,2.399,.3952,0) DATE FACILITY INITIATED REVIEW^D^^0;9^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",2,2.399,.3952,3) Enter the Date the Facility initiated the Catastrophically Disabled review for CD History. "^DD",2,2.399,.3952,21,0) ^^2^2^3140912^ "^DD",2,2.399,.3952,21,1,0) Documents the date the facility initiated the Catastrophically Disabled "^DD",2,2.399,.3952,21,2,0) review for CD History. "^DD",2,2.399,.3952,"DT") 3050915 "^DD",2,2.399,.3953,0) DATE VETERAN WAS NOTIFIED^D^^0;10^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",2,2.399,.3953,3) Enter the the date the Veteran was notified of the Catastrophically Disabled status for CD History. "^DD",2,2.399,.3953,21,0) ^.001^2^2^3140912^^ "^DD",2,2.399,.3953,21,1,0) Documents the date the Veteran was notified of the Catastrophically "^DD",2,2.399,.3953,21,2,0) Disabled status for CD History. "^DD",2,2.399,.3953,"DT") 3050915 "^DD",2,2.399,.396,0) CD REASON^2.409PA^^1;0 "^DD",2,2.399,.396,21,0) ^^1^1^3140912^ "^DD",2,2.399,.396,21,1,0) Documents the Catastrophically Disabled Reason for CD History. "^DD",2,2.401,0) CD DESCRIPTORS SUB-FIELD^^.01^1 "^DD",2,2.401,0,"DT") 3150317 "^DD",2,2.401,0,"IX","B",2.401,.01) "^DD",2,2.401,0,"NM","CD DESCRIPTORS") "^DD",2,2.401,0,"UP") 2 "^DD",2,2.401,.01,0) CD DESCRIPTORS^M*P27.17'^DGEN(27.17,^0;1^S DIC("S")="I $$TYPE^DGENA5(Y)=""DE""" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X "^DD",2,2.401,.01,1,0) ^.1 "^DD",2,2.401,.01,1,1,0) 2.401^B "^DD",2,2.401,.01,1,1,1) S ^DPT(DA(1),.401,"B",$E(X,1,30),DA)="" "^DD",2,2.401,.01,1,1,2) K ^DPT(DA(1),.401,"B",$E(X,1,30),DA) "^DD",2,2.401,.01,3) Enter a descriptor justifying a catastrophically disabled ruling. "^DD",2,2.401,.01,12) Only a valid descriptor may be selected. "^DD",2,2.401,.01,12.1) S DIC("S")="I $$TYPE^DGENA5(Y)=""DE""" "^DD",2,2.401,.01,21,0) ^^4^4^3150317^ "^DD",2,2.401,.01,21,1,0) Veterans having one of the following descriptors shall be determined "^DD",2,2.401,.01,21,2,0) Catastrophically Disabled. If medical examination shows the Veteran "^DD",2,2.401,.01,21,3,0) has Amputation, Disarticulation, or Detachment, it must involve more "^DD",2,2.401,.01,21,4,0) than one limb. "^DD",2,2.401,.01,"DT") 3150317 "^DD",2,2.409,0) CD REASON SUB-FIELD^^3^4 "^DD",2,2.409,0,"DT") 3140912 "^DD",2,2.409,0,"IX","B",2.409,.01) "^DD",2,2.409,0,"NM","CD REASON") "^DD",2,2.409,0,"UP") 2.399 "^DD",2,2.409,.01,0) CD REASON^P27.17'^DGEN(27.17,^0;1^Q "^DD",2,2.409,.01,1,0) ^.1 "^DD",2,2.409,.01,1,1,0) 2.409^B "^DD",2,2.409,.01,1,1,1) S ^DPT(DA(2),.399,DA(1),1,"B",$E(X,1,30),DA)="" "^DD",2,2.409,.01,1,1,2) K ^DPT(DA(2),.399,DA(1),1,"B",$E(X,1,30),DA) "^DD",2,2.409,.01,3) Enter the CD Reason for the CD History. "^DD",2,2.409,.01,21,0) ^^3^3^3140912^^ "^DD",2,2.409,.01,21,1,0) This sub-field will contain pointers to the CD REASONS file (#27.17), "^DD",2,2.409,.01,21,2,0) as well as the supporting data stored in the CD STATUS DIAGNOSES (#.396), "^DD",2,2.409,.01,21,3,0) PROCEDURES (#.397) and CONDITIONS (#.398) fields. "^DD",2,2.409,.01,"DT") 3140912 "^DD",2,2.409,1,0) AFFECTED EXTREMITY^S^RUE:RIGHT UPPER EXTREMITY;LUE:LEFT UPPER EXTREMITY;RLE:RIGHT LOWER EXTREMITY;LLE:LEFT LOWER EXTREMITY;BLE:Bilateral Lower Extremity;BLU:Bilateral Upper Extremity;^0;2^Q "^DD",2,2.409,1,3) Choose the affected extremity. "^DD",2,2.409,1,21,0) ^^1^1^3130828^ "^DD",2,2.409,1,21,1,0) This is the extremity affected by the CD. "^DD",2,2.409,1,"DT") 3130828 "^DD",2,2.409,2,0) SCORE^NJ3,0^^0;3^K:+X'=X!(X>100)!(X<0)!(X?.E1"."1N.N) X "^DD",2,2.409,2,3) Type a Number between 0 and 100, 0 Decimal Digits "^DD",2,2.409,2,21,0) ^^2^2^2990524^ "^DD",2,2.409,2,21,1,0) This field stores a historical value for the SCORE subfield (#1) of the "^DD",2,2.409,2,21,2,0) CD STATUS CONDITIONS field (#.398) of the PATIENT file (#2). "^DD",2,2.409,2,"DT") 2990524 "^DD",2,2.409,3,0) PERMANENT INDICATOR^S^1:PERMANENT;2:NOT PERMANENT;3:UNKNOWN;^0;4^Q "^DD",2,2.409,3,3) Enter the Permanent Indicator for CD History. "^DD",2,2.409,3,21,0) ^^2^2^2990524^ "^DD",2,2.409,3,21,1,0) This subfield stores a historical value of the PERMANENT INDICATOR subfield "^DD",2,2.409,3,21,2,0) (#2) of the CD STATUS CONDITIONS field (#.398) of the PATIENT file (#2). "^DD",2,2.409,3,"DT") 3140912 "^DD",27.17,27.17,0) FIELD^^8^10 "^DD",27.17,27.17,0,"DDA") N "^DD",27.17,27.17,0,"DT") 3140910 "^DD",27.17,27.17,0,"ID",3) S DIY=$S($D(@(DIC_(+Y)_",""0"")")):$P(^("0"),U,3),1:"") D NAME^DICM2 W ?35," ",DINAME,@("$E("_DIC_"Y,0),0)") "^DD",27.17,27.17,0,"ID",8) W ?45," ",$P(^(0),U,4) "^DD",27.17,27.17,0,"IX","B",27.17,.01) "^DD",27.17,27.17,0,"IX","C",27.17,8) "^DD",27.17,27.17,0,"NM","CATASTROPHIC DISABILITY REASONS") "^DD",27.17,27.17,0,"PT",2.396,.01) "^DD",27.17,27.17,0,"PT",2.397,.01) "^DD",27.17,27.17,0,"PT",2.398,.01) "^DD",27.17,27.17,0,"PT",2.401,.01) "^DD",27.17,27.17,0,"PT",2.409,.01) "^DD",27.17,27.17,0,"VRPK") DG "^DD",27.17,27.17,.01,0) NAME^RF^^0;1^K:$L(X)>80!($L(X)<3)!'(X'?1P.E) X "^DD",27.17,27.17,.01,1,0) ^.1 "^DD",27.17,27.17,.01,1,1,0) 27.17^B "^DD",27.17,27.17,.01,1,1,1) S ^DGEN(27.17,"B",$E($TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ"),1,30),DA)="" "^DD",27.17,27.17,.01,1,1,2) K ^DGEN(27.17,"B",$E($TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ"),1,30),DA) "^DD",27.17,27.17,.01,1,1,"DT") 2990621 "^DD",27.17,27.17,.01,3) Answer must be 3-80 characters in length. "^DD",27.17,27.17,.01,"DT") 2990621 "^DD",27.17,27.17,1,0) TYPE^RSI^P:PROCEDURE;D:DIAGNOSIS;C:CONDITION;DE:DESCRIPTOR;^0;2^Q "^DD",27.17,27.17,1,1,0) ^.1^^0 "^DD",27.17,27.17,1,3) Enter the correct type. "^DD",27.17,27.17,1,5,1,0) 27.17^3^1 "^DD",27.17,27.17,1,21,0) ^.001^3^3^3140910^^^ "^DD",27.17,27.17,1,21,1,0) This field contains the type of CATASTROPHIC DISABILITY REASON. The "^DD",27.17,27.17,1,21,2,0) PATIENT file uses this set of codes to screen out Diagnoses, Procedures, "^DD",27.17,27.17,1,21,3,0) Conditions and Descriptors in its fields .396, .397, .398 and .401. "^DD",27.17,27.17,1,"DT") 3140910 "^DD",27.17,27.17,3,0) ICD OR CPT CODE^VX^^0;3^Q "^DD",27.17,27.17,3,.1) "^DD",27.17,27.17,3,1,0) ^.1 "^DD",27.17,27.17,3,1,1,0) ^^TRIGGER^27.17^1 "^DD",27.17,27.17,3,1,1,1) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGEN(27.17,D0,0)):^(0),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(27.17,3,1,1,1.1) S DIH=$G(^DGEN(27.17,DIV(0),0)),DIV=X S $P(^(0),U,2)=DIV,DIH=27.17,DIG=1 D ^DICR "^DD",27.17,27.17,3,1,1,1.1) S X=DIV N DGP S DGP=$P($P(^DGEN(27.17,DA,0),U,3),";",2) S X=$S(DGP="ICD9(":"D",DGP="ICD0(":"P",DGP="ICPT(":"P",1:"") "^DD",27.17,27.17,3,1,1,2) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGEN(27.17,D0,0)):^(0),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" S DIH=$G(^DGEN(27.17,DIV(0),0)),DIV=X S $P(^(0),U,2)=DIV,DIH=27.17,DIG=1 D ^DICR "^DD",27.17,27.17,3,1,1,3) Do not Delete. "^DD",27.17,27.17,3,1,1,"%D",0) ^.101^2^2^3130604^^^ "^DD",27.17,27.17,3,1,1,"%D",1,0) This trigger populates the TYPE field to the correct value for any "^DD",27.17,27.17,3,1,1,"%D",2,0) Diagnosis or Procedure code entered. "^DD",27.17,27.17,3,1,1,"CREATE VALUE") N DGP S DGP=$P($P(^DGEN(27.17,DA,0),U,3),";",2) S X=$S(DGP="ICD9(":"D",DGP="ICD0(":"P",DGP="ICPT(":"P",1:"") "^DD",27.17,27.17,3,1,1,"DELETE VALUE") @ "^DD",27.17,27.17,3,1,1,"DT") 3120125 "^DD",27.17,27.17,3,1,1,"FIELD") TYPE "^DD",27.17,27.17,3,1,2,0) ^^TRIGGER^27.17^9 "^DD",27.17,27.17,3,1,2,1) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGEN(27.17,D0,0)):^(0),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y X ^DD(27.17,3,1,2,1.1) S DIH=$G(^DGEN(27.17,DIV(0),0)),DIV=X S $P(^(0),U,9)=DIV,DIH=27.17,DIG=9 D ^DICR "^DD",27.17,27.17,3,1,2,1.1) S X=DIV N DGP,DGIEN S DGP=$P($P(^DGEN(27.17,DA,0),U,3),";",2),DGIEN=+$P(^DGEN(27.17,DA,0),U,3) S X=$S(DGP="ICD9(":$$CSI^ICDEX(80,DGIEN),DGP="ICD0(":$$CSI^ICDEX(80.1,DGIEN),1:"") "^DD",27.17,27.17,3,1,2,2) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGEN(27.17,D0,0)):^(0),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y S X="" S DIH=$G(^DGEN(27.17,DIV(0),0)),DIV=X S $P(^(0),U,9)=DIV,DIH=27.17,DIG=9 D ^DICR "^DD",27.17,27.17,3,1,2,3) Do Not Delete "^DD",27.17,27.17,3,1,2,"%D",0) ^^1^1^3120130^ "^DD",27.17,27.17,3,1,2,"%D",1,0) This trigger updates the ICD VERSION field to the correct value. "^DD",27.17,27.17,3,1,2,"CREATE VALUE") N DGP,DGIEN S DGP=$P($P(^DGEN(27.17,DA,0),U,3),";",2),DGIEN=+$P(^DGEN(27.17,DA,0),U,3) S X=$S(DGP="ICD9(":$$CSI^ICDEX(80,DGIEN),DGP="ICD0(":$$CSI^ICDEX(80.1,DGIEN),1:"") "^DD",27.17,27.17,3,1,2,"DELETE VALUE") @ "^DD",27.17,27.17,3,1,2,"DT") 3120130 "^DD",27.17,27.17,3,1,2,"FIELD") ICD VERSION "^DD",27.17,27.17,3,3) Select an appropriate Diagnostic/Procedure code, if applicable. "^DD",27.17,27.17,3,21,0) ^.001^8^8^3120113^^^^ "^DD",27.17,27.17,3,21,1,0) If the type is "PROCEDURE" then this must be a CPT Code or an ICD "^DD",27.17,27.17,3,21,2,0) Operation/Procedure. If the type is "DIAGNOSIS" then this must be "^DD",27.17,27.17,3,21,3,0) an ICD Diagnosis. If the type is "CONDITION" then this "^DD",27.17,27.17,3,21,4,0) field must be blank. "^DD",27.17,27.17,3,21,5,0) "^DD",27.17,27.17,3,21,6,0) If this field contains an ICD Diagnosis or Procedure code "^DD",27.17,27.17,3,21,7,0) then the ICD VERSION field (#9) must point to the correct ICD "^DD",27.17,27.17,3,21,8,0) VERSION. "^DD",27.17,27.17,3,"DT") 3120130 "^DD",27.17,27.17,3,"V",0) ^.12P^3^3 "^DD",27.17,27.17,3,"V",1,0) 80^ICD Diagnostic Code^10^ICDDI^^n "^DD",27.17,27.17,3,"V",2,0) 80.1^ICD Operation/Procedure^20^ICDOP^^n "^DD",27.17,27.17,3,"V",3,0) 81^CPT Procedure^30^ICPT^^n "^DD",27.17,27.17,4,0) AFFECTED LIMB^27.174SA^^1;0 "^DD",27.17,27.17,4,21,0) ^^2^2^2990520^ "^DD",27.17,27.17,4,21,1,0) This set of codes determines to which limbs the procedure could apply. "^DD",27.17,27.17,4,21,2,0) A procedure cannot be entered for a limb that's not mentioned here. "^DD",27.17,27.17,5,0) TEST SCORE RANGE^F^^2;E1,245^K:$L(X)>250!($L(X)<1) X "^DD",27.17,27.17,5,3) Answer must be 1-250 characters in length. "^DD",27.17,27.17,5,9) @ "^DD",27.17,27.17,5,21,0) ^^4^4^2990608^^ "^DD",27.17,27.17,5,21,1,0) This field contains a MUMPS condition on the variables SCORE (patient's "^DD",27.17,27.17,5,21,2,0) score on the test) and PERM (permanent status indicator). If this "^DD",27.17,27.17,5,21,3,0) condition is true, then the patient meets the Catastrophic Disability "^DD",27.17,27.17,5,21,4,0) requirements for this test. "^DD",27.17,27.17,5,"DT") 2990520 "^DD",27.17,27.17,6,0) HELP TEXT^27.176^^3;0 "^DD",27.17,27.17,6,21,0) ^^2^2^2990520^ "^DD",27.17,27.17,6,21,1,0) This field contains help text that will be displayed to the user when "^DD",27.17,27.17,6,21,2,0) entering data in the PATIENT file (field #.398) for this condition. "^DD",27.17,27.17,7,0) VALIDATION^F^^4;E1,245^K:$L(X)>250!($L(X)<1) X "^DD",27.17,27.17,7,3) Answer must be 1-250 characters in length. "^DD",27.17,27.17,7,9) @ "^DD",27.17,27.17,7,21,0) ^^5^5^2990520^ "^DD",27.17,27.17,7,21,1,0) This field contains a MUMPS condition on the variable X to determine if "^DD",27.17,27.17,7,21,2,0) a test score entered by the user is valid or not. For example if you "^DD",27.17,27.17,7,21,3,0) specify X>10 here, then the user won't be able to enter a TEST SCORE "^DD",27.17,27.17,7,21,4,0) in the CD CONDITIONS field of the PATIENT file whose value is not "^DD",27.17,27.17,7,21,5,0) greater than 10. "^DD",27.17,27.17,7,"DT") 2990520 "^DD",27.17,27.17,8,0) HL7 TRANSMISSION VALUE^RF^^0;4^K:$L(X)>30!($L(X)<1) X "^DD",27.17,27.17,8,1,0) ^.1 "^DD",27.17,27.17,8,1,1,0) 27.17^C "^DD",27.17,27.17,8,1,1,1) S ^DGEN(27.17,"C",$E(X,1,30),DA)="" "^DD",27.17,27.17,8,1,1,2) K ^DGEN(27.17,"C",$E(X,1,30),DA) "^DD",27.17,27.17,8,1,1,"%D",0) ^^2^2^2990524^ "^DD",27.17,27.17,8,1,1,"%D",1,0) This cross-reference will facilitate lookup when HL7 messages are being "^DD",27.17,27.17,8,1,1,"%D",2,0) processed. "^DD",27.17,27.17,8,1,1,"DT") 2990524 "^DD",27.17,27.17,8,3) Answer must be 1-30 characters in length. "^DD",27.17,27.17,8,21,0) ^^2^2^2990524^ "^DD",27.17,27.17,8,21,1,0) This is the value that should be sent in HL7 messages (ZCD segment) "^DD",27.17,27.17,8,21,2,0) for this catastrophic disability reason. "^DD",27.17,27.17,8,"DT") 2990524 "^DD",27.17,27.17,9,0) ICD VERSION^P80.4'I^ICDS(^0;9^Q "^DD",27.17,27.17,9,3) Select the appropriate coding system for this entry. "^DD",27.17,27.17,9,5,1,0) 27.17^3^2 "^DD",27.17,27.17,9,21,0) ^.001^9^9^3120125^^^^ "^DD",27.17,27.17,9,21,1,0) Indicate the correct version of the ICD code for this entry. "^DD",27.17,27.17,9,21,2,0) "^DD",27.17,27.17,9,21,3,0) If the type "PROCEDURE" then indicate the correct version of ICD "^DD",27.17,27.17,9,21,4,0) Operation/Procedure "^DD",27.17,27.17,9,21,5,0) "^DD",27.17,27.17,9,21,6,0) If the type is "DIAGNOSIS" then indicate the correct version of ICD "^DD",27.17,27.17,9,21,7,0) Diagnosis. "^DD",27.17,27.17,9,21,8,0) "^DD",27.17,27.17,9,21,9,0) If the type is "CONDITION" then this field must be blank "^DD",27.17,27.17,9,"DT") 3120125 "^DD",27.17,27.17,10,0) LONG DESCRIPTION^F^^5;1^K:$L(X)>130!($L(X)<3) X "^DD",27.17,27.17,10,3) Answer must be 3-130 characters in length. "^DD",27.17,27.17,10,21,0) ^.001^1^1^3120620^^^^ "^DD",27.17,27.17,10,21,1,0) Enter the long description to be used for Diagnosis or Procedure codes. "^DD",27.17,27.17,10,"DT") 3111214 "^DD",27.17,27.174,0) AFFECTED LIMB SUB-FIELD^^.01^1 "^DD",27.17,27.174,0,"DT") 3140819 "^DD",27.17,27.174,0,"IX","B",27.174,.01) "^DD",27.17,27.174,0,"NM","AFFECTED LIMB") "^DD",27.17,27.174,0,"UP") 27.17 "^DD",27.17,27.174,.01,0) AFFECTED LIMB^MS^RUE:Right Upper Extremity;RLE:Right Lower Extremity;LUE:Left Upper Extremity;LLE:Left Lower Extremity;BLE:Bilateral Lower Extremity;BUE:Bilateral Upper Extremity;^0;1^Q "^DD",27.17,27.174,.01,1,0) ^.1 "^DD",27.17,27.174,.01,1,1,0) 27.174^B "^DD",27.17,27.174,.01,1,1,1) S ^DGEN(27.17,DA(1),1,"B",$E(X,1,30),DA)="" "^DD",27.17,27.174,.01,1,1,2) K ^DGEN(27.17,DA(1),1,"B",$E(X,1,30),DA) "^DD",27.17,27.174,.01,21,0) ^^4^4^2990514^^^^ "^DD",27.17,27.174,.01,21,1,0) For ICD Procedure Codes and CPT Codes, this field is used to define "^DD",27.17,27.174,.01,21,2,0) the acceptable extremities to which the code could apply. "^DD",27.17,27.174,.01,21,3,0) This field will also be used for V codes in the future. "^DD",27.17,27.174,.01,21,4,0) The field is not used for ICD Diagnostic codes. "^DD",27.17,27.174,.01,"DT") 3120103 "^DD",27.17,27.176,0) HELP TEXT SUB-FIELD^^.01^1 "^DD",27.17,27.176,0,"DT") 2990519 "^DD",27.17,27.176,0,"NM","HELP TEXT") "^DD",27.17,27.176,0,"UP") 27.17 "^DD",27.17,27.176,.01,0) HELP TEXT^WL^^0;1^Q "^DD",27.17,27.176,.01,"DT") 2990519 "^DD",38.6,38.6,0) FIELD^^50^8 "^DD",38.6,38.6,0,"DDA") N "^DD",38.6,38.6,0,"IX","B",38.6,.01) "^DD",38.6,38.6,0,"NM","INCONSISTENT DATA ELEMENTS") "^DD",38.6,38.6,0,"PT",38.51,.01) "^DD",38.6,38.6,0,"VRPK") IVM "^DD",38.6,38.6,.001,0) NUMBER^NJ3,0^^ ^K:+X'=X!(X>999)!(X<1)!(X?.E1"."1N.N) X "^DD",38.6,38.6,.001,3) TYPE A WHOLE NUMBER BETWEEN 1 AND 999 "^DD",38.6,38.6,.001,21,0) ^^5^5^2911211^ "^DD",38.6,38.6,.001,21,1,0) This field contains the internal entry number of the inconsistency. This "^DD",38.6,38.6,.001,21,2,0) number is used by the consistency checker routines to determine what action "^DD",38.6,38.6,.001,21,3,0) needs to be taken. Entries in this file must not be added nor altered in "^DD",38.6,38.6,.001,21,4,0) any way as this would cause the consistency checker functionality to act "^DD",38.6,38.6,.001,21,5,0) incorrectly. "^DD",38.6,38.6,.01,0) NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X?1A.E) X "^DD",38.6,38.6,.01,1,0) ^.1 "^DD",38.6,38.6,.01,1,1,0) 38.6^B "^DD",38.6,38.6,.01,1,1,1) S ^DGIN(38.6,"B",$E(X,1,30),DA)="" "^DD",38.6,38.6,.01,1,1,2) K ^DGIN(38.6,"B",$E(X,1,30),DA) "^DD",38.6,38.6,.01,3) ANSWER MUST BE 3-30 CHARACTERS IN LENGTH "^DD",38.6,38.6,.01,21,0) ^^4^4^2911211^ "^DD",38.6,38.6,.01,21,1,0) This field contains the name of the inconsistency that will be reported "^DD",38.6,38.6,.01,21,2,0) when utilizing various registration and consistency checker options. This "^DD",38.6,38.6,.01,21,3,0) name will appear on the screen and in a mailmessage should the inconsistency "^DD",38.6,38.6,.01,21,4,0) not be reported. "^DD",38.6,38.6,.01,"DT") 2870513 "^DD",38.6,38.6,2,0) TEXT^RF^^0;2^K:$L(X)>70!($L(X)<2) X "^DD",38.6,38.6,2,3) ANSWER MUST BE 2-70 CHARACTERS IN LENGTH "^DD",38.6,38.6,2,21,0) ^^2^2^2911211^ "^DD",38.6,38.6,2,21,1,0) Enter the text for this inconsistency. This text will display on the "^DD",38.6,38.6,2,21,2,0) inconsistent data reports. It describes how the inconsistency occurs. "^DD",38.6,38.6,2,"DT") 2870306 "^DD",38.6,38.6,3,0) KEY REQUIRED^RS^0:NO KEY REQUIRED;1:ELIGIBILITY VERIFIED;2:MONEY VERFIED;3:SERVICE VERIFIED;4:KEY ALWAYS REQUIRED;^0;3^Q "^DD",38.6,38.6,3,21,0) ^^8^8^2911211^ "^DD",38.6,38.6,3,21,1,0) Various entries in the PATIENT file become uneditable by certain hospital "^DD",38.6,38.6,3,21,2,0) personnel once the data has been verified. If the data has been verified, "^DD",38.6,38.6,3,21,3,0) the user must hold a key in order to make a change to it. If the "^DD",38.6,38.6,3,21,4,0) inconsistency in this file requires a user to hold a key to edit the data "^DD",38.6,38.6,3,21,5,0) once it has been verified, that key must be listed here. "^DD",38.6,38.6,3,21,6,0) "^DD",38.6,38.6,3,21,7,0) Altering of data in this field could cause data to be edited "^DD",38.6,38.6,3,21,8,0) inappropriately. This field should not be changed! "^DD",38.6,38.6,3,"DT") 2870312 "^DD",38.6,38.6,4,0) SET ELIG DR STRING^S^1:YES;0:NO;^0;4^Q "^DD",38.6,38.6,4,21,0) ^^10^10^2911211^ "^DD",38.6,38.6,4,21,1,0) If the data required to clean-up this inconsistency requires editing of "^DD",38.6,38.6,4,21,2,0) data that is related to eligibility, this field should be answered yes. "^DD",38.6,38.6,4,21,3,0) For example, if the inconsistency is 'SC PROMPT UNANSWERED', this field "^DD",38.6,38.6,4,21,4,0) would be yes because this prompt is required in order to select a "^DD",38.6,38.6,4,21,5,0) patient's eligibility. If this field is answered yes, all eligibility "^DD",38.6,38.6,4,21,6,0) related questions will also be asked. "^DD",38.6,38.6,4,21,7,0) "^DD",38.6,38.6,4,21,8,0) Data in this field must not be altered in any way or it could cause "^DD",38.6,38.6,4,21,9,0) inaccrarate patient data to be entered on your system. This data is "^DD",38.6,38.6,4,21,10,0) distributed and maintained by the MAS package. "^DD",38.6,38.6,4,"DT") 2870320 "^DD",38.6,38.6,5,0) CHECK/DON'T CHECK^S^0:CHECK;1:DON'T CHECK;^0;5^Q "^DD",38.6,38.6,5,21,0) ^^13^13^2920324^^^ "^DD",38.6,38.6,5,21,1,0) Answer '0' if you want to check this inconsistency locally or '1' "^DD",38.6,38.6,5,21,2,0) if you wish to ignore it whenever found. "^DD",38.6,38.6,5,21,3,0) "^DD",38.6,38.6,5,21,4,0) Most checks provide the ability for them to be turned off locally, however, "^DD",38.6,38.6,5,21,5,0) there are some consistency checks ('SC PROMPT UNANSWERED', for example) "^DD",38.6,38.6,5,21,6,0) which will always be turned on regardless of how this promt is answered. "^DD",38.6,38.6,5,21,7,0) "^DD",38.6,38.6,5,21,8,0) This field can be edited at the site level. "^DD",38.6,38.6,5,21,9,0) "^DD",38.6,38.6,5,21,10,0) The consistency checks that will always be on are 'VETERAN STATUS "^DD",38.6,38.6,5,21,11,0) UNSPECIFIED', 'SC PROMPT UNANSWERED', 'POS UNSPECIFIED', 'ELIG CODE "^DD",38.6,38.6,5,21,12,0) UNANSWERED', 'ELIG CODE INCONSISTENT', 'INSURANCE PROMPT UNANSWERED', "^DD",38.6,38.6,5,21,13,0) and 'EMPLOYMENT STATUS UNANSWERED'. "^DD",38.6,38.6,5,"DT") 2870513 "^DD",38.6,38.6,6,0) USE FOR Z07 CHECK^SI^0:NO;1:YES;^0;6^Q "^DD",38.6,38.6,6,23,0) ^.001^1^1^3081028^^ "^DD",38.6,38.6,6,23,1,0) "^DD",38.6,38.6,6,"DT") 3081028 "^DD",38.6,38.6,50,0) DESCRIPTION^38.61^^D;0 "^DD",38.6,38.6,50,21,0) ^^3^3^2911211^ "^DD",38.6,38.6,50,21,1,0) This field contains a full description of how the inconsistency is "^DD",38.6,38.6,50,21,2,0) created. This data is provided and maintained by the MAS package and "^DD",38.6,38.6,50,21,3,0) should not be altered at the site level. "^DD",38.6,38.61,0) DESCRIPTION SUB-FIELD^^.01^1 "^DD",38.6,38.61,0,"NM","DESCRIPTION") "^DD",38.6,38.61,0,"UP") 38.6 "^DD",38.6,38.61,.01,0) DESCRIPTION^W^^0;1^Q "^DD",38.6,38.61,.01,"DT") 2870513 "^DIC",27.17,27.17,0) CATASTROPHIC DISABILITY REASONS^27.17 "^DIC",27.17,27.17,0,"GL") ^DGEN(27.17, "^DIC",27.17,27.17,"%D",0) ^^4^4^2990617^^ "^DIC",27.17,27.17,"%D",1,0) THIS FILE SHOULD NOT BE MODIFIED BY USERS! "^DIC",27.17,27.17,"%D",2,0) Per the Enrollment Phase II SRS (section 6.8.1.2), this file has been "^DIC",27.17,27.17,"%D",3,0) added to store the acceptable reasons why a veteran may be classified "^DIC",27.17,27.17,"%D",4,0) as catastrophically disabled. "^DIC",27.17,"B","CATASTROPHIC DISABILITY REASONS",27.17) "^DIC",38.6,38.6,0) INCONSISTENT DATA ELEMENTS "^DIC",38.6,38.6,0,"GL") ^DGIN(38.6, "^DIC",38.6,38.6,"%D",0) ^^5^5^2911211^^ "^DIC",38.6,38.6,"%D",1,0) The INCONSISTENT DATA ELEMENTS file contains those entries which are "^DIC",38.6,38.6,"%D",2,0) checked by the MAS module consistency checker. Other than turning "^DIC",38.6,38.6,"%D",3,0) individual checks on or off the user should not alter or add to this "^DIC",38.6,38.6,"%D",4,0) file in any way. Making any modification to this file will definitely "^DIC",38.6,38.6,"%D",5,0) cause the consistency checker to function improperly. "^DIC",38.6,"B","INCONSISTENT DATA ELEMENTS",38.6) **INSTALL NAME** IVM*2.0*158 "BLD",9536,0) IVM*2.0*158^INCOME VERIFICATION MATCH^0^3150319^y "BLD",9536,1,0) ^^15^15^3141210^^ "BLD",9536,1,1,0) This patch modifies the Income Verification Match v2.0 application as "BLD",9536,1,2,0) described below: "BLD",9536,1,3,0) "BLD",9536,1,4,0) 1. If the VETERAN CATASTROPHICALLY DISABLED? (#.39) field of the "BLD",9536,1,5,0) PATIENT (#2) file equals "Y" and no CD DESCRIPTORS are on file, CD "BLD",9536,1,6,0) STATUS DIAGNOSES, CD STATUS PROCEDURES and CD STATUS CONDITIONS will be "BLD",9536,1,7,0) sent on the HL7 Z07 message. "BLD",9536,1,8,0) "BLD",9536,1,9,0) 2. If the VETERAN CATASTROPHICALLY DISABLED? (#.39) field of the PATIENT "BLD",9536,1,10,0) (#2) file equals "Y" and new CD STATUS DESCRIPTORS are on File, CD "BLD",9536,1,11,0) DESCRIPTORS in lieu of CD STATUS DIAGNOSES, CD STATUS PROCEDURES and CD "BLD",9536,1,12,0) STATUS CONDITIONS will be sent on the HL7 Z07 message. "BLD",9536,1,13,0) "BLD",9536,1,14,0) 3. If the VETERAN CATASTROPHICALLY DISABLED? (#.39) field of the PATIENT "BLD",9536,1,15,0) (#2) file equals "N", it will not send anything. "BLD",9536,4,0) ^9.64PA^^0 "BLD",9536,6) ^110 "BLD",9536,6.3) 44 "BLD",9536,"ABPKG") n "BLD",9536,"KRN",0) ^9.67PA^779.2^20 "BLD",9536,"KRN",.4,0) .4 "BLD",9536,"KRN",.4,"NM",0) ^9.68A^^ "BLD",9536,"KRN",.401,0) .401 "BLD",9536,"KRN",.402,0) .402 "BLD",9536,"KRN",.403,0) .403 "BLD",9536,"KRN",.5,0) .5 "BLD",9536,"KRN",.84,0) .84 "BLD",9536,"KRN",3.6,0) 3.6 "BLD",9536,"KRN",3.8,0) 3.8 "BLD",9536,"KRN",9.2,0) 9.2 "BLD",9536,"KRN",9.8,0) 9.8 "BLD",9536,"KRN",9.8,"NM",0) ^9.68A^2^1 "BLD",9536,"KRN",9.8,"NM",2,0) IVMZ7CCD^^0^B32237910 "BLD",9536,"KRN",9.8,"NM","B","IVMZ7CCD",2) "BLD",9536,"KRN",19,0) 19 "BLD",9536,"KRN",19.1,0) 19.1 "BLD",9536,"KRN",101,0) 101 "BLD",9536,"KRN",409.61,0) 409.61 "BLD",9536,"KRN",771,0) 771 "BLD",9536,"KRN",779.2,0) 779.2 "BLD",9536,"KRN",870,0) 870 "BLD",9536,"KRN",8989.51,0) 8989.51 "BLD",9536,"KRN",8989.52,0) 8989.52 "BLD",9536,"KRN",8994,0) 8994 "BLD",9536,"KRN","B",.4,.4) "BLD",9536,"KRN","B",.401,.401) "BLD",9536,"KRN","B",.402,.402) "BLD",9536,"KRN","B",.403,.403) "BLD",9536,"KRN","B",.5,.5) "BLD",9536,"KRN","B",.84,.84) "BLD",9536,"KRN","B",3.6,3.6) "BLD",9536,"KRN","B",3.8,3.8) "BLD",9536,"KRN","B",9.2,9.2) "BLD",9536,"KRN","B",9.8,9.8) "BLD",9536,"KRN","B",19,19) "BLD",9536,"KRN","B",19.1,19.1) "BLD",9536,"KRN","B",101,101) "BLD",9536,"KRN","B",409.61,409.61) "BLD",9536,"KRN","B",771,771) "BLD",9536,"KRN","B",779.2,779.2) "BLD",9536,"KRN","B",870,870) "BLD",9536,"KRN","B",8989.51,8989.51) "BLD",9536,"KRN","B",8989.52,8989.52) "BLD",9536,"KRN","B",8994,8994) "BLD",9536,"QUES",0) ^9.62^^ "BLD",9536,"REQB",0) ^9.611^3^1 "BLD",9536,"REQB",3,0) IVM*2.0*132^2 "BLD",9536,"REQB","B","IVM*2.0*132",3) "MBREQ") 0 "PKG",120,-1) 1^1 "PKG",120,0) INCOME VERIFICATION MATCH^IVM^IVM Software for interface with the IVM Center "PKG",120,20,0) ^9.402P^^ "PKG",120,22,0) ^9.49I^1^1 "PKG",120,22,1,0) 2.0^2941021^2960823 "PKG",120,22,1,"PAH",1,0) 158^3150319^101063 "PKG",120,22,1,"PAH",1,1,0) ^^15^15^3150319 "PKG",120,22,1,"PAH",1,1,1,0) This patch modifies the Income Verification Match v2.0 application as "PKG",120,22,1,"PAH",1,1,2,0) described below: "PKG",120,22,1,"PAH",1,1,3,0) "PKG",120,22,1,"PAH",1,1,4,0) 1. If the VETERAN CATASTROPHICALLY DISABLED? (#.39) field of the "PKG",120,22,1,"PAH",1,1,5,0) PATIENT (#2) file equals "Y" and no CD DESCRIPTORS are on file, CD "PKG",120,22,1,"PAH",1,1,6,0) STATUS DIAGNOSES, CD STATUS PROCEDURES and CD STATUS CONDITIONS will be "PKG",120,22,1,"PAH",1,1,7,0) sent on the HL7 Z07 message. "PKG",120,22,1,"PAH",1,1,8,0) "PKG",120,22,1,"PAH",1,1,9,0) 2. If the VETERAN CATASTROPHICALLY DISABLED? (#.39) field of the PATIENT "PKG",120,22,1,"PAH",1,1,10,0) (#2) file equals "Y" and new CD STATUS DESCRIPTORS are on File, CD "PKG",120,22,1,"PAH",1,1,11,0) DESCRIPTORS in lieu of CD STATUS DIAGNOSES, CD STATUS PROCEDURES and CD "PKG",120,22,1,"PAH",1,1,12,0) STATUS CONDITIONS will be sent on the HL7 Z07 message. "PKG",120,22,1,"PAH",1,1,13,0) "PKG",120,22,1,"PAH",1,1,14,0) 3. If the VETERAN CATASTROPHICALLY DISABLED? (#.39) field of the PATIENT "PKG",120,22,1,"PAH",1,1,15,0) (#2) file equals "N", it will not send anything. "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","IVMZ7CCD") 0^2^B32237910 "RTN","IVMZ7CCD",1,0) IVMZ7CCD ;BAJ,TGH - HL7 Z07 CONSISTENCY CHECKER -- CATASTROPHIC DISABILITY SUBROUTINE ; 11/9/05 9:30am "RTN","IVMZ7CCD",2,0) ;;2.0;INCOME VERIFICATION MATCH;**105,132,158**;JUL 8,1996;Build 44 "RTN","IVMZ7CCD",3,0) ; "RTN","IVMZ7CCD",4,0) ; Catastrophic Disability Consistency Checks "RTN","IVMZ7CCD",5,0) ; This routine checks the various elements of catastrophic disability information "RTN","IVMZ7CCD",6,0) ; prior to building a Z07 record. Any tests which fail consistency check will be "RTN","IVMZ7CCD",7,0) ; saved to the ^DGIN(38.6 record for the patient. "RTN","IVMZ7CCD",8,0) ; "RTN","IVMZ7CCD",9,0) ; "RTN","IVMZ7CCD",10,0) ; Must be called from entry point "RTN","IVMZ7CCD",11,0) Q "RTN","IVMZ7CCD",12,0) ; "RTN","IVMZ7CCD",13,0) EN(DFN) ; entry point. Patient DFN is sent from calling routine. "RTN","IVMZ7CCD",14,0) ; initialize working variables "RTN","IVMZ7CCD",15,0) N RULE,Y,DGCDIS,PASS,FILERR "RTN","IVMZ7CCD",16,0) ; patient array DGCDIS can be populated by a call to $$GET^DGENCDA(DFN,.DGCDIS) as follows: "RTN","IVMZ7CCD",17,0) ; "RTN","IVMZ7CCD",18,0) ; S PASS=$$GET^DGENCDA(DFN,.DGCDIS) "RTN","IVMZ7CCD",19,0) ; "RTN","IVMZ7CCD",20,0) ; and creates an array similar to this: "RTN","IVMZ7CCD",21,0) ; DGCDIS("BY")="DR. JOHN" "RTN","IVMZ7CCD",22,0) ; DGCDIS("COND",1)="48" "RTN","IVMZ7CCD",23,0) ; DGCDIS("DATE")="3050926" "RTN","IVMZ7CCD",24,0) ; DGCDIS("DIAG",1)="8" "RTN","IVMZ7CCD",25,0) ; DGCDIS("DTFACIRV")="" "RTN","IVMZ7CCD",26,0) ; DGCDIS("DTVETNOT")="" "RTN","IVMZ7CCD",27,0) ; DGCDIS("FACDET")="16660" "RTN","IVMZ7CCD",28,0) ; DGCDIS("METDET")="3" "RTN","IVMZ7CCD",29,0) ; DGCDIS("PERM",1)="1" "RTN","IVMZ7CCD",30,0) ; DGCDIS("REVDTE")="3050926" "RTN","IVMZ7CCD",31,0) ; DGCDIS("SCORE",1)="6" "RTN","IVMZ7CCD",32,0) ; DGCDIS("VCD")="Y" "RTN","IVMZ7CCD",33,0) ; DGCDIS("VETREQDT")="" "RTN","IVMZ7CCD",34,0) ; "RTN","IVMZ7CCD",35,0) ; if the patient has no CD data on file, the API will return the following: "RTN","IVMZ7CCD",36,0) ; DGCDIS="" "RTN","IVMZ7CCD",37,0) ; DGCDIS("BY")="" "RTN","IVMZ7CCD",38,0) ; DGCDIS("DATE")="" "RTN","IVMZ7CCD",39,0) ; DGCDIS("DTFACIRV")="" "RTN","IVMZ7CCD",40,0) ; DGCDIS("DTVETNOT")="" "RTN","IVMZ7CCD",41,0) ; DGCDIS("FACDET")="" "RTN","IVMZ7CCD",42,0) ; DGCDIS("METDET")="" "RTN","IVMZ7CCD",43,0) ; DGCDIS("REVDTE")="" "RTN","IVMZ7CCD",44,0) ; DGCDIS("VCD")="" "RTN","IVMZ7CCD",45,0) ; DGCDIS("VETREQDT")="" "RTN","IVMZ7CCD",46,0) ; "RTN","IVMZ7CCD",47,0) S PASS=$$GET^DGENCDA(DFN,.DGCDIS) "RTN","IVMZ7CCD",48,0) ; "RTN","IVMZ7CCD",49,0) ; In cases where patient is not listed as catastrophically disabled, routine should check to see if patient could potentially "RTN","IVMZ7CCD",50,0) ; qualify for CD. If patient qualifies and is not listed as CD, an inconsistency should be filed. Otherwise continue. "RTN","IVMZ7CCD",51,0) ; If patient is not listed as CD, regardless of potential, further checks are not necessary as the rest depend on CD="YES" "RTN","IVMZ7CCD",52,0) ; "RTN","IVMZ7CCD",53,0) I '$$CD(DGCDIS("VCD")="Y") D Q "RTN","IVMZ7CCD",54,0) . I $D(FILERR) D FILE "RTN","IVMZ7CCD",55,0) ; "RTN","IVMZ7CCD",56,0) ; loop through rules in INCONSISTENT DATA ELEMENTS file. "RTN","IVMZ7CCD",57,0) ; execute only the rules where CHECK/DON'T CHECK and INCLUDE IN Z07 CHECKS fields are turned ON. "RTN","IVMZ7CCD",58,0) ; "RTN","IVMZ7CCD",59,0) ; ***NOTE loop boundary (701-728) must be changed if rule numbers are added *** "RTN","IVMZ7CCD",60,0) F RULE=701:1:728 I $D(^DGIN(38.6,RULE)) D ;IVM*2.0*158 "RTN","IVMZ7CCD",61,0) . S Y=^DGIN(38.6,RULE,0) "RTN","IVMZ7CCD",62,0) . I $P(Y,"^",6) D @RULE "RTN","IVMZ7CCD",63,0) I $D(FILERR) D FILE "RTN","IVMZ7CCD",64,0) Q "RTN","IVMZ7CCD",65,0) ; "RTN","IVMZ7CCD",66,0) CD(VCD) ; Is Patient Catastrophically disabled? If not, we need to examine patient's record to see if qualified for CD "RTN","IVMZ7CCD",67,0) ; Whether qualified or not, if patient is listed as NOT CD, the rest of the rules should not be checked. Therefore, "RTN","IVMZ7CCD",68,0) ; if DGCDIS("VCD") does not = "Y" system will exit after this rule without checking any further. "RTN","IVMZ7CCD",69,0) I VCD Q 1 "RTN","IVMZ7CCD",70,0) I $$ISCD^DGENCDA1(.DGCDIS) S FILERR(720)="" "RTN","IVMZ7CCD",71,0) Q 0 "RTN","IVMZ7CCD",72,0) ; "RTN","IVMZ7CCD",73,0) 701 ;Catastrophic Disability 'Decided By' Cannot be 'HINQ' "RTN","IVMZ7CCD",74,0) I $G(DGCDIS("BY"))="HINQ" S FILERR(RULE)="" "RTN","IVMZ7CCD",75,0) Q "RTN","IVMZ7CCD",76,0) ; "RTN","IVMZ7CCD",77,0) 702 ;Catastrophic Disability 'Decided By' not valid "RTN","IVMZ7CCD",78,0) I ($L(DGCDIS("BY"))<3)!($L(DGCDIS("BY"))>35) S FILERR(RULE)="" "RTN","IVMZ7CCD",79,0) Q "RTN","IVMZ7CCD",80,0) 703 ;"Catastrophic Disability 'Decided By' required" "RTN","IVMZ7CCD",81,0) I $G(DGCDIS("BY"))="" S FILERR(RULE)="" "RTN","IVMZ7CCD",82,0) Q "RTN","IVMZ7CCD",83,0) ; "RTN","IVMZ7CCD",84,0) 704 ;"Catastrophic Disability Review Date Required" "RTN","IVMZ7CCD",85,0) I $G(DGCDIS("REVDTE"))="" S FILERR(RULE)="" "RTN","IVMZ7CCD",86,0) Q "RTN","IVMZ7CCD",87,0) ; "RTN","IVMZ7CCD",88,0) 705 ;"Catastrophic Disability Review Date Invalid" "RTN","IVMZ7CCD",89,0) N RESULT "RTN","IVMZ7CCD",90,0) D CHK^DIE(2,.394,,DGCDIS("REVDTE"),.RESULT) "RTN","IVMZ7CCD",91,0) I RESULT="^" S FILERR(RULE)="" "RTN","IVMZ7CCD",92,0) Q "RTN","IVMZ7CCD",93,0) ; "RTN","IVMZ7CCD",94,0) 706 ;"CD Condition Score not valid" "RTN","IVMZ7CCD",95,0) N ITEM,ERR "RTN","IVMZ7CCD",96,0) S ITEM="",ERR=0 "RTN","IVMZ7CCD",97,0) F S ITEM=$O(DGCDIS("COND",ITEM)) Q:ITEM="" D "RTN","IVMZ7CCD",98,0) . I '$$VALID^DGENA5(DGCDIS("COND",ITEM),$G(DGCDIS("SCORE",ITEM))) S ERR=1 "RTN","IVMZ7CCD",99,0) I ERR S FILERR(RULE)="" "RTN","IVMZ7CCD",100,0) Q "RTN","IVMZ7CCD",101,0) ; "RTN","IVMZ7CCD",102,0) 707 ;"CD Review Date greater than CD Date of Determination" "RTN","IVMZ7CCD",103,0) I $G(DGCDIS("REVDTE"))>$G(DGCDIS("DATE")) S FILERR(RULE)="" "RTN","IVMZ7CCD",104,0) Q "RTN","IVMZ7CCD",105,0) ; "RTN","IVMZ7CCD",106,0) 708 ;"CD Status Affected Extremity' Invalid" "RTN","IVMZ7CCD",107,0) N ITEM,EIEN,ERR "RTN","IVMZ7CCD",108,0) S ITEM="",ERR=0 "RTN","IVMZ7CCD",109,0) F S ITEM=$O(DGCDIS("PROC",ITEM)) Q:ITEM="" D "RTN","IVMZ7CCD",110,0) . S EIEN="" F S EIEN=$O(DGCDIS("EXT",ITEM,EIEN)) Q:EIEN="" D "RTN","IVMZ7CCD",111,0) . . I '$$LIMBOK^DGENA5(DGCDIS("PROC",ITEM),DGCDIS("EXT",ITEM,EIEN)) S ERR=1 "RTN","IVMZ7CCD",112,0) I ERR S FILERR(RULE)="" "RTN","IVMZ7CCD",113,0) Q "RTN","IVMZ7CCD",114,0) ; "RTN","IVMZ7CCD",115,0) 709 ;"CD Status Diagnoses' Not Valid" "RTN","IVMZ7CCD",116,0) ; .396 CD STATUS DIAGNOSES field (multiple): "RTN","IVMZ7CCD",117,0) N ITEM,ERR "RTN","IVMZ7CCD",118,0) S ITEM="",ERR=0 "RTN","IVMZ7CCD",119,0) F S ITEM=$O(DGCDIS("DIAG",ITEM)) Q:ITEM="" D "RTN","IVMZ7CCD",120,0) . I $$TYPE^DGENA5(DGCDIS("DIAG",ITEM))'="D" S ERR=1 "RTN","IVMZ7CCD",121,0) I ERR S FILERR(RULE)="" "RTN","IVMZ7CCD",122,0) Q "RTN","IVMZ7CCD",123,0) ; "RTN","IVMZ7CCD",124,0) 710 ;"'CD Status Procedure' Not Valid" "RTN","IVMZ7CCD",125,0) ; .397 CD STATUS PROCEDURES field (multiple): "RTN","IVMZ7CCD",126,0) N ITEM,ERR "RTN","IVMZ7CCD",127,0) S ITEM="",ERR=0 "RTN","IVMZ7CCD",128,0) F S ITEM=$O(DGCDIS("PROC",ITEM)) Q:ITEM="" D "RTN","IVMZ7CCD",129,0) . I $$TYPE^DGENA5(DGCDIS("PROC",ITEM))'="P" S ERR=1 "RTN","IVMZ7CCD",130,0) I ERR S FILERR(RULE)="" "RTN","IVMZ7CCD",131,0) Q "RTN","IVMZ7CCD",132,0) ; "RTN","IVMZ7CCD",133,0) 711 ;"No CD Status Reason is Present" "RTN","IVMZ7CCD",134,0) I '($D(DGCDIS("DIAG"))!$D(DGCDIS("PROC"))!$D(DGCDIS("COND"))!$D(DGCDIS("DESCR"))) S FILERR(RULE)="" "RTN","IVMZ7CCD",135,0) Q "RTN","IVMZ7CCD",136,0) ; "RTN","IVMZ7CCD",137,0) 712 ;"'Date Of Catastophic Disability Decision' Not Valid" "RTN","IVMZ7CCD",138,0) N RESULT,OK,EXTERNAL "RTN","IVMZ7CCD",139,0) S OK=0 "RTN","IVMZ7CCD",140,0) I $G(DGCDIS("DATE"))'="" S OK=1 D "RTN","IVMZ7CCD",141,0) . S EXTERNAL=$$EXTERNAL^DILFD(2,.392,"",DGCDIS("DATE")) "RTN","IVMZ7CCD",142,0) . I EXTERNAL="" S OK=0 Q "RTN","IVMZ7CCD",143,0) . D CHK^DIE(2,.392,,EXTERNAL,.RESULT) I RESULT="^" S OK=0 "RTN","IVMZ7CCD",144,0) I 'OK S FILERR(RULE)="" "RTN","IVMZ7CCD",145,0) Q "RTN","IVMZ7CCD",146,0) ; "RTN","IVMZ7CCD",147,0) 713 ;"'Date Of Catastophic Disability Decision' Required" "RTN","IVMZ7CCD",148,0) I $G(DGCDIS("DATE"))="" S FILERR(RULE)="" "RTN","IVMZ7CCD",149,0) Q "RTN","IVMZ7CCD",150,0) ; "RTN","IVMZ7CCD",151,0) 714 ;"'Facility Making Catastrophic Disability Determination' Not Valid" "RTN","IVMZ7CCD",152,0) I DGCDIS("VCD")'=""!(DGCDIS("FACDET")'=""),$$EXTERNAL^DILFD(2,.393,"",$G(DGCDIS("FACDET")))="" S FILERR(RULE)="" "RTN","IVMZ7CCD",153,0) Q "RTN","IVMZ7CCD",154,0) ; "RTN","IVMZ7CCD",155,0) 715 ;"'Method Of Determination' Is A Required Value" "RTN","IVMZ7CCD",156,0) I $G(DGCDIS("METDET"))="" S FILERR(RULE)="" "RTN","IVMZ7CCD",157,0) Q "RTN","IVMZ7CCD",158,0) ; "RTN","IVMZ7CCD",159,0) 716 ;"'Method Of Determination' Not Valid" "RTN","IVMZ7CCD",160,0) I ".2.3."'[("."_$G(DGCDIS("METDET"))_".") S FILERR(RULE)="" "RTN","IVMZ7CCD",161,0) Q "RTN","IVMZ7CCD",162,0) ; "RTN","IVMZ7CCD",163,0) 717 ;"Not Enough Diagnoses/Procedures/Conditions To Qualify For CD Status" "RTN","IVMZ7CCD",164,0) I '$$ISCD^DGENCDA1(.DGCDIS) S FILERR(RULE)="" "RTN","IVMZ7CCD",165,0) Q "RTN","IVMZ7CCD",166,0) ; "RTN","IVMZ7CCD",167,0) 718 ;"Permanent Status Indicator' Not Valid" "RTN","IVMZ7CCD",168,0) N ITEM "RTN","IVMZ7CCD",169,0) S ITEM="" F S ITEM=$O(DGCDIS("COND",ITEM)) Q:ITEM="" D "RTN","IVMZ7CCD",170,0) . I ".1.2.3."'[("."_DGCDIS("PERM",ITEM)_".") S FILERR(RULE)="" "RTN","IVMZ7CCD",171,0) Q "RTN","IVMZ7CCD",172,0) ; "RTN","IVMZ7CCD",173,0) 719 ;"'Veteran Catastrophically Disabled?' Field Must Have A Response" "RTN","IVMZ7CCD",174,0) ; .39 VETERAN CATASTROPHICALLY DISABLED? field. "RTN","IVMZ7CCD",175,0) I DGCDIS("VCD")="" S FILERR(RULE)="" "RTN","IVMZ7CCD",176,0) Q "RTN","IVMZ7CCD",177,0) ; "RTN","IVMZ7CCD",178,0) 720 ;"Veteran Has Enough Diagnoses/Procedures/Conditions To Qualify For CD Status" "RTN","IVMZ7CCD",179,0) ; We check this rule at the beginning of the routine. No need to check it here, "RTN","IVMZ7CCD",180,0) ; but we need the label as a place holder. "RTN","IVMZ7CCD",181,0) Q "RTN","IVMZ7CCD",182,0) ; "RTN","IVMZ7CCD",183,0) 723 ;"Catastrophic Disability Review date must be a precise date" "RTN","IVMZ7CCD",184,0) N RESULT "RTN","IVMZ7CCD",185,0) D CHK^DIE(2,.394,,DGCDIS("REVDTE"),.RESULT) "RTN","IVMZ7CCD",186,0) I RESULT="^" S FILERR(RULE)="" "RTN","IVMZ7CCD",187,0) Q "RTN","IVMZ7CCD",188,0) ; "RTN","IVMZ7CCD",189,0) 724 ;"Catastrophic Disability Date of Decision must be a precise date" "RTN","IVMZ7CCD",190,0) N RESULT "RTN","IVMZ7CCD",191,0) D CHK^DIE(2,.392,,DGCDIS("DATE"),.RESULT) "RTN","IVMZ7CCD",192,0) I RESULT="^" S FILERR(RULE)="" "RTN","IVMZ7CCD",193,0) Q "RTN","IVMZ7CCD",194,0) ; "RTN","IVMZ7CCD",195,0) 725 ;"Catastrophic Disability Procedure code must be accompanied with an Affected Extremity field" "RTN","IVMZ7CCD",196,0) ; Procedure list = DGCDIS("PROC",ITEM) "RTN","IVMZ7CCD",197,0) ; Affected Extremity list = DGCDIS("EXT",ITEM) "RTN","IVMZ7CCD",198,0) ; This tag makes sure that there is at least one Affected Extremity for each procedure code. "RTN","IVMZ7CCD",199,0) N ITEM,ERR "RTN","IVMZ7CCD",200,0) S ERR=0,ITEM="" "RTN","IVMZ7CCD",201,0) F S ITEM=$O(DGCDIS("PROC",ITEM)) Q:ITEM="" D "RTN","IVMZ7CCD",202,0) . I '$D(DGCDIS("EXT",ITEM)) S ERR=1 Q "RTN","IVMZ7CCD",203,0) . I $G(DGCDIS("EXT",ITEM))="" S ERR=1 "RTN","IVMZ7CCD",204,0) I ERR S FILERR(RULE)="" "RTN","IVMZ7CCD",205,0) Q "RTN","IVMZ7CCD",206,0) ; "RTN","IVMZ7CCD",207,0) 726 ;"Catastrophic Disablity condition code requires a Score field" "RTN","IVMZ7CCD",208,0) ; Condition list = DGCDIS("COND",ITEM) "RTN","IVMZ7CCD",209,0) ; Score list = DGCDIS("SCORE",ITEM) "RTN","IVMZ7CCD",210,0) N ITEM,ERR "RTN","IVMZ7CCD",211,0) S ERR=0,ITEM="" "RTN","IVMZ7CCD",212,0) F S ITEM=$O(DGCDIS("COND",ITEM)) Q:ITEM="" D "RTN","IVMZ7CCD",213,0) . I '$D(DGCDIS("SCORE",ITEM)) S ERR=1 Q "RTN","IVMZ7CCD",214,0) . I $G(DGCDIS("SCORE",ITEM))="" S ERR=1 "RTN","IVMZ7CCD",215,0) I ERR S FILERR(RULE)="" "RTN","IVMZ7CCD",216,0) Q "RTN","IVMZ7CCD",217,0) ; "RTN","IVMZ7CCD",218,0) 727 ;"'CD Status Descriptor' Not Valid" - IVM*2.0*158 "RTN","IVMZ7CCD",219,0) ; .401 CD STATUS DESCRIPTORS field (multiple): "RTN","IVMZ7CCD",220,0) N ITEM,ERR "RTN","IVMZ7CCD",221,0) S ITEM="",ERR=0 "RTN","IVMZ7CCD",222,0) F S ITEM=$O(DGCDIS("DESCR",ITEM)) Q:ITEM="" D "RTN","IVMZ7CCD",223,0) . I $$TYPE^DGENA5(DGCDIS("DESCR",ITEM))'="DE" S ERR=1 "RTN","IVMZ7CCD",224,0) I ERR S FILERR(RULE)="" "RTN","IVMZ7CCD",225,0) Q "RTN","IVMZ7CCD",226,0) ; "RTN","IVMZ7CCD",227,0) 728 ;"No 'CD Descriptors' Selected" - IVM*2.0*158 "RTN","IVMZ7CCD",228,0) I '($D(DGCDIS("DIAG"))!$D(DGCDIS("PROC"))!$D(DGCDIS("COND"))!$D(DGCDIS("DESCR"))) S FILERR(RULE)="" "RTN","IVMZ7CCD",229,0) Q "RTN","IVMZ7CCD",230,0) ; "RTN","IVMZ7CCD",231,0) FILE ;file the inconsistencies in a temp global "RTN","IVMZ7CCD",232,0) M ^TMP($J,DFN)=FILERR "RTN","IVMZ7CCD",233,0) Q "RTN","IVMZ7CCD",234,0) ; "VER") 8.0^22.0 **END** **END**