DGPT702 ;ALB/MTC,HIOFO/FT - Process 702 transmission ;4/14/2014 4:08pm
;;5.3;Registration;**884**;Aug 13, 1993;Build 31
;
;no external references
;
EN ;called from DGPTAE
S DGPTSTR=^TMP("AEDIT",$J,NODE,SEQ)
D:DGPTFMT=2 SET9
D:DGPTFMT=3 SET10
DIAG ;
S DGPTERC=0 D ^DGPT70DI
I 'DGPTERC W "."
;
EXIT ;
K DGPTGD2,DGPTGD3,DGPTGD4,DGPTGD5,DGPTGD6,DGPTGD7,DGPTGD8,DGPTGD9,DGPTGD10,DGPTGD11,DGPTGD12,DGPTGD13,DGPTGD14,DGPTGD15,DGPTGD16,DGPTGD17
K DGPTGD18,DGPTGD19,DGPTGD20,DGPTGD21,DGPTGD22,DGPTGD23,DGPTGD24,DGPTGD25,DGPTPOA2,DGPTPOA3,DGPTPOA4,DGPTPOA5,DGPTPOA6,DGPTPOA7
K DGPTPOA8,DGPTPOA9,DGPTPOA10,DGPTPOA11,DGPTPOA12,DGPTPOA13,DGPTPOA14,DGPTPOA15,DGPTPOA16,DGPTPOA17,DGPTPOA18,DGPTPOA19,DGPTPOA20,DGPTPOA21,DGPTPOA22
K DGPTPOA23,DGPTPOA24,DGPTPOA25,DGPTGD,DGPTSTR
Q
SET9 ;record layout before icd10 turned on
S DGPTGD1=$E(DGPTSTR,41,47) ;diagnostic codes 1 - 9, but why 1 when 1 is not in the 702 segment?
S DGPTGD2=$E(DGPTSTR,48,54) ;the values are checked in DGPT70DI and reset using indirection into the
S DGPTGD3=$E(DGPTSTR,55,61) ;variable name. also, the DGPTDIAR array(date)=procedure ien is set.
S DGPTGD4=$E(DGPTSTR,62,68)
S DGPTGD5=$E(DGPTSTR,69,75)
S DGPTGD6=$E(DGPTSTR,76,82)
S DGPTGD7=$E(DGPTSTR,83,89)
S DGPTGD8=$E(DGPTSTR,90,96)
S DGPTGD9=$E(DGPTSTR,97,103)
Q
SET10 ;record layout after icd10 turned on
S DGPTDOD=$E(DGPTSTR,31,36) ;date of discharge
S DGPTTOD=$E(DGPTSTR,37,40) ;time of discharge(24 hour time)
S DGPTGD2=$E(DGPTSTR,41,47),DGPTPOA2=$E(DGPTSTR,48) ;parse out the 24 secondary dx & poa codes
S DGPTGD3=$E(DGPTSTR,49,55),DGPTPOA3=$E(DGPTSTR,56)
S DGPTGD4=$E(DGPTSTR,57,63),DGPTPOA4=$E(DGPTSTR,64)
S DGPTGD5=$E(DGPTSTR,65,71),DGPTPOA5=$E(DGPTSTR,72)
S DGPTGD6=$E(DGPTSTR,73,79),DGPTPOA6=$E(DGPTSTR,80)
S DGPTGD7=$E(DGPTSTR,81,87),DGPTPOA7=$E(DGPTSTR,88)
S DGPTGD8=$E(DGPTSTR,89,95),DGPTPOA8=$E(DGPTSTR,96)
S DGPTGD9=$E(DGPTSTR,97,103),DGPTPOA9=$E(DGPTSTR,104)
S DGPTGD10=$E(DGPTSTR,105,111),DGPTPOA10=$E(DGPTSTR,112)
S DGPTGD11=$E(DGPTSTR,113,119),DGPTPOA11=$E(DGPTSTR,120)
S DGPTGD12=$E(DGPTSTR,121,127),DGPTPOA12=$E(DGPTSTR,128)
S DGPTGD13=$E(DGPTSTR,129,135),DGPTPOA13=$E(DGPTSTR,136)
S DGPTGD14=$E(DGPTSTR,137,143),DGPTPOA14=$E(DGPTSTR,144)
S DGPTGD15=$E(DGPTSTR,145,151),DGPTPOA15=$E(DGPTSTR,152)
S DGPTGD16=$E(DGPTSTR,153,159),DGPTPOA16=$E(DGPTSTR,160)
S DGPTGD17=$E(DGPTSTR,161,167),DGPTPOA17=$E(DGPTSTR,168)
S DGPTGD18=$E(DGPTSTR,169,175),DGPTPOA18=$E(DGPTSTR,176)
S DGPTGD19=$E(DGPTSTR,177,183),DGPTPOA19=$E(DGPTSTR,184)
S DGPTGD20=$E(DGPTSTR,185,191),DGPTPOA20=$E(DGPTSTR,192)
S DGPTGD21=$E(DGPTSTR,193,199),DGPTPOA21=$E(DGPTSTR,200)
S DGPTGD22=$E(DGPTSTR,201,207),DGPTPOA22=$E(DGPTSTR,208)
S DGPTGD23=$E(DGPTSTR,209,215),DGPTPOA23=$E(DGPTSTR,216)
S DGPTGD24=$E(DGPTSTR,217,223),DGPTPOA24=$E(DGPTSTR,224)
S DGPTGD25=$E(DGPTSTR,225,231),DGPTPOA25=$E(DGPTSTR,232)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPT702 2909 printed Oct 16, 2024@18:52 Page 2
DGPT702 ;ALB/MTC,HIOFO/FT - Process 702 transmission ;4/14/2014 4:08pm
+1 ;;5.3;Registration;**884**;Aug 13, 1993;Build 31
+2 ;
+3 ;no external references
+4 ;
EN ;called from DGPTAE
+1 SET DGPTSTR=^TMP("AEDIT",$JOB,NODE,SEQ)
+2 if DGPTFMT=2
DO SET9
+3 if DGPTFMT=3
DO SET10
DIAG ;
+1 SET DGPTERC=0
DO ^DGPT70DI
+2 IF 'DGPTERC
WRITE "."
+3 ;
EXIT ;
+1 KILL DGPTGD2,DGPTGD3,DGPTGD4,DGPTGD5,DGPTGD6,DGPTGD7,DGPTGD8,DGPTGD9,DGPTGD10,DGPTGD11,DGPTGD12,DGPTGD13,DGPTGD14,DGPTGD15,DGPTGD16,DGPTGD17
+2 KILL DGPTGD18,DGPTGD19,DGPTGD20,DGPTGD21,DGPTGD22,DGPTGD23,DGPTGD24,DGPTGD25,DGPTPOA2,DGPTPOA3,DGPTPOA4,DGPTPOA5,DGPTPOA6,DGPTPOA7
+3 KILL DGPTPOA8,DGPTPOA9,DGPTPOA10,DGPTPOA11,DGPTPOA12,DGPTPOA13,DGPTPOA14,DGPTPOA15,DGPTPOA16,DGPTPOA17,DGPTPOA18,DGPTPOA19,DGPTPOA20,DGPTPOA21,DGPTPOA22
+4 KILL DGPTPOA23,DGPTPOA24,DGPTPOA25,DGPTGD,DGPTSTR
+5 QUIT
SET9 ;record layout before icd10 turned on
+1 ;diagnostic codes 1 - 9, but why 1 when 1 is not in the 702 segment?
SET DGPTGD1=$EXTRACT(DGPTSTR,41,47)
+2 ;the values are checked in DGPT70DI and reset using indirection into the
SET DGPTGD2=$EXTRACT(DGPTSTR,48,54)
+3 ;variable name. also, the DGPTDIAR array(date)=procedure ien is set.
SET DGPTGD3=$EXTRACT(DGPTSTR,55,61)
+4 SET DGPTGD4=$EXTRACT(DGPTSTR,62,68)
+5 SET DGPTGD5=$EXTRACT(DGPTSTR,69,75)
+6 SET DGPTGD6=$EXTRACT(DGPTSTR,76,82)
+7 SET DGPTGD7=$EXTRACT(DGPTSTR,83,89)
+8 SET DGPTGD8=$EXTRACT(DGPTSTR,90,96)
+9 SET DGPTGD9=$EXTRACT(DGPTSTR,97,103)
+10 QUIT
SET10 ;record layout after icd10 turned on
+1 ;date of discharge
SET DGPTDOD=$EXTRACT(DGPTSTR,31,36)
+2 ;time of discharge(24 hour time)
SET DGPTTOD=$EXTRACT(DGPTSTR,37,40)
+3 ;parse out the 24 secondary dx & poa codes
SET DGPTGD2=$EXTRACT(DGPTSTR,41,47)
SET DGPTPOA2=$EXTRACT(DGPTSTR,48)
+4 SET DGPTGD3=$EXTRACT(DGPTSTR,49,55)
SET DGPTPOA3=$EXTRACT(DGPTSTR,56)
+5 SET DGPTGD4=$EXTRACT(DGPTSTR,57,63)
SET DGPTPOA4=$EXTRACT(DGPTSTR,64)
+6 SET DGPTGD5=$EXTRACT(DGPTSTR,65,71)
SET DGPTPOA5=$EXTRACT(DGPTSTR,72)
+7 SET DGPTGD6=$EXTRACT(DGPTSTR,73,79)
SET DGPTPOA6=$EXTRACT(DGPTSTR,80)
+8 SET DGPTGD7=$EXTRACT(DGPTSTR,81,87)
SET DGPTPOA7=$EXTRACT(DGPTSTR,88)
+9 SET DGPTGD8=$EXTRACT(DGPTSTR,89,95)
SET DGPTPOA8=$EXTRACT(DGPTSTR,96)
+10 SET DGPTGD9=$EXTRACT(DGPTSTR,97,103)
SET DGPTPOA9=$EXTRACT(DGPTSTR,104)
+11 SET DGPTGD10=$EXTRACT(DGPTSTR,105,111)
SET DGPTPOA10=$EXTRACT(DGPTSTR,112)
+12 SET DGPTGD11=$EXTRACT(DGPTSTR,113,119)
SET DGPTPOA11=$EXTRACT(DGPTSTR,120)
+13 SET DGPTGD12=$EXTRACT(DGPTSTR,121,127)
SET DGPTPOA12=$EXTRACT(DGPTSTR,128)
+14 SET DGPTGD13=$EXTRACT(DGPTSTR,129,135)
SET DGPTPOA13=$EXTRACT(DGPTSTR,136)
+15 SET DGPTGD14=$EXTRACT(DGPTSTR,137,143)
SET DGPTPOA14=$EXTRACT(DGPTSTR,144)
+16 SET DGPTGD15=$EXTRACT(DGPTSTR,145,151)
SET DGPTPOA15=$EXTRACT(DGPTSTR,152)
+17 SET DGPTGD16=$EXTRACT(DGPTSTR,153,159)
SET DGPTPOA16=$EXTRACT(DGPTSTR,160)
+18 SET DGPTGD17=$EXTRACT(DGPTSTR,161,167)
SET DGPTPOA17=$EXTRACT(DGPTSTR,168)
+19 SET DGPTGD18=$EXTRACT(DGPTSTR,169,175)
SET DGPTPOA18=$EXTRACT(DGPTSTR,176)
+20 SET DGPTGD19=$EXTRACT(DGPTSTR,177,183)
SET DGPTPOA19=$EXTRACT(DGPTSTR,184)
+21 SET DGPTGD20=$EXTRACT(DGPTSTR,185,191)
SET DGPTPOA20=$EXTRACT(DGPTSTR,192)
+22 SET DGPTGD21=$EXTRACT(DGPTSTR,193,199)
SET DGPTPOA21=$EXTRACT(DGPTSTR,200)
+23 SET DGPTGD22=$EXTRACT(DGPTSTR,201,207)
SET DGPTPOA22=$EXTRACT(DGPTSTR,208)
+24 SET DGPTGD23=$EXTRACT(DGPTSTR,209,215)
SET DGPTPOA23=$EXTRACT(DGPTSTR,216)
+25 SET DGPTGD24=$EXTRACT(DGPTSTR,217,223)
SET DGPTPOA24=$EXTRACT(DGPTSTR,224)
+26 SET DGPTGD25=$EXTRACT(DGPTSTR,225,231)
SET DGPTPOA25=$EXTRACT(DGPTSTR,232)
+27 QUIT
