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