DGPT701P ;ALB/MTC,HIOFO/FT - Parse 701 Record String ;2/23/15 9:20am
;;5.3;Registration;**164,415,884**;Aug 13, 1993;Build 31
;
EN ;
PARSE ; Parse record string
D:DGPTFMT=2 SET9
D:DGPTFMT=3 SET10
Q
SET9 ;record layout before icd10 turned on
S DGPTDDTD=$E(DGPTSTR,31,40) ;date of disposition
S DGPTDDS=$$FMDT^DGPT101($E(DGPTDDTD,1,6))_"."_$E(DGPTDDTD,7,10)
S DGPTDSP=$E(DGPTSTR,41,42) ;discharge specialty code
S DGPTDTY=$E(DGPTSTR,43) ;type of disposition
S DGPTDOP=$E(DGPTSTR,44) ;outpatient care status
S DGPTDVA=$E(DGPTSTR,45) ;under va auspices
S DGPTDPD=$E(DGPTSTR,46) ;place of disposition
S DGPTDRF=$E(DGPTSTR,47,52) ;receiving facility number and suffix
S DGPTDAS=$E(DGPTSTR,53,55) ;extended care days - absent sick in hospital
S DGPTDCP=$E(DGPTSTR,57) ;compensation & pension status
S DGPTDDXE=$E(DGPTSTR,58,64) ;dxls for entire stay
S DGPTDDXO=$E(DGPTSTR,65) ;present on admission (poa) for dxls
S DGPTDLR=$E(DGPTSTR,66,71) ;physical location cdr code
S DGPTDLC=$E(DGPTSTR,72,73) ;physical location code
S DGPTDSC=$E(DGPTSTR,74,76) ;percentage of service connection
S DGPT70LG=$E(DGPTSTR,77) ;legionnaires
S DGPT70SU=$E(DGPTSTR,78) ;suicide indicator
S DGPT70DR=$E(DGPTSTR,79,82) ;substance abuse
S DGPT70X4=$E(DGPTSTR,83) ;physical axis class
S DGPTDXV1=$E(DGPTSTR,84,85) ;physical axis assessment-1
S DGPTDXV2=$E(DGPTSTR,86,87) ;physical axis assessment-2
Q
SET10 ;record layout after icd10 turn on
S DGPTDDTD=$E(DGPTSTR,31,40) ;date of disposition
S DGPTDDS=$$FMDT^DGPT101($E(DGPTDDTD,1,6))_"."_$E(DGPTDDTD,7,10)
S DGPTDSP=$E(DGPTSTR,41,42) ;discharge specialty code
S DGPTDTY=$E(DGPTSTR,43) ;type of disposition
S DGPTDOP=$E(DGPTSTR,44) ;outpatient care status
S DGPTDVA=$E(DGPTSTR,45) ;under va auspices
S DGPTDPD=$E(DGPTSTR,46) ;place of disposition
S DGPTDRF=$E(DGPTSTR,47,52) ;receiving facility number and suffix
S DGPTDAS=$E(DGPTSTR,53,55) ;extended care days - absent sick in hospital
S DGPT70RACE=$E(DGPTSTR,56) ;race
S DGPTDCP=$E(DGPTSTR,57) ;compensation & pension status
S DGPTDDXE=$E(DGPTSTR,58,64) ;dxls for entire stay
S DGPTDXLSPOA=$E(DGPTSTR,65) ;poa for dxls
S DGPTDDXO=$E(DGPTSTR,66) ;dxls only no other codes
S DGPTDLR=$E(DGPTSTR,67,72) ;physical location cdr code
S DGPTDLC=$E(DGPTSTR,73,74) ;physical location code
S DGPTDSC=$E(DGPTSTR,75,77) ;percentage of service connection
S DGPT70LG=$E(DGPTSTR,78) ;legionnaires
S DGPT70SU=$E(DGPTSTR,79) ;suicide indicator
S DGPT70DR=$E(DGPTSTR,80,83) ;substance abuse
S DGPT70X4=$E(DGPTSTR,84) ;physical axis class <-no longer used with ICD10, should be a space. ft 11/3/14
S DGPTDXV2=$E(DGPTSTR,85,88) ;physical axis assessment 1 & 2 <-no longer used with ICD10, should be 4 spaces. ft 11/3/14
S DGPT70TSC=$E(DGPTSTR,89) ;treated for service condition
S DGPT70AO=$E(DGPTSTR,90) ;treated for agent orange condition
S DGPT70IR=$E(DGPTSTR,91) ;treated for ionizing radiation
S DGPT70SWA=$E(DGPTSTR,92) ;treated for sw asia condition
S DGPT70MST=$E(DGPTSTR,93) ;military sexual trauma care
S DGPT70HNC=$E(DGPTSTR,94) ;head neck cancer
S DGPT70ETHNIC=$E(DGPTSTR,95,96) ;ethnicity
S DGPT70RACE1=$E(DGPTSTR,97,98) ;race-1
S DGPT70RACE2=$E(DGPTSTR,99,100) ;race-2
S DGPT70RACE3=$E(DGPTSTR,101,102) ;race-3
S DGPT70RACE4=$E(DGPTSTR,103,104) ;race-4
S DGPT70RACE5=$E(DGPTSTR,105,106) ;race-5
S DGPT70RACE6=$E(DGPTSTR,107,108) ;race-6
S DGPT70COMVET=$E(DGPTSTR,109) ;combat veteran
S DGPT70SHAD=$E(DGPTSTR,110) ;shipboard hazard and defense
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPT701P 3559 printed Apr 09, 2024@21:40:12 Page 2
DGPT701P ;ALB/MTC,HIOFO/FT - Parse 701 Record String ;2/23/15 9:20am
+1 ;;5.3;Registration;**164,415,884**;Aug 13, 1993;Build 31
+2 ;
EN ;
PARSE ; Parse record string
+1 if DGPTFMT=2
DO SET9
+2 if DGPTFMT=3
DO SET10
+3 QUIT
SET9 ;record layout before icd10 turned on
+1 ;date of disposition
SET DGPTDDTD=$EXTRACT(DGPTSTR,31,40)
+2 SET DGPTDDS=$$FMDT^DGPT101($EXTRACT(DGPTDDTD,1,6))_"."_$EXTRACT(DGPTDDTD,7,10)
+3 ;discharge specialty code
SET DGPTDSP=$EXTRACT(DGPTSTR,41,42)
+4 ;type of disposition
SET DGPTDTY=$EXTRACT(DGPTSTR,43)
+5 ;outpatient care status
SET DGPTDOP=$EXTRACT(DGPTSTR,44)
+6 ;under va auspices
SET DGPTDVA=$EXTRACT(DGPTSTR,45)
+7 ;place of disposition
SET DGPTDPD=$EXTRACT(DGPTSTR,46)
+8 ;receiving facility number and suffix
SET DGPTDRF=$EXTRACT(DGPTSTR,47,52)
+9 ;extended care days - absent sick in hospital
SET DGPTDAS=$EXTRACT(DGPTSTR,53,55)
+10 ;compensation & pension status
SET DGPTDCP=$EXTRACT(DGPTSTR,57)
+11 ;dxls for entire stay
SET DGPTDDXE=$EXTRACT(DGPTSTR,58,64)
+12 ;present on admission (poa) for dxls
SET DGPTDDXO=$EXTRACT(DGPTSTR,65)
+13 ;physical location cdr code
SET DGPTDLR=$EXTRACT(DGPTSTR,66,71)
+14 ;physical location code
SET DGPTDLC=$EXTRACT(DGPTSTR,72,73)
+15 ;percentage of service connection
SET DGPTDSC=$EXTRACT(DGPTSTR,74,76)
+16 ;legionnaires
SET DGPT70LG=$EXTRACT(DGPTSTR,77)
+17 ;suicide indicator
SET DGPT70SU=$EXTRACT(DGPTSTR,78)
+18 ;substance abuse
SET DGPT70DR=$EXTRACT(DGPTSTR,79,82)
+19 ;physical axis class
SET DGPT70X4=$EXTRACT(DGPTSTR,83)
+20 ;physical axis assessment-1
SET DGPTDXV1=$EXTRACT(DGPTSTR,84,85)
+21 ;physical axis assessment-2
SET DGPTDXV2=$EXTRACT(DGPTSTR,86,87)
+22 QUIT
SET10 ;record layout after icd10 turn on
+1 ;date of disposition
SET DGPTDDTD=$EXTRACT(DGPTSTR,31,40)
+2 SET DGPTDDS=$$FMDT^DGPT101($EXTRACT(DGPTDDTD,1,6))_"."_$EXTRACT(DGPTDDTD,7,10)
+3 ;discharge specialty code
SET DGPTDSP=$EXTRACT(DGPTSTR,41,42)
+4 ;type of disposition
SET DGPTDTY=$EXTRACT(DGPTSTR,43)
+5 ;outpatient care status
SET DGPTDOP=$EXTRACT(DGPTSTR,44)
+6 ;under va auspices
SET DGPTDVA=$EXTRACT(DGPTSTR,45)
+7 ;place of disposition
SET DGPTDPD=$EXTRACT(DGPTSTR,46)
+8 ;receiving facility number and suffix
SET DGPTDRF=$EXTRACT(DGPTSTR,47,52)
+9 ;extended care days - absent sick in hospital
SET DGPTDAS=$EXTRACT(DGPTSTR,53,55)
+10 ;race
SET DGPT70RACE=$EXTRACT(DGPTSTR,56)
+11 ;compensation & pension status
SET DGPTDCP=$EXTRACT(DGPTSTR,57)
+12 ;dxls for entire stay
SET DGPTDDXE=$EXTRACT(DGPTSTR,58,64)
+13 ;poa for dxls
SET DGPTDXLSPOA=$EXTRACT(DGPTSTR,65)
+14 ;dxls only no other codes
SET DGPTDDXO=$EXTRACT(DGPTSTR,66)
+15 ;physical location cdr code
SET DGPTDLR=$EXTRACT(DGPTSTR,67,72)
+16 ;physical location code
SET DGPTDLC=$EXTRACT(DGPTSTR,73,74)
+17 ;percentage of service connection
SET DGPTDSC=$EXTRACT(DGPTSTR,75,77)
+18 ;legionnaires
SET DGPT70LG=$EXTRACT(DGPTSTR,78)
+19 ;suicide indicator
SET DGPT70SU=$EXTRACT(DGPTSTR,79)
+20 ;substance abuse
SET DGPT70DR=$EXTRACT(DGPTSTR,80,83)
+21 ;physical axis class <-no longer used with ICD10, should be a space. ft 11/3/14
SET DGPT70X4=$EXTRACT(DGPTSTR,84)
+22 ;physical axis assessment 1 & 2 <-no longer used with ICD10, should be 4 spaces. ft 11/3/14
SET DGPTDXV2=$EXTRACT(DGPTSTR,85,88)
+23 ;treated for service condition
SET DGPT70TSC=$EXTRACT(DGPTSTR,89)
+24 ;treated for agent orange condition
SET DGPT70AO=$EXTRACT(DGPTSTR,90)
+25 ;treated for ionizing radiation
SET DGPT70IR=$EXTRACT(DGPTSTR,91)
+26 ;treated for sw asia condition
SET DGPT70SWA=$EXTRACT(DGPTSTR,92)
+27 ;military sexual trauma care
SET DGPT70MST=$EXTRACT(DGPTSTR,93)
+28 ;head neck cancer
SET DGPT70HNC=$EXTRACT(DGPTSTR,94)
+29 ;ethnicity
SET DGPT70ETHNIC=$EXTRACT(DGPTSTR,95,96)
+30 ;race-1
SET DGPT70RACE1=$EXTRACT(DGPTSTR,97,98)
+31 ;race-2
SET DGPT70RACE2=$EXTRACT(DGPTSTR,99,100)
+32 ;race-3
SET DGPT70RACE3=$EXTRACT(DGPTSTR,101,102)
+33 ;race-4
SET DGPT70RACE4=$EXTRACT(DGPTSTR,103,104)
+34 ;race-5
SET DGPT70RACE5=$EXTRACT(DGPTSTR,105,106)
+35 ;race-6
SET DGPT70RACE6=$EXTRACT(DGPTSTR,107,108)
+36 ;combat veteran
SET DGPT70COMVET=$EXTRACT(DGPTSTR,109)
+37 ;shipboard hazard and defense
SET DGPT70SHAD=$EXTRACT(DGPTSTR,110)
+38 QUIT
