13 lines
1020 B
Mathematica
13 lines
1020 B
Mathematica
IMRDD ;ISC-SF.SEA/JLI-CHECK FOR STATUS AGREEING WITH DATE OF DEATH ;10/21/91 15:27
|
|
;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
|
|
CHEK ; called from ^DD(158,15.7,0)-Patient Status (1:alive,2:dead,9:unknown)
|
|
S IMRXA=X,X=+^IMR(158,DA,0) D ^IMRXOR
|
|
S (IMRXDFN,DFN)=X D DEM^VADPT K DFN
|
|
S X=IMRXA,IMRXA=VADM(6)>0 K VA,VADM
|
|
I IMRXA=1,X'=2 W $C(7),!,"***** Patient has a DATE OF DEATH, setting it to 2 ****",! S X=2 K IMRXA,IMRXDFN Q
|
|
I IMRXA=0,$D(^IMR(158,DA,5)),$P(^(5),U,19)'="",$P(^(5),U,19)>0,X=2 S IMRXA=1 I X'=2 W $C(7),!,"**** Patient has an ICR DATE OF DEATH ENTERED, setting status to DEAD ****",! S X=2 K IMRXA,IMRXDFN Q
|
|
I IMRXA=0,X=2 R !!,"Do you want to enter an ICR DATE OF DEATH (Y/N) ? ",Y:DTIME I "yY"[$E(Y_".") S IMRXB=X,%DT="AEQP" D ^%DT S X=IMRXB K %DT,IMRXB I Y>0 S $P(^IMR(158,DA,5),U,19)=Y K IMRXA,IMRXDFN Q
|
|
I IMRXA=0,X=2 W $C(7),!,"***** PATIENT FILE has NO date of death entered,",!,"AND IMR DATE OF DEATH FIELD HAS NO DATE *****",!,"***** You must choose 1 or 9 *****",! K X
|
|
K IMRXA,IMRXDFN
|
|
Q
|