- 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 Jan 18, 2025@03:52:06 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