DGPTAE04.m

DGPTAE04 ;ALB/MTC/ADL - 401 Edit Checks Cont ; 13 NOV 92

 ;;5.3;Registration;**510,744,1015**;Aug 13, 1993;Build 21

 ;;ADL;Updated for CSV Project;;Mar 24, 2003

 ;

TRAN ;-- verify transplant status

 I " 12"'[DGPT40PT S DGPTERC=417

 Q

 ;

CHIEF ;

 N FLAG,I

 Q:"VMN"[DGPTSCS

 I "1234567"'[DGPTSCS S DGPTERC=407 Q

 S FLAG=1 F I=10,11,30,40,42 I DGPTSTTY["^"_I_"^" S FLAG=0 Q

 S:FLAG DGPTERC=407

 Q

FAST ;

 N FLAG,I

 Q:DGPTSFA=" "

 S FLAG=0 F I=20:1:26 I DGPTSTTY["^"_I_"^" S FLAG=1,DGPTSFA=" " Q

 I FLAG Q

 I "12345678"'[DGPTSFA S DGPTERC=408 Q

 Q

ANES ;

 N FLAG,I

 Q:DGPTSAT=" "

 S FLAG=0 F I=20:1:26 I DGPTSTTY["^"_I_"^" S FLAG=1,DGPTSAT=" " Q

 I FLAG Q

 I "0123456789RX"'[DGPTSAT S DGPTERC=409 Q

 S DGPTERC=409 F I=10,11,30,40,42 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q

 Q

 ;

FIRST ;-- Edit surgeries - present in ICD0 OPERATIONS, current, gender ok

 ;

 I (+DGPTSO1=1371)!(+DGPTSO1=39610)!(+DGPTSO1=39611)!(+DGPTSO1=39612) S DGPTERC=450 D ERR G:DGPTEDFL EXIT

LOOP ;

 F DGPTL3=1:1:5 S DGPTERC=0 D CHKOPC I DGPTERC D ERR G:DGPTEDFL EXIT

 Q

CHKOPC ;

 S DGPTOC=(@("DGPTSO"_DGPTL3)),DGPTOC=$P(DGPTOC," ",1) Q:DGPTOC=""

 S DGPTERC=410+DGPTL3

 S DGPTOC=$E(DGPTOC_"       ",1,2)_"."_$E(DGPTOC,3,7)

 I $D(^ICD0("AB",DGPTOC)) S DGPTERC=0 D GEN Q

 Q

GEN ;

 S DGPTOPP=$O(^ICD0("AB",DGPTOC,0)) I DGPTOPP="" S DGPTERC=451 Q

 S DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,$S($G(DGPTSDD)'="":DGPTSDD,1:DT))  ;use date of surgery from rec if it exists, else today

 ; DG*744 - check against discharge date

 ;I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=451 Q

 I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=451 N DGPTDAT S DGPTDAT=+$G(^DGPT(PTF,70)) I DGPTDAT S DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,DGPTDAT) I $P(DGPTTMP,U,10)=1 S DGPTERC=0

 I DGPTERC=451 Q

 I $P(DGPTTMP,U,11)]""&(DGPTGEN'=$P(DGPTTMP,U,11)) S DGPTERC=451 Q

CURR ;

 S DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,$S($G(DGPTSDD)'="":DGPTSDD,1:DT))  ;use date of surgery from rec if it exists, else today

 I ($P(DGPTTMP,U,10)=0)&($P(DGPTSDD,1,7)>$P(DGPTTMP,U,12)) S DGPTERC=474+DGPTL3 Q

SAVE ;

 S @("DGPTSO"_DGPTL3)=DGPTOC

ARRAY ;

 S DGPTOPAR(DGPTSDD)=$S($D(DGPTOPAR(DGPTSDD)):DGPTOPAR(DGPTSDD)_U_DGPTOPP,1:DGPTOPP_U)

 Q

EXIT ;

 K DGPTL3,DGPTOC,DGPTOC1,DGPTOPP

 Q

ERR ;

 D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)

 Q

DGPTAE04  ;ALB/MTC/ADL - 401 Edit Checks Cont ; 13 NOV 92

 +1       ;;5.3;Registration;**510,744,1015**;Aug 13, 1993;Build 21

 +2       ;;ADL;Updated for CSV Project;;Mar 24, 2003

 +3       ;

TRAN      ;-- verify transplant status

 +1        IF " 12"'[DGPT40PT

               SET DGPTERC=417

 +2        QUIT 

 +3       ;

CHIEF     ;

 +1        NEW FLAG,I

 +2        IF "VMN"[DGPTSCS

               QUIT 

 +3        IF "1234567"'[DGPTSCS

               SET DGPTERC=407

               QUIT 

 +4        SET FLAG=1

           FOR I=10,11,30,40,42

               IF DGPTSTTY["^"_I_"^"

                   SET FLAG=0

                   QUIT 

 +5        IF FLAG

               SET DGPTERC=407

 +6        QUIT 

FAST      ;

 +1        NEW FLAG,I

 +2        IF DGPTSFA=" "

               QUIT 

 +3        SET FLAG=0

           FOR I=20:1:26

               IF DGPTSTTY["^"_I_"^"

                   SET FLAG=1

                   SET DGPTSFA=" "

                   QUIT 

 +4        IF FLAG

               QUIT 

 +5        IF "12345678"'[DGPTSFA

               SET DGPTERC=408

               QUIT 

 +6        QUIT 

ANES      ;

 +1        NEW FLAG,I

 +2        IF DGPTSAT=" "

               QUIT 

 +3        SET FLAG=0

           FOR I=20:1:26

               IF DGPTSTTY["^"_I_"^"

                   SET FLAG=1

                   SET DGPTSAT=" "

                   QUIT 

 +4        IF FLAG

               QUIT 

 +5        IF "0123456789RX"'[DGPTSAT

               SET DGPTERC=409

               QUIT 

 +6        SET DGPTERC=409

           FOR I=10,11,30,40,42

               IF DGPTSTTY["^"_I_"^"

                   SET DGPTERC=0

                   QUIT 

 +7        QUIT 

 +8       ;

FIRST     ;-- Edit surgeries - present in ICD0 OPERATIONS, current, gender ok

 +1       ;

 +2        IF (+DGPTSO1=1371)!(+DGPTSO1=39610)!(+DGPTSO1=39611)!(+DGPTSO1=39612)

               SET DGPTERC=450

               DO ERR

               IF DGPTEDFL

                   GOTO EXIT

LOOP      ;

 +1        FOR DGPTL3=1:1:5

               SET DGPTERC=0

               DO CHKOPC

               IF DGPTERC

                   DO ERR

                   IF DGPTEDFL

                       GOTO EXIT

 +2        QUIT 

CHKOPC    ;

 +1        SET DGPTOC=(@("DGPTSO"_DGPTL3))

           SET DGPTOC=$PIECE(DGPTOC," ",1)

           IF DGPTOC=""

               QUIT 

 +2        SET DGPTERC=410+DGPTL3

 +3        SET DGPTOC=$EXTRACT(DGPTOC_"       ",1,2)_"."_$EXTRACT(DGPTOC,3,7)

 +4        IF $DATA(^ICD0("AB",DGPTOC))

               SET DGPTERC=0

               DO GEN

               QUIT 

 +5        QUIT 

GEN       ;

 +1        SET DGPTOPP=$ORDER(^ICD0("AB",DGPTOC,0))

           IF DGPTOPP=""

               SET DGPTERC=451

               QUIT 

 +2       ;use date of surgery from rec if it exists, else today

           SET DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,$SELECT($GET(DGPTSDD)'="":DGPTSDD,1:DT))

 +3       ; DG*744 - check against discharge date

 +4       ;I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=451 Q

 +5        IF DGPTTMP=-1!('$PIECE(DGPTTMP,U,10))

               SET DGPTERC=451

               NEW DGPTDAT

               SET DGPTDAT=+$GET(^DGPT(PTF,70))

               IF DGPTDAT

                   SET DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,DGPTDAT)

                   IF $PIECE(DGPTTMP,U,10)=1

                       SET DGPTERC=0

 +6        IF DGPTERC=451

               QUIT 

 +7        IF $PIECE(DGPTTMP,U,11)]""&(DGPTGEN'=$PIECE(DGPTTMP,U,11))

               SET DGPTERC=451

               QUIT 

CURR      ;

 +1       ;use date of surgery from rec if it exists, else today

           SET DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,$SELECT($GET(DGPTSDD)'="":DGPTSDD,1:DT))

 +2        IF ($PIECE(DGPTTMP,U,10)=0)&($PIECE(DGPTSDD,1,7)>$PIECE(DGPTTMP,U,12))

               SET DGPTERC=474+DGPTL3

               QUIT 

SAVE      ;

 +1        SET @("DGPTSO"_DGPTL3)=DGPTOC

ARRAY     ;

 +1        SET DGPTOPAR(DGPTSDD)=$SELECT($DATA(DGPTOPAR(DGPTSDD)):DGPTOPAR(DGPTSDD)_U_DGPTOPP,1:DGPTOPP_U)

 +2        QUIT 

EXIT      ;

 +1        KILL DGPTL3,DGPTOC,DGPTOC1,DGPTOPP

 +2        QUIT 

ERR       ;

 +1        DO WRTERR^DGPTAE(DGPTERC,NODE,SEQ)

 +2        QUIT