DGPT401 ;ALB/MTC,HIOFO/FT - 401/402/403 Edits ;2/19/15 2:51pm
;;5.3;Registration;**164,729,884,1057**;Aug 13, 1993;Build 17
;
;no external references
;
;Edits for 401/402/403 transmission
EN ;called by RTE^DGPTAE (using indirection)
N ERROR
S (DGPTEDFL,DGPTERC)=0,DGPTSTR=^TMP("AEDIT",$J,NODE,SEQ)
S:$E(DGPTSTR,37,40)="2400" DGPTSTR=$E(DGPTSTR,1,36)_"2359"_$E(DGPTSTR,41,246)
SET ;parse data string and set variables. different record layout for dg*5.3*884
D:DGPTFMT=2 SET9
D:DGPTFMT=3 SET10
DATE ;date of surgery
; DGPTDDS - discharge DT
; DGPTDTS - admission DT
; DGPTSDD - surgery DT
S DGPTSDT=$E(DGPTSTR,31,40),(X,DGPTSDD)=$$FMDT^DGPT101($E(DGPTSDT,1,6))_"."_$E(DGPTSDT,7,10) S %DT="XT" D ^%DT K %DT I Y<0 S DGPTERC=405 D ERR G:DGPTEDFL EXIT
I $$FMDIFF^XLFDT(DGPTDDS,DGPTSDD,2)<0 S DGPTERC=440 D ERR G:DGPTEDFL EXIT ; DG*5.3*1057
I $$FMDIFF^XLFDT(DGPTSDD,$$FMADD^XLFDT(DGPTDTS,,-72),2)<0 S DGPTERC=437 D ERR G:DGPTEDFL EXIT ; DG*5.3*1057
D DD^%DT S DGPTSDT=$E(Y,5,6)_"-"_$E(Y,1,3)_"-"_$E(Y,9,12)_" "_$S($P(Y,"@",2)]"":$E($P(Y,"@",2),1,5),1:"00:00")
I DGPTSDT'?1.2N1"-"3U1"-"4N1" "2N1":"2N S DGPTERC=450 D ERR G:DGPTEDFL EXIT
I ($P(DGPTSDD,".",2)="0000")!($P(DGPTDTS,".",2)="0000")!($P(DGPTDDS,".",2)="0000") S DGPTERC=$S(+DGPTSDD<+DGPTDTS:437,+DGPTSDD>+DGPTDDS:440,1:0)
SPEC ;specialty
I ((DGPTSSC>63)!(DGPTSSC<48))&((DGPTSSC'=65)&(DGPTSSC'=78)&(DGPTSSC'=97)) S DGPTERC=406 D ERR G:DGPTEDFL EXIT
CHFS ;chief surgeon
S DGPTERC=0 D CHIEF^DGPTAE04 I DGPTERC D ERR G:DGPTEDFL EXIT
FAST ;first assistant
S DGPTERC=0 D FAST^DGPTAE04 I DGPTERC D ERR G:DGPTEDFL EXIT
ANES ;anesthesia technique
S DGPTERC=0 D ANES^DGPTAE04 I DGPTERC D ERR G:DGPTEDFL EXIT
SRP ;source of payment
N I,FLAG
I "12 "'[DGPTSSP S DGPTERC=410 D ERR G:DGPTEDFL EXIT
S FLAG=0 F I=20:1:26 I DGPTSTTY[U_I_U S FLAG=1 Q
G:FLAG OPCD
I "12"[DGPTSSP S DGPTERC=410 F I=10,11,30,40,42 I DGPTSTTY[U_I_U S FLAG=1,DGPTERC=0 Q
I FLAG D ERR G:DGPTEDFL EXIT
OPCD ;operation codes
S DGPTERC=0 D FIRST^DGPTAE04 G:DGPTEDFL EXIT
TRANS ; Transplant status
I DGPTFMT=2 D ;check only if icd-9, otherwise this field will not be used with ICD-10
.I DGPTDDS'<2911001 G GOOD
.S DGPTERC=0 D TRAN^DGPTAE04 I DGPTERC D ERR G:DGPTEDFL EXIT
GOOD ;
W:'$D(ERROR) "."
EXIT ;
K DGPTSDT,DGPTSSC,DGPTSCS,DGPTSFA,DGPTSAT,DGPTSSP,DGPTSTR,DGPTSDD,DGPT40PT,DGPTXX
K DGPTSO1,DGPTSO2,DGPTSO3,DGPTSO4,DGPTSO5,DGPTSO6,DGPTSO7,DGPTSO8,DGPTSO9,DGPTSO10
K DGPTSO11,DGPTSO12,DGPTSO13,DGPTSO14,DGPTSO15,DGPTSO16,DGPTSO17,DGPTSO18,DGPTSO19,DGPTSO20
K DGPTSO21,DGPTSO22,DGPTSO23,DGPTSO24,DGPTSO25
Q
ERR ;
D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
S ERROR=1
Q
SET9 ;record layout before icd10 turned on
S DGPTSDT=$E(DGPTSTR,31,40) ;31-36 is date of surgery, 37-40 is time of surgery
S DGPTSSC=$E(DGPTSTR,41,42) ;specialty
S DGPTSCS=$E(DGPTSTR,43) ;category of chief surgeon
S DGPTSFA=$E(DGPTSTR,44) ;category of first assistant
S DGPTSAT=$E(DGPTSTR,45) ;anesthesia technique (principal)
S DGPTSSP=$E(DGPTSTR,46) ;source of payment
S DGPTSO1=$E(DGPTSTR,47,53) ;operation codes 1-5
S DGPTSO2=$E(DGPTSTR,54,60)
S DGPTSO3=$E(DGPTSTR,61,67)
S DGPTSO4=$E(DGPTSTR,68,74)
S DGPTSO5=$E(DGPTSTR,75,81)
S DGPTXX=$E(DGPTSTR,82,90) ;set & killed, otherwise not used.
S DGPT40PT=$E(DGPTSTR,91) ;transplant status. Note: not used with ICD-10
Q
SET10 ; record layout after icd10 turned on
S DGPTSDT=$E(DGPTSTR,31,40) ;31-36 is date of surgery, 37-40 is time of surgery
S DGPTSSC=$E(DGPTSTR,41,42) ;specialty
S DGPTSCS=$E(DGPTSTR,43) ;category of chief surgeon
S DGPTSFA=$E(DGPTSTR,44) ;category of first assistant
S DGPTSAT=$E(DGPTSTR,45) ;anesthesia technique (principal)
S DGPTSSP=$E(DGPTSTR,46) ;source of payment
S DGPTSO1=$E(DGPTSTR,47,53) ;the procedure code is 7 characters, The 8th character is a space when transmitting.
S DGPTSO2=$E(DGPTSTR,55,61) ;grabbing 7 characters instead of 8.
S DGPTSO3=$E(DGPTSTR,63,69)
S DGPTSO4=$E(DGPTSTR,71,77)
S DGPTSO5=$E(DGPTSTR,79,85)
S DGPTSO6=$E(DGPTSTR,87,93)
S DGPTSO7=$E(DGPTSTR,95,101)
S DGPTSO8=$E(DGPTSTR,103,109)
S DGPTSO9=$E(DGPTSTR,111,117)
S DGPTSO10=$E(DGPTSTR,119,125)
S DGPTSO11=$E(DGPTSTR,127,133)
S DGPTSO12=$E(DGPTSTR,135,141)
S DGPTSO13=$E(DGPTSTR,143,149)
S DGPTSO14=$E(DGPTSTR,151,157)
S DGPTSO15=$E(DGPTSTR,159,165)
S DGPTSO16=$E(DGPTSTR,167,173)
S DGPTSO17=$E(DGPTSTR,175,181)
S DGPTSO18=$E(DGPTSTR,183,189)
S DGPTSO19=$E(DGPTSTR,191,197)
S DGPTSO20=$E(DGPTSTR,199,205)
S DGPTSO21=$E(DGPTSTR,207,213)
S DGPTSO22=$E(DGPTSTR,215,221)
S DGPTSO23=$E(DGPTSTR,223,229)
S DGPTSO24=$E(DGPTSTR,231,237)
S DGPTSO25=$E(DGPTSTR,239,245)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPT401 4684 printed Apr 09, 2024@21:43:09 Page 2
DGPT401 ;ALB/MTC,HIOFO/FT - 401/402/403 Edits ;2/19/15 2:51pm
+1 ;;5.3;Registration;**164,729,884,1057**;Aug 13, 1993;Build 17
+2 ;
+3 ;no external references
+4 ;
+5 ;Edits for 401/402/403 transmission
EN ;called by RTE^DGPTAE (using indirection)
+1 NEW ERROR
+2 SET (DGPTEDFL,DGPTERC)=0
SET DGPTSTR=^TMP("AEDIT",$JOB,NODE,SEQ)
+3 if $EXTRACT(DGPTSTR,37,40)="2400"
SET DGPTSTR=$EXTRACT(DGPTSTR,1,36)_"2359"_$EXTRACT(DGPTSTR,41,246)
SET ;parse data string and set variables. different record layout for dg*5.3*884
+1 if DGPTFMT=2
DO SET9
+2 if DGPTFMT=3
DO SET10
DATE ;date of surgery
+1 ; DGPTDDS - discharge DT
+2 ; DGPTDTS - admission DT
+3 ; DGPTSDD - surgery DT
+4 SET DGPTSDT=$EXTRACT(DGPTSTR,31,40)
SET (X,DGPTSDD)=$$FMDT^DGPT101($EXTRACT(DGPTSDT,1,6))_"."_$EXTRACT(DGPTSDT,7,10)
SET %DT="XT"
DO ^%DT
KILL %DT
IF Y<0
SET DGPTERC=405
DO ERR
if DGPTEDFL
GOTO EXIT
+5 ; DG*5.3*1057
IF $$FMDIFF^XLFDT(DGPTDDS,DGPTSDD,2)<0
SET DGPTERC=440
DO ERR
if DGPTEDFL
GOTO EXIT
+6 ; DG*5.3*1057
IF $$FMDIFF^XLFDT(DGPTSDD,$$FMADD^XLFDT(DGPTDTS,,-72),2)<0
SET DGPTERC=437
DO ERR
if DGPTEDFL
GOTO EXIT
+7 DO DD^%DT
SET DGPTSDT=$EXTRACT(Y,5,6)_"-"_$EXTRACT(Y,1,3)_"-"_$EXTRACT(Y,9,12)_" "_$SELECT($PIECE(Y,"@",2)]"":$EXTRACT($PIECE(Y,"@",2),1,5),1:"00:00")
+8 IF DGPTSDT'?1.2N1"-"3U1"-"4N1" "2N1":"2N
SET DGPTERC=450
DO ERR
if DGPTEDFL
GOTO EXIT
+9 IF ($PIECE(DGPTSDD,".",2)="0000")!($PIECE(DGPTDTS,".",2)="0000")!($PIECE(DGPTDDS,".",2)="0000")
SET DGPTERC=$SELECT(+DGPTSDD<+DGPTDTS:437,+DGPTSDD>+DGPTDDS:440,1:0)
SPEC ;specialty
+1 IF ((DGPTSSC>63)!(DGPTSSC<48))&((DGPTSSC'=65)&(DGPTSSC'=78)&(DGPTSSC'=97))
SET DGPTERC=406
DO ERR
if DGPTEDFL
GOTO EXIT
CHFS ;chief surgeon
+1 SET DGPTERC=0
DO CHIEF^DGPTAE04
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
FAST ;first assistant
+1 SET DGPTERC=0
DO FAST^DGPTAE04
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
ANES ;anesthesia technique
+1 SET DGPTERC=0
DO ANES^DGPTAE04
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
SRP ;source of payment
+1 NEW I,FLAG
+2 IF "12 "'[DGPTSSP
SET DGPTERC=410
DO ERR
if DGPTEDFL
GOTO EXIT
+3 SET FLAG=0
FOR I=20:1:26
IF DGPTSTTY[U_I_U
SET FLAG=1
QUIT
+4 if FLAG
GOTO OPCD
+5 IF "12"[DGPTSSP
SET DGPTERC=410
FOR I=10,11,30,40,42
IF DGPTSTTY[U_I_U
SET FLAG=1
SET DGPTERC=0
QUIT
+6 IF FLAG
DO ERR
if DGPTEDFL
GOTO EXIT
OPCD ;operation codes
+1 SET DGPTERC=0
DO FIRST^DGPTAE04
if DGPTEDFL
GOTO EXIT
TRANS ; Transplant status
+1 ;check only if icd-9, otherwise this field will not be used with ICD-10
IF DGPTFMT=2
Begin DoDot:1
+2 IF DGPTDDS'<2911001
GOTO GOOD
+3 SET DGPTERC=0
DO TRAN^DGPTAE04
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
End DoDot:1
GOOD ;
+1 if '$DATA(ERROR)
WRITE "."
EXIT ;
+1 KILL DGPTSDT,DGPTSSC,DGPTSCS,DGPTSFA,DGPTSAT,DGPTSSP,DGPTSTR,DGPTSDD,DGPT40PT,DGPTXX
+2 KILL DGPTSO1,DGPTSO2,DGPTSO3,DGPTSO4,DGPTSO5,DGPTSO6,DGPTSO7,DGPTSO8,DGPTSO9,DGPTSO10
+3 KILL DGPTSO11,DGPTSO12,DGPTSO13,DGPTSO14,DGPTSO15,DGPTSO16,DGPTSO17,DGPTSO18,DGPTSO19,DGPTSO20
+4 KILL DGPTSO21,DGPTSO22,DGPTSO23,DGPTSO24,DGPTSO25
+5 QUIT
ERR ;
+1 DO WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
+2 SET ERROR=1
+3 QUIT
SET9 ;record layout before icd10 turned on
+1 ;31-36 is date of surgery, 37-40 is time of surgery
SET DGPTSDT=$EXTRACT(DGPTSTR,31,40)
+2 ;specialty
SET DGPTSSC=$EXTRACT(DGPTSTR,41,42)
+3 ;category of chief surgeon
SET DGPTSCS=$EXTRACT(DGPTSTR,43)
+4 ;category of first assistant
SET DGPTSFA=$EXTRACT(DGPTSTR,44)
+5 ;anesthesia technique (principal)
SET DGPTSAT=$EXTRACT(DGPTSTR,45)
+6 ;source of payment
SET DGPTSSP=$EXTRACT(DGPTSTR,46)
+7 ;operation codes 1-5
SET DGPTSO1=$EXTRACT(DGPTSTR,47,53)
+8 SET DGPTSO2=$EXTRACT(DGPTSTR,54,60)
+9 SET DGPTSO3=$EXTRACT(DGPTSTR,61,67)
+10 SET DGPTSO4=$EXTRACT(DGPTSTR,68,74)
+11 SET DGPTSO5=$EXTRACT(DGPTSTR,75,81)
+12 ;set & killed, otherwise not used.
SET DGPTXX=$EXTRACT(DGPTSTR,82,90)
+13 ;transplant status. Note: not used with ICD-10
SET DGPT40PT=$EXTRACT(DGPTSTR,91)
+14 QUIT
SET10 ; record layout after icd10 turned on
+1 ;31-36 is date of surgery, 37-40 is time of surgery
SET DGPTSDT=$EXTRACT(DGPTSTR,31,40)
+2 ;specialty
SET DGPTSSC=$EXTRACT(DGPTSTR,41,42)
+3 ;category of chief surgeon
SET DGPTSCS=$EXTRACT(DGPTSTR,43)
+4 ;category of first assistant
SET DGPTSFA=$EXTRACT(DGPTSTR,44)
+5 ;anesthesia technique (principal)
SET DGPTSAT=$EXTRACT(DGPTSTR,45)
+6 ;source of payment
SET DGPTSSP=$EXTRACT(DGPTSTR,46)
+7 ;the procedure code is 7 characters, The 8th character is a space when transmitting.
SET DGPTSO1=$EXTRACT(DGPTSTR,47,53)
+8 ;grabbing 7 characters instead of 8.
SET DGPTSO2=$EXTRACT(DGPTSTR,55,61)
+9 SET DGPTSO3=$EXTRACT(DGPTSTR,63,69)
+10 SET DGPTSO4=$EXTRACT(DGPTSTR,71,77)
+11 SET DGPTSO5=$EXTRACT(DGPTSTR,79,85)
+12 SET DGPTSO6=$EXTRACT(DGPTSTR,87,93)
+13 SET DGPTSO7=$EXTRACT(DGPTSTR,95,101)
+14 SET DGPTSO8=$EXTRACT(DGPTSTR,103,109)
+15 SET DGPTSO9=$EXTRACT(DGPTSTR,111,117)
+16 SET DGPTSO10=$EXTRACT(DGPTSTR,119,125)
+17 SET DGPTSO11=$EXTRACT(DGPTSTR,127,133)
+18 SET DGPTSO12=$EXTRACT(DGPTSTR,135,141)
+19 SET DGPTSO13=$EXTRACT(DGPTSTR,143,149)
+20 SET DGPTSO14=$EXTRACT(DGPTSTR,151,157)
+21 SET DGPTSO15=$EXTRACT(DGPTSTR,159,165)
+22 SET DGPTSO16=$EXTRACT(DGPTSTR,167,173)
+23 SET DGPTSO17=$EXTRACT(DGPTSTR,175,181)
+24 SET DGPTSO18=$EXTRACT(DGPTSTR,183,189)
+25 SET DGPTSO19=$EXTRACT(DGPTSTR,191,197)
+26 SET DGPTSO20=$EXTRACT(DGPTSTR,199,205)
+27 SET DGPTSO21=$EXTRACT(DGPTSTR,207,213)
+28 SET DGPTSO22=$EXTRACT(DGPTSTR,215,221)
+29 SET DGPTSO23=$EXTRACT(DGPTSTR,223,229)
+30 SET DGPTSO24=$EXTRACT(DGPTSTR,231,237)
+31 SET DGPTSO25=$EXTRACT(DGPTSTR,239,245)
+32 QUIT
