| [613] | 1 | DGPTAE04 ;ALB/MTC/ADL - 401 Edit Checks Cont ; 13 NOV 92
|
|---|
| 2 | ;;5.3;Registration;**510,744**;Aug 13, 1993;Build 5
|
|---|
| 3 | ;;ADL;Updated for CSV Project;;Mar 24, 2003
|
|---|
| 4 | ;
|
|---|
| 5 | TRAN ;-- verify transplant status
|
|---|
| 6 | I " 12"'[DGPT40PT S DGPTERC=417
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | CHIEF ;
|
|---|
| 10 | N FLAG,I
|
|---|
| 11 | Q:"VMN"[DGPTSCS
|
|---|
| 12 | I "1234567"'[DGPTSCS S DGPTERC=407 Q
|
|---|
| 13 | S FLAG=1 F I=10,11,30,40,42 I DGPTSTTY["^"_I_"^" S FLAG=0 Q
|
|---|
| 14 | S:FLAG DGPTERC=407
|
|---|
| 15 | Q
|
|---|
| 16 | FAST ;
|
|---|
| 17 | N FLAG,I
|
|---|
| 18 | Q:DGPTSFA=" "
|
|---|
| 19 | S FLAG=0 F I=20:1:26 I DGPTSTTY["^"_I_"^" S FLAG=1,DGPTSFA=" " Q
|
|---|
| 20 | I FLAG Q
|
|---|
| 21 | I "12345678"'[DGPTSFA S DGPTERC=408 Q
|
|---|
| 22 | Q
|
|---|
| 23 | ANES ;
|
|---|
| 24 | N FLAG,I
|
|---|
| 25 | Q:DGPTSAT=" "
|
|---|
| 26 | S FLAG=0 F I=20:1:26 I DGPTSTTY["^"_I_"^" S FLAG=1,DGPTSAT=" " Q
|
|---|
| 27 | I FLAG Q
|
|---|
| 28 | I "0123456789RX"'[DGPTSAT S DGPTERC=409 Q
|
|---|
| 29 | S DGPTERC=409 F I=10,11,30,40,42 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | FIRST ;-- Edit surgeries - present in ICD0 OPERATIONS, current, gender ok
|
|---|
| 33 | ;
|
|---|
| 34 | I (+DGPTSO1=1371)!(+DGPTSO1=39610)!(+DGPTSO1=39611)!(+DGPTSO1=39612) S DGPTERC=450 D ERR G:DGPTEDFL EXIT
|
|---|
| 35 | LOOP ;
|
|---|
| 36 | F DGPTL3=1:1:5 S DGPTERC=0 D CHKOPC I DGPTERC D ERR G:DGPTEDFL EXIT
|
|---|
| 37 | Q
|
|---|
| 38 | CHKOPC ;
|
|---|
| 39 | S DGPTOC=(@("DGPTSO"_DGPTL3)),DGPTOC=$P(DGPTOC," ",1) Q:DGPTOC=""
|
|---|
| 40 | S DGPTERC=410+DGPTL3
|
|---|
| 41 | S DGPTOC=$E(DGPTOC_" ",1,2)_"."_$E(DGPTOC,3,7)
|
|---|
| 42 | I $D(^ICD0("AB",DGPTOC)) S DGPTERC=0 D GEN Q
|
|---|
| 43 | Q
|
|---|
| 44 | GEN ;
|
|---|
| 45 | S DGPTOPP=$O(^ICD0("AB",DGPTOC,0)) I DGPTOPP="" S DGPTERC=451 Q
|
|---|
| 46 | S DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,$S($G(DGPTSDD)'="":DGPTSDD,1:DT)) ;use date of surgery from rec if it exists, else today
|
|---|
| 47 | ; DG*744 - check against discharge date
|
|---|
| 48 | ;I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=451 Q
|
|---|
| 49 | 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
|
|---|
| 50 | I DGPTERC=451 Q
|
|---|
| 51 | I $P(DGPTTMP,U,11)]""&(DGPTGEN'=$P(DGPTTMP,U,11)) S DGPTERC=451 Q
|
|---|
| 52 | CURR ;
|
|---|
| 53 | S DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,$S($G(DGPTSDD)'="":DGPTSDD,1:DT)) ;use date of surgery from rec if it exists, else today
|
|---|
| 54 | I ($P(DGPTTMP,U,10)=0)&($P(DGPTSDD,1,7)>$P(DGPTTMP,U,12)) S DGPTERC=474+DGPTL3 Q
|
|---|
| 55 | SAVE ;
|
|---|
| 56 | S @("DGPTSO"_DGPTL3)=DGPTOC
|
|---|
| 57 | ARRAY ;
|
|---|
| 58 | S DGPTOPAR(DGPTSDD)=$S($D(DGPTOPAR(DGPTSDD)):DGPTOPAR(DGPTSDD)_U_DGPTOPP,1:DGPTOPP_U)
|
|---|
| 59 | Q
|
|---|
| 60 | EXIT ;
|
|---|
| 61 | K DGPTL3,DGPTOC,DGPTOC1,DGPTOPP
|
|---|
| 62 | Q
|
|---|
| 63 | ERR ;
|
|---|
| 64 | D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
|
|---|
| 65 | Q
|
|---|
