source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURACE8.m@ 1096

NURACE8 ;HIRMFO/RM,FT-PATIENT CLASSIFICATION FACTOR CHECKS ;1/9/97  13:53
 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ;VALIDATE EXTENDED CARE FACTORS
 I FACT["A" I ((FACT["B")!(FACT["C")) S NURS1SW=1
 I FACT["B" I FACT["C" S NURS1SW=1
 I FACT["D" I ((FACT["E")!(FACT["F")) S NURS4SW=1
 I FACT["E" I FACT["F" S NURS4SW=1
 I FACT["G" I ((FACT["H")!(FACT["I")) S NURS7SW=1
 I FACT["H" I FACT["I" S NURS7SW=1
 I FACT["J" I ((FACT["K")!(FACT["L")) S NURS10SW=1
 I FACT["K" I FACT["L" S NURS10SW=1
 I FACT["M" I ((FACT["N")!(FACT["O")) S NURS13SW=1
 I FACT["N" I FACT["O" S NURS13SW=1
 Q
EN2 ;VALIDATE PSYCHIATRIC FACTORS
 I FACT["A" I ((FACT["B")!(FACT["C")!(FACT["D")) S NURS1SW=1
 I FACT["B" I ((FACT["C")!(FACT["D")) S NURS1SW=1
 I FACT["C" I FACT["D" S NURS1SW=1
 I FACT["E" I ((FACT["F")!(FACT["G")!(FACT["H")) S NURS5SW=1
 I FACT["F" I ((FACT["G")!(FACT["H")) S NURS5SW=1
 I FACT["G" I FACT["H" S NURS5SW=1
 I ((PREV="A")!(PREV="F")) I ((FACT["I")!(FACT["K")) S NWFCTSW=1,FCK="I or K"
 I PREV="B" I ((FACT["H")!(FACT["K")) S NWFCTSW=1,FCK="H, or K"
 I PREV="D" I FACT["E" S NWFCTSW=1,FCK="E"
 I PREV="E" I ((FACT["I")!(FACT["K")!(FACT["D")) S NWFCTSW=1,FCK="D,I or K"
 I PREV="H" I FACT["A" S NWFCTSW=1,FCK="A"
 I PREV="I" I ((FACT["E")!(FACT["F")) S NWFCTSW=1,FCK="E or F"
 I PREV="K" I ((FACT["A")!(FACT["B")!(FACT["C")!(FACT["E")!(FACT["F")) S NWFCTSW=1,FCK="A,B,C,E or F"
 Q
EN3 ; ERROR MESSAGE THAT ACUITY ROUTINE NOT RUN
 W !,*7
 F J=1:1:3 D ASTER
 F J=1:1:2 D ASTER1
 W !,"*****",?$X+31,"WARNING",?$X+32,"*****"
 ;D ASTER1
 ;W !,"*****",?$X+21,"CLASSIFICATION CANNOT BE RUN",?$X+21,"*****"
 F J=1:1:5 D ASTER1
 W !,"*****",?$X+20,"NOTIFY NURSING ADP COORDINATOR",?$X+20,"*****"
 D ASTER1
 W !,"*****",?$X+8,"TaskMan DID NOT RUN ACUITY ROUTINE (AMIS 1106 UPDATE)",?$X+9,"*****"
 D ASTER1
 W !,"*****",?$X+18,"THIS CALL MUST BE MADE IMMEDIATELY",?$X+18,"*****"
 F J=1:1:2 D ASTER1
 F J=1:1:3 D ASTER
 H 5
 Q
ASTER ;
 W $$REPEAT^XLFSTR("*",80)
 Q
ASTER1 ;
 W !,*7,"*****",?$X+70,"*****"
 Q
EN4 ; PROMPT PRINTED IF UP-ARROWED OUT OF CLASSIFICATION
 W *7,*7,!,"THIS PATIENT'S CLASSIFICATION HAS NOT BEEN UPDATED."
 Q
EN5 ; PRINT INFO FOR ATEC PATIENTS
 W !!,?8,"Current Classification: ",CLASSX W:CLASSX'="" " (USER)"
 W !,?8,"Last user to classify: ",USERX
 W !,?8,"Last date/time classified: "
 I DATEX'="" S Y=DATEX D:+Y D^DIQ W Y
 Q
EN6 ; CLASSIFICATION OF ATEC PATIENTS
 W !,"Enter Classification: " W:(CLASSX'="") CLASSX,"//"
 R X:DTIME S:CLASSX'=""&(X="") X=CLASSX
 I (X="^")!('$T) D EN4 S OUTSW=1 Q
 I (X?1N)&(X>0)&(X<5) S CLASSX=X G Q
 W !,*7,"ANSWER WITH A NUMBER BETWEEN 1 AND 4" G EN6
Q D FINAL2^NURACE7 S OUTSW=1 Q
EN7 ;VALIDATE EXTENDED CARE FACTORS
 I FACT["A" I ((FACT["B")!(FACT["C")!(FACT["D")) S NURS1SW=1
 I FACT["B" I ((FACT["C")!(FACT["D")) S NURS1SW=1
 I FACT["C" I FACT["D" S NURS1SW=1
 I FACT["E" I ((FACT["F")!(FACT["G")!(FACT["H")) S NURS4SW=1
 I FACT["F" I ((FACT["G")!(FACT["H")) S NURS4SW=1
 I FACT["G" I FACT["H" S NURS4SW=1
 I FACT["I" I ((FACT["J")!(FACT["K")!(FACT["L")) S NURS7SW=1
 I FACT["J" I ((FACT["K")!(FACT["L")) S NURS7SW=1
 I FACT["K" I FACT["L" S NURS7SW=1
 I FACT["M" I ((FACT["N")!(FACT["O")!(FACT["P")) S NURS10SW=1
 I FACT["N" I ((FACT["O")!(FACT["P")) S NURS10SW=1
 I FACT["O" I FACT["P" S NURS10SW=1
 I FACT["Q" I ((FACT["R")!(FACT["S")!(FACT["T")) S NURS13SW=1
 I FACT["R" I ((FACT["S")!(FACT["T")) S NURS13SW=1
 I FACT["S" I FACT["T" S NURS13SW=1
 Q