66 lines
2.2 KiB
Mathematica
66 lines
2.2 KiB
Mathematica
DGPTAE04 ;ALB/MTC/ADL - 401 Edit Checks Cont ; 13 NOV 92
|
|
;;5.3;Registration;**510,744**;Aug 13, 1993;Build 5
|
|
;;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
|