DGPTAEE1 ;ALB/MTC,HIOFO/FT - Austin Edits EAL Listing Continued ;12/4/14 3:05pm
;;5.3;Registration;**338,565,678,729,664,884**;Aug 13, 1993;Build 31
;
;no external references
;
;DGPTLINE=1 is icd9 layout
;DGPTLINE=2 is icd10 layout
H101(REC) ;-- 101 header //patch 850 made the needed changes for 101 so 884 did have to modify this subrtn. ft 12/2/14
; INPUT : REC - Node that contains the error
N I,X,X1,X2
S X="ADM SSN ADM-DATE-TIME LAST-NAME INIT SOU FROM SOP POW MS SX"
S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
S X=$E(REC,1,4)_" "_$E(REC,5,14)_SP_$E(REC,15,16)_SP_$E(REC,17,18)_SP_$E(REC,19,20)_SP_$E(REC,21,24)_SP_$E(REC,31,42)_" "_$E(REC,43,44)_" "_$E(REC,45,46)_SP_$E(REC,47,52)_SP_$E(REC,53)_" "_$E(REC,54)_" "_$E(REC,55)_" "_$E(REC,56)
S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")<12 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80)
S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
S X="BIRTHDATE POS AGO ION ST-CNTY ZIP MT INCOME MST CV CV-END SHAD ERI CNTRY"
S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
S X=$E(REC,57,58)_SP_$E(REC,59,60)_SP_$E(REC,61,64)_" "_$E(REC,65,66)_" "_$E(REC,67)_" "_$E(REC,68)_" "_$E(REC,69,73)_" "_$E(REC,74,78)_" "_$E(REC,79,80)_SP_$E(REC,81,86)_" "_$E(REC,87)_" "_$E(REC,88)_" "_$E(REC,89,94)
S X=X_" "_$E(REC,95)_" "_$E(REC,96)_" "_$E(REC,97,99)
S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")>11 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80)
S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
D WRER^DGPTAEE
Q
;
H401(REC) ;-- 401 header
; INPUT : REC - Node that contains the error
N X,X1,X2
S X="SURG SSN ADM-DATE-TIME SURG-DATE-TIME SPEC CATEG TECH SOP"
S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
S X=$E(REC,1,4)_" "_$E(REC,5,14)_SP_$E(REC,15,16)_SP_$E(REC,17,18)_SP_$E(REC,19,20)_SP_$E(REC,21,24)_" "_$E(REC,31,32)_SP_$E(REC,33,34)_SP_$E(REC,35,36)_SP_$E(REC,37,40)_" "
S X=X_$E(REC,41,42)_" "_$E(REC,43)_" "_$E(REC,44)_" "_$E(REC,45)_" "_$E(REC,46)
S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")<9 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80)
S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
I DGPTLINE=1 D ;icd9 layout. ft 12/2/14
.S X="------------SURGICAL CODES------------- PHY SSN TRNSPLNT"
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,47,53)_SP_$E(REC,54,60)_SP_$E(REC,61,67)_SP_$E(REC,68,74)_SP_$E(REC,75,81)_" "_$E(REC,82,90)_" "_$E(REC,91)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")>8 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
I DGPTLINE=2 D ;icd10 layout. ft 12/2/14
.S X="------------SURGICAL CODES-------------"
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,47,53)_SP_$E(REC,55,61)_SP_$E(REC,63,69)_SP_$E(REC,71,77)_SP_$E(REC,79,85)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,87,93)_SP_$E(REC,95,101)_SP_$E(REC,103,109)_SP_$E(REC,111,117)_SP_$E(REC,119,125)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,127,133)_SP_$E(REC,135,141)_SP_$E(REC,143,149)_SP_$E(REC,151,157)_SP_$E(REC,159,167)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,167,173)_SP_$E(REC,175,181)_SP_$E(REC,183,189)_SP_$E(REC,191,197)_SP_$E(REC,199,205)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,207,213)_SP_$E(REC,215,221)_SP_$E(REC,223,229)_SP_$E(REC,231,237)_SP_$E(REC,239,246)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")>8 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
D WRER^DGPTAEE
Q
;
H501(REC) ;-- 501 header
; INPUT : REC - Node that contains the error
N X,X1,X2
S X="DIAG SSN ADM-DATE-TIME MOVE DATE-TIME MPCR CODE SPC LVE PASS SCI"
S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
S X=$E(REC,1,4)_" "_$E(REC,5,14)_SP_$E(REC,15,16)_SP_$E(REC,17,18)_SP_$E(REC,19,20)_SP_$E(REC,21,24)_SP_$E(REC,31,32)_SP_$E(REC,33,34)_SP_$E(REC,35,36)_SP_$E(REC,37,40)_SP
S X=X_" "_$E(REC,41,46)_" "_$E(REC,47,48)_" "_$E(REC,49,51)_" "_$E(REC,52,54)_" "_$E(REC,55)
S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")<10 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80)
S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
I DGPTLINE=1 D ;icd9 layout. ft 12/2/14
.S X="-----------DIAGNOSTIC CODES------------"
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,56,62)_SP_$E(REC,63,69)_SP_$E(REC,70,76)_SP_$E(REC,77,83)_SP_$E(REC,84,90)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")=10 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X="SSN ATTY PHY PHY LOC CDE BSI LI SI DRUG A4 A5 SC AO IR SWAC"
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,91,99)_" "_$E(REC,100,105)_" "_$E(REC,106,107)_" "_$E(REC,108)_" "_$E(REC,109)_" "_$E(REC,110)_SP_$E(REC,111,114)_" "_$E(REC,115)_SP_$E(REC,116,119)_" "_$E(REC,120)_" "_$E(REC,121)_" "_$E(REC,122)_" "_$E(REC,123)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")>10 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
I DGPTLINE=2 D ;icd10 layout. ft 12/2/14
.S X="-----------DIAGNOSTIC CODES------------"
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,56,63)_SP_$E(REC,64,71)_SP_$E(REC,72,79)_SP_$E(REC,80,87)_SP_$E(REC,88,95)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,96,103)_SP_$E(REC,104,111)_SP_$E(REC,112,119)_SP_$E(REC,120,127)_SP_$E(REC,128,135)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,136,143)_SP_$E(REC,144,151)_SP_$E(REC,152,159)_SP_$E(REC,160,167)_SP_$E(REC,168,175)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,176,183)_SP_$E(REC,184,191)_SP_$E(REC,192,199)_SP_$E(REC,200,207)_SP_$E(REC,208,215)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X=$E(REC,216,223)_SP_$E(REC,224,231)_SP_$E(REC,232,239)_SP_$E(REC,240,247)_SP_$E(REC,248,255)_SP_$E(REC,265,270)_SP_$E(REC,271,272)_SP_$E(REC,273)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
.S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")>9 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80)
.S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X
D WRER^DGPTAEE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTAEE1 6888 printed Dec 13, 2024@02:51:35 Page 2
DGPTAEE1 ;ALB/MTC,HIOFO/FT - Austin Edits EAL Listing Continued ;12/4/14 3:05pm
+1 ;;5.3;Registration;**338,565,678,729,664,884**;Aug 13, 1993;Build 31
+2 ;
+3 ;no external references
+4 ;
+5 ;DGPTLINE=1 is icd9 layout
+6 ;DGPTLINE=2 is icd10 layout
H101(REC) ;-- 101 header //patch 850 made the needed changes for 101 so 884 did have to modify this subrtn. ft 12/2/14
+1 ; INPUT : REC - Node that contains the error
+2 NEW I,X,X1,X2
+3 SET X="ADM SSN ADM-DATE-TIME LAST-NAME INIT SOU FROM SOP POW MS SX"
+4 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+5 SET X=$EXTRACT(REC,1,4)_" "_$EXTRACT(REC,5,14)_SP_...
SET $EXTRACT(REC,15,16)_SP_$EXTRACT(REC,17,18)_SP_$EXTRACT(REC,19,20)_SP_$EXTRACT(REC,21,24)_SP_$EXTRACT(REC,31,42)_" "_$EXTRACT(REC,43,44)_" "_$EXTRACT(REC,45,46)_SP_$EXTRACT(REC,47,52)_SP_...
... $EXTRACT(REC,53)_" "_$EXTRACT(REC,54)_" "_$EXTRACT(REC,55)_" "_$EXTRACT(REC,56)
+6 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+7 SET X=""
SET $PIECE(X," ",80)=" "
FOR X1=1:1
SET I=$PIECE(DGER,",",X1)
if I=""
QUIT
IF $PIECE(I,":")<12
SET X2=+$PIECE(I,":",2)
SET X=$EXTRACT(X,1,X2-1)_"#"_$EXTRACT(X,X2+1,80)
+8 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+9 SET X="BIRTHDATE POS AGO ION ST-CNTY ZIP MT INCOME MST CV CV-END SHAD ERI CNTRY"
+10 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+11 SET X=$EXTRACT(REC,57,58)_SP_$EXTRACT(REC,59,60)_SP_$EXTRACT(REC,61,64)_" "_...
... $EXTRACT(REC,65,66)_" "_$EXTRACT(REC,67)_" "_$EXTRACT(REC,68)_" "_$EXTRACT(REC,69,73)_" "_$EXTRACT(REC,74,78)_" "_$EXTRACT(REC,79,80)_SP_$EXTRACT(REC,81,86)_" "_$EXTRACT(REC,87)_" "_$EXTRACT(REC,88)_" "_$EXTRACT(REC,89,94)
+12 SET X=X_" "_$EXTRACT(REC,95)_" "_$EXTRACT(REC,96)_" "_$EXTRACT(REC,97,99)
+13 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+14 SET X=""
SET $PIECE(X," ",80)=" "
FOR X1=1:1
SET I=$PIECE(DGER,",",X1)
if I=""
QUIT
IF $PIECE(I,":")>11
SET X2=+$PIECE(I,":",2)
SET X=$EXTRACT(X,1,X2-1)_"#"_$EXTRACT(X,X2+1,80)
+15 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+16 DO WRER^DGPTAEE
+17 QUIT
+18 ;
H401(REC) ;-- 401 header
+1 ; INPUT : REC - Node that contains the error
+2 NEW X,X1,X2
+3 SET X="SURG SSN ADM-DATE-TIME SURG-DATE-TIME SPEC CATEG TECH SOP"
+4 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+5 SET X=$EXTRACT(REC,1,4)_" "_$EXTRACT(REC,5,14)_SP_$EXTRACT(REC,15,16)_SP_$EXTRACT(REC,17,18)_SP_$EXTRACT(REC,19,20)_SP_$EXTRACT(REC,21,24)_" "_$EXTRACT(REC,31,32)_SP_$EXTRACT(REC,33,34)_SP_$EXTRACT(REC,35,36)_SP_$EXTRACT(REC,37,40)_" "
+6 SET X=X_$EXTRACT(REC,41,42)_" "_$EXTRACT(REC,43)_" "_$EXTRACT(REC,44)_" "_$EXTRACT(REC,45)_" "_$EXTRACT(REC,46)
+7 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+8 SET X=""
SET $PIECE(X," ",80)=" "
FOR X1=1:1
SET I=$PIECE(DGER,",",X1)
if I=""
QUIT
IF $PIECE(I,":")<9
SET X2=+$PIECE(I,":",2)
SET X=$EXTRACT(X,1,X2-1)_"#"_$EXTRACT(X,X2+1,80)
+9 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+10 ;icd9 layout. ft 12/2/14
IF DGPTLINE=1
Begin DoDot:1
+11 SET X="------------SURGICAL CODES------------- PHY SSN TRNSPLNT"
+12 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+13 SET X=$EXTRACT(REC,47,53)_SP_$EXTRACT(REC,54,60)_SP_$EXTRACT(REC,61,67)_SP_$EXTRACT(REC,68,74)_SP_$EXTRACT(REC,75,81)_" "_$EXTRACT(REC,82,90)_" "_$EXTRACT(REC,91)
+14 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+15 SET X=""
SET $PIECE(X," ",80)=" "
FOR X1=1:1
SET I=$PIECE(DGER,",",X1)
if I=""
QUIT
IF $PIECE(I,":")>8
SET X2=+$PIECE(I,":",2)
SET X=$EXTRACT(X,1,X2-1)_"#"_$EXTRACT(X,X2+1,80)
+16 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
End DoDot:1
+17 ;icd10 layout. ft 12/2/14
IF DGPTLINE=2
Begin DoDot:1
+18 SET X="------------SURGICAL CODES-------------"
+19 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+20 SET X=$EXTRACT(REC,47,53)_SP_$EXTRACT(REC,55,61)_SP_$EXTRACT(REC,63,69)_SP_$EXTRACT(REC,71,77)_SP_$EXTRACT(REC,79,85)
+21 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+22 SET X=$EXTRACT(REC,87,93)_SP_$EXTRACT(REC,95,101)_SP_$EXTRACT(REC,103,109)_SP_$EXTRACT(REC,111,117)_SP_$EXTRACT(REC,119,125)
+23 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+24 SET X=$EXTRACT(REC,127,133)_SP_$EXTRACT(REC,135,141)_SP_$EXTRACT(REC,143,149)_SP_$EXTRACT(REC,151,157)_SP_$EXTRACT(REC,159,167)
+25 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+26 SET X=$EXTRACT(REC,167,173)_SP_$EXTRACT(REC,175,181)_SP_$EXTRACT(REC,183,189)_SP_$EXTRACT(REC,191,197)_SP_$EXTRACT(REC,199,205)
+27 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+28 SET X=$EXTRACT(REC,207,213)_SP_$EXTRACT(REC,215,221)_SP_$EXTRACT(REC,223,229)_SP_$EXTRACT(REC,231,237)_SP_$EXTRACT(REC,239,246)
+29 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+30 SET X=""
SET $PIECE(X," ",80)=" "
FOR X1=1:1
SET I=$PIECE(DGER,",",X1)
if I=""
QUIT
IF $PIECE(I,":")>8
SET X2=+$PIECE(I,":",2)
SET X=$EXTRACT(X,1,X2-1)_"#"_$EXTRACT(X,X2+1,80)
+31 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
End DoDot:1
+32 DO WRER^DGPTAEE
+33 QUIT
+34 ;
H501(REC) ;-- 501 header
+1 ; INPUT : REC - Node that contains the error
+2 NEW X,X1,X2
+3 SET X="DIAG SSN ADM-DATE-TIME MOVE DATE-TIME MPCR CODE SPC LVE PASS SCI"
+4 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+5 SET X=$EXTRACT(REC,1,4)_" "_$EXTRACT(REC,5,14)_SP_$EXTRACT(REC,15,16)_SP_$EXTRACT(REC,17,18)_SP_$EXTRACT(REC,19,20)_SP_$EXTRACT(REC,21,24)_SP_$EXTRACT(REC,31,32)_SP_$EXTRACT(REC,33,34)_SP_$EXTRACT(REC,35,36)_SP_$EXTRACT(REC,37,40)_SP
+6 SET X=X_" "_$EXTRACT(REC,41,46)_" "_$EXTRACT(REC,47,48)_" "_$EXTRACT(REC,49,51)_" "_$EXTRACT(REC,52,54)_" "_$EXTRACT(REC,55)
+7 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+8 SET X=""
SET $PIECE(X," ",80)=" "
FOR X1=1:1
SET I=$PIECE(DGER,",",X1)
if I=""
QUIT
IF $PIECE(I,":")<10
SET X2=+$PIECE(I,":",2)
SET X=$EXTRACT(X,1,X2-1)_"#"_$EXTRACT(X,X2+1,80)
+9 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+10 ;icd9 layout. ft 12/2/14
IF DGPTLINE=1
Begin DoDot:1
+11 SET X="-----------DIAGNOSTIC CODES------------"
+12 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+13 SET X=$EXTRACT(REC,56,62)_SP_$EXTRACT(REC,63,69)_SP_$EXTRACT(REC,70,76)_SP_$EXTRACT(REC,77,83)_SP_$EXTRACT(REC,84,90)
+14 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+15 SET X=""
SET $PIECE(X," ",80)=" "
FOR X1=1:1
SET I=$PIECE(DGER,",",X1)
if I=""
QUIT
IF $PIECE(I,":")=10
SET X2=+$PIECE(I,":",2)
SET X=$EXTRACT(X,1,X2-1)_"#"_$EXTRACT(X,X2+1,80)
+16 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+17 SET X="SSN ATTY PHY PHY LOC CDE BSI LI SI DRUG A4 A5 SC AO IR SWAC"
+18 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+19 SET X=$EXTRACT(REC,91,99)_" "_$EXTRACT(REC,100,105)_" "_...
SET $EXTRACT(REC,106,107)_" "_$EXTRACT(REC,108)_" "_$EXTRACT(REC,109)_" "_$EXTRACT(REC,110)_SP_$EXTRACT(REC,111,114)_" "_$EXTRACT(REC,115)_SP_$EXTRACT(REC,116,119)_" "_$EXTRACT(REC,120)_" "_$EXTRACT(REC,121)_" "_$EXTRACT(REC,122)
_" "_...
... $EXTRACT(REC,123)
+20 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+21 SET X=""
SET $PIECE(X," ",80)=" "
FOR X1=1:1
SET I=$PIECE(DGER,",",X1)
if I=""
QUIT
IF $PIECE(I,":")>10
SET X2=+$PIECE(I,":",2)
SET X=$EXTRACT(X,1,X2-1)_"#"_$EXTRACT(X,X2+1,80)
+22 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
End DoDot:1
+23 ;icd10 layout. ft 12/2/14
IF DGPTLINE=2
Begin DoDot:1
+24 SET X="-----------DIAGNOSTIC CODES------------"
+25 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+26 SET X=$EXTRACT(REC,56,63)_SP_$EXTRACT(REC,64,71)_SP_$EXTRACT(REC,72,79)_SP_$EXTRACT(REC,80,87)_SP_$EXTRACT(REC,88,95)
+27 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+28 SET X=$EXTRACT(REC,96,103)_SP_$EXTRACT(REC,104,111)_SP_$EXTRACT(REC,112,119)_SP_$EXTRACT(REC,120,127)_SP_$EXTRACT(REC,128,135)
+29 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+30 SET X=$EXTRACT(REC,136,143)_SP_$EXTRACT(REC,144,151)_SP_$EXTRACT(REC,152,159)_SP_$EXTRACT(REC,160,167)_SP_$EXTRACT(REC,168,175)
+31 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+32 SET X=$EXTRACT(REC,176,183)_SP_$EXTRACT(REC,184,191)_SP_$EXTRACT(REC,192,199)_SP_$EXTRACT(REC,200,207)_SP_$EXTRACT(REC,208,215)
+33 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+34 SET X=$EXTRACT(REC,216,223)_SP_$EXTRACT(REC,224,231)_SP_$EXTRACT(REC,232,239)_SP_$EXTRACT(REC,240,247)_SP_$EXTRACT(REC,248,255)_SP_$EXTRACT(REC,265,270)_SP_$EXTRACT(REC,271,272)_SP_$EXTRACT(REC,273)
+35 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
+36 SET X=""
SET $PIECE(X," ",80)=" "
FOR X1=1:1
SET I=$PIECE(DGER,",",X1)
if I=""
QUIT
IF $PIECE(I,":")>9
SET X2=+$PIECE(I,":",2)
SET X=$EXTRACT(X,1,X2-1)_"#"_$EXTRACT(X,X2+1,80)
+37 SET VALMCNT=VALMCNT+1
SET ^TMP("AD",$JOB,VALMCNT,0)=X
End DoDot:1
+38 DO WRER^DGPTAEE
+39 QUIT
+40 ;
