NURACE1 ;HIRMFO/RM/MD-PATIENT CLASSIFICATION DRIVER-cont ;11/4/87
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ;BEGIN PRINTING PATIENT INFO
W !,?13,"PATIENT CLASSIFICATION ",NURSBSF
S NPWARD=NURSWARD D EN6^NURSAUTL W !!,"Patient: ",NURSNAM," SSN: ",SSN," Admission Date: ",$S('PADMDT:"NO MAS ADMISSION DATE",1:PADMDT),!,"Unit: ",NPWARD," Room/Bed: ",NURSRMBD," Bed Section: ",NURSBSF
I NURSBS'=11 W !,"FACTORS:" G NURSWBYP
NURSWBYP ;PRINT REST OF PATIENT INFO
D FACTPRNT Q:OUTSW
I CLASSX="" G EDITIT1:'CLASSREV,PRTREV
I NURSBS=11 D EN5^NURACE8 G PRTREV:CLASSREV,PRTCONT
W !!,?8,"Current Classification: ",CLASSX," Factors: ",FACTX," (",CONFIGX,")"
I $E(CONFIGX,1)="U" S NURSTCLS=CLASSX,NURSNSW=1 D FACTCK S NURSNSW=0 W !,?8,"Computer's Classification for Factors would have been: ",CLASSX S XCLAS=CLASSX,CLASSX=NURSTCLS K NURSTCLS
W !,?8,"Comments: ",COMMENTX
W !,?8,"Last user to classify: ",USERX
W !,?8,"Last date/time classified: "
I DATEX'="" S Y=DATEX D:+Y D^DIQ W Y
I NURSBS=4,FACTORS="N/A" S (CLASSX,FACTX)="",REENTSW=0 G EDITCONT
G:CLASSREV=0 PRTCONT
PRTREV ;PRINT REVIEW INFO IF REVIEWING
I ((CLASSX="")&(FACTX="")) G EDITIT1
W !,?8,"Last reviewed by: ",REVIEWER
W !,?8,"Last date/time reviewed: "
I REVDATE'="" S Y=REVDATE D:+Y D^DIQ W Y
PRTREV1 ;
W !!,"Do you wish to override this classification" S %=2 D YN^DICN
I %=-1 D EN4^NURACE8 L -^NURSF(214,DFN) S OUTSW=1 Q
I %=0 W !,"ANSWER YES OR NO" G PRTREV1
I %=1 G EDITIT1
S NOREVSW=1
Q
PRTCONT ;FINISH PRINTING PATIENT INFO
I CLASSX="" G EDITIT1
PRTCONT1 ;
W !,"Do you wish to retain this as the current classification" S %=1 D YN^DICN
I %=-1 D EN4^NURACE8 S OUTSW=1 Q
I %=1 S NURSRTSW=1 Q
I %=2 G EDITIT1
W !,"ANSWER YES OR NO" G PRTCONT1
EDITIT1 ;GO TO EDIT PATIENT CLASSIFICATION
S REENTSW=0
I CLASSX=""&(CLASSREV=1) W !,*7,"** NO FACTORS OR CLASSIFICATION ENTERED FOR THIS PATIENT **" W !!,"Do you wish to enter in a classification" S %=1 D YN^DICN G EDITIT2
G EDITCONT
EDITIT2 ;
I %=-1!(%=2) S OUTSW=1 D EN4^NURACE8 Q
I %=1 S CLASSREV=0 G EDITCONT
W !,"ANSWER YES OR NO" G EDITIT1
EDITCONT ;
L +^NURSF(214,DFN):0 I '$T W !!,$C(7),"THIS PATIENT IS BEING EDITED, TRY LATER!!" S OUTSW=1 Q
I (NURSBS=11) D EN6^NURACE8 L -^NURSF(214,DFN) Q
W !!,"PATIENT: ",NURSNAM," SSN: ",SSN
I NURSBS=5!(NURSBS=9) W !,"Choose one factor from each group."
W !,"Enter Factors: " W:(FACTX'="") FACTX,"// "
K FACT S FACT="",CK=""
R FACT:DTIME S FACT=$E(FACT,1,30)
I (FACT="^")!('$T) D EN4^NURACE8 L -^NURSF(214,DFN) S OUTSW=1 Q
I $L(FACT)>20 W !,$C(7),"This is an invalid response!" G EDITCONT
F I=1:1:$L(FACT) S:$E(FACT,I)'="," CK=CK_$E(FACT,I)
S FACT=CK
D EN1^NURACE6:(NURSBS=5!(NURSBS=9)),EN1^NURACE4:(NURSBS=1),EN1^NURACE5:(NURSBS=7),EN5^NURACE8:NURSBS=11,EN1^NURACE2:(NURSBS=3!(NURSBS=2)),EN1^NURACE9:NURSBS=4
I OUTSW L -^NURSF(214,DFN) Q
I '(NURSBS=11),REENTSW L -^NURSF(214,DFN) G EDITIT1
Q
FACTCK ;
D EN2^NURACE4:NURSBS=1,EN2^NURACE6:NURSBS=5!(NURSBS=9),EN2^NURACE5:NURSBS=7,EN2^NURACE2:NURSBS=3!(NURSBS=2),EN2^NURACE9:NURSBS=4
Q
FACTPRNT ; PRINT FACTOR LISTS
D EN2^NURACE3:NURSBS=3!(NURSBS=2),EN4^NURACE3:NURSBS=9!(NURSBS=5),EN1^NURACE3:NURSBS=1,EN3^NURACE3:NURSBS=7,EN5^NURACE3:NURSBS=4
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURACE1 3275 printed Oct 16, 2024@18:19:39 Page 2
NURACE1 ;HIRMFO/RM/MD-PATIENT CLASSIFICATION DRIVER-cont ;11/4/87
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ;BEGIN PRINTING PATIENT INFO
+1 WRITE !,?13,"PATIENT CLASSIFICATION ",NURSBSF
+2 SET NPWARD=NURSWARD
DO EN6^NURSAUTL
WRITE !!,"Patient: ",NURSNAM," SSN: ",SSN," Admission Date: ",$SELECT('PADMDT:"NO MAS ADMISSION DATE",1:PADMDT),!,"Unit: ",NPWARD," Room/Bed: ",NURSRMBD," Bed Section: ",NURSBSF
+3 IF NURSBS'=11
WRITE !,"FACTORS:"
GOTO NURSWBYP
NURSWBYP ;PRINT REST OF PATIENT INFO
+1 DO FACTPRNT
if OUTSW
QUIT
+2 IF CLASSX=""
if 'CLASSREV
GOTO EDITIT1
GOTO PRTREV
+3 IF NURSBS=11
DO EN5^NURACE8
if CLASSREV
GOTO PRTREV
GOTO PRTCONT
+4 WRITE !!,?8,"Current Classification: ",CLASSX," Factors: ",FACTX," (",CONFIGX,")"
+5 IF $EXTRACT(CONFIGX,1)="U"
SET NURSTCLS=CLASSX
SET NURSNSW=1
DO FACTCK
SET NURSNSW=0
WRITE !,?8,"Computer's Classification for Factors would have been: ",CLASSX
SET XCLAS=CLASSX
SET CLASSX=NURSTCLS
KILL NURSTCLS
+6 WRITE !,?8,"Comments: ",COMMENTX
+7 WRITE !,?8,"Last user to classify: ",USERX
+8 WRITE !,?8,"Last date/time classified: "
+9 IF DATEX'=""
SET Y=DATEX
if +Y
DO D^DIQ
WRITE Y
+10 IF NURSBS=4
IF FACTORS="N/A"
SET (CLASSX,FACTX)=""
SET REENTSW=0
GOTO EDITCONT
+11 if CLASSREV=0
GOTO PRTCONT
PRTREV ;PRINT REVIEW INFO IF REVIEWING
+1 IF ((CLASSX="")&(FACTX=""))
GOTO EDITIT1
+2 WRITE !,?8,"Last reviewed by: ",REVIEWER
+3 WRITE !,?8,"Last date/time reviewed: "
+4 IF REVDATE'=""
SET Y=REVDATE
if +Y
DO D^DIQ
WRITE Y
PRTREV1 ;
+1 WRITE !!,"Do you wish to override this classification"
SET %=2
DO YN^DICN
+2 IF %=-1
DO EN4^NURACE8
LOCK -^NURSF(214,DFN)
SET OUTSW=1
QUIT
+3 IF %=0
WRITE !,"ANSWER YES OR NO"
GOTO PRTREV1
+4 IF %=1
GOTO EDITIT1
+5 SET NOREVSW=1
+6 QUIT
PRTCONT ;FINISH PRINTING PATIENT INFO
+1 IF CLASSX=""
GOTO EDITIT1
PRTCONT1 ;
+1 WRITE !,"Do you wish to retain this as the current classification"
SET %=1
DO YN^DICN
+2 IF %=-1
DO EN4^NURACE8
SET OUTSW=1
QUIT
+3 IF %=1
SET NURSRTSW=1
QUIT
+4 IF %=2
GOTO EDITIT1
+5 WRITE !,"ANSWER YES OR NO"
GOTO PRTCONT1
EDITIT1 ;GO TO EDIT PATIENT CLASSIFICATION
+1 SET REENTSW=0
+2 IF CLASSX=""&(CLASSREV=1)
WRITE !,*7,"** NO FACTORS OR CLASSIFICATION ENTERED FOR THIS PATIENT **"
WRITE !!,"Do you wish to enter in a classification"
SET %=1
DO YN^DICN
GOTO EDITIT2
+3 GOTO EDITCONT
EDITIT2 ;
+1 IF %=-1!(%=2)
SET OUTSW=1
DO EN4^NURACE8
QUIT
+2 IF %=1
SET CLASSREV=0
GOTO EDITCONT
+3 WRITE !,"ANSWER YES OR NO"
GOTO EDITIT1
EDITCONT ;
+1 LOCK +^NURSF(214,DFN):0
IF '$TEST
WRITE !!,$CHAR(7),"THIS PATIENT IS BEING EDITED, TRY LATER!!"
SET OUTSW=1
QUIT
+2 IF (NURSBS=11)
DO EN6^NURACE8
LOCK -^NURSF(214,DFN)
QUIT
+3 WRITE !!,"PATIENT: ",NURSNAM," SSN: ",SSN
+4 IF NURSBS=5!(NURSBS=9)
WRITE !,"Choose one factor from each group."
+5 WRITE !,"Enter Factors: "
if (FACTX'="")
WRITE FACTX,"// "
+6 KILL FACT
SET FACT=""
SET CK=""
+7 READ FACT:DTIME
SET FACT=$EXTRACT(FACT,1,30)
+8 IF (FACT="^")!('$TEST)
DO EN4^NURACE8
LOCK -^NURSF(214,DFN)
SET OUTSW=1
QUIT
+9 IF $LENGTH(FACT)>20
WRITE !,$CHAR(7),"This is an invalid response!"
GOTO EDITCONT
+10 FOR I=1:1:$LENGTH(FACT)
if $EXTRACT(FACT,I)'=","
SET CK=CK_$EXTRACT(FACT,I)
+11 SET FACT=CK
+12 if (NURSBS=5!(NURSBS=9))
DO EN1^NURACE6
if (NURSBS=1)
DO EN1^NURACE4
if (NURSBS=7)
DO EN1^NURACE5
if NURSBS=11
DO EN5^NURACE8
if (NURSBS=3!(NURSBS=2))
DO EN1^NURACE2
if NURSBS=4
DO EN1^NURACE9
+13 IF OUTSW
LOCK -^NURSF(214,DFN)
QUIT
+14 IF '(NURSBS=11)
IF REENTSW
LOCK -^NURSF(214,DFN)
GOTO EDITIT1
+15 QUIT
FACTCK ;
+1 if NURSBS=1
DO EN2^NURACE4
if NURSBS=5!(NURSBS=9)
DO EN2^NURACE6
if NURSBS=7
DO EN2^NURACE5
if NURSBS=3!(NURSBS=2)
DO EN2^NURACE2
if NURSBS=4
DO EN2^NURACE9
+2 QUIT
FACTPRNT ; PRINT FACTOR LISTS
+1 if NURSBS=3!(NURSBS=2)
DO EN2^NURACE3
if NURSBS=9!(NURSBS=5)
DO EN4^NURACE3
if NURSBS=1
DO EN1^NURACE3
if NURSBS=7
DO EN3^NURACE3
if NURSBS=4
DO EN5^NURACE3
+2 QUIT
