- 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 Feb 18, 2025@23:45:25 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