source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRDD.m@ 975

Last change on this file since 975 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1020 bytes
Line 
1IMRDD ;ISC-SF.SEA/JLI-CHECK FOR STATUS AGREEING WITH DATE OF DEATH ;10/21/91 15:27
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
3CHEK ; called from ^DD(158,15.7,0)-Patient Status (1:alive,2:dead,9:unknown)
4 S IMRXA=X,X=+^IMR(158,DA,0) D ^IMRXOR
5 S (IMRXDFN,DFN)=X D DEM^VADPT K DFN
6 S X=IMRXA,IMRXA=VADM(6)>0 K VA,VADM
7 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
8 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
9 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
10 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
11 K IMRXA,IMRXDFN
12 Q
Note: See TracBrowser for help on using the repository browser.