source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURACE6.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1NURACE6 ;HIRMFO/RM-PATIENT CLASSIFICATION EXTENDED CARE ;NOVEMBER 17, 1986
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ;ENTER IN CLASSIFICATION FACTORS
4 S ABORTSW=0,CHANGESW=0,NURS1SW=0,NURS4SW=0,NURS7SW=0,NURS10SW=0,NURS13SW=0
5 I FACT["?" D EN4^NURACE3 S REENTSW=1 Q
6 F I=1:1:$L(FACT) S:(($A(FACT,I)<65)!($E(FACT,I)'?1A)!($A(FACT,I)>79)) ABORTSW=1 Q:ABORTSW=1 S FACT($E(FACT,I))=0
7 I ABORTSW=1 W *7," *** BAD ENTRY - TRY AGAIN ***" S REENTSW=1 Q
8 D EN1^NURACE8
9 S FACT="",NXT="" F I=0:0 S NXT=$O(FACT(NXT)) Q:NXT="" S FACT=FACT_NXT
10 I ((FACT="")&(FACTORS="")) W !,*7,"**** NO FACTORS ENTERED - CLASSIFICATION NOT UPDATED ****" H 3 S OUTSW=1 Q
11 I NURS1SW=1 W !,*7,"*** FACTORS A,B or C CANNOT BE USED TOGETHER ***" S REENTSW=1 Q
12 I NURS4SW=1 W !,*7,"*** FACTORS D,E or F CANNOT BE USED TOGETHER ***" S REENTSW=1 Q
13 I NURS7SW=1 W !,*7,"*** FACTORS G,H or I CANNOT BE USED TOGETHER ***" S REENTSW=1 Q
14 I NURS10SW=1 W !,*7,"*** FACTORS J,K or L CANNOT BE USED TOGETHER ***" S REENTSW=1 Q
15 I NURS13SW=1 W !,*7,"*** FACTORS M,N or O CANNOT BE USED TOGETHER ***" S REENTSW=1 Q
16 I ((FACT="")!(FACT=FACTORS)) S NURSCKSW=1 G EN2
17 I ((FACT'["A")&(FACT'["B")&(FACT'["C")) W !,*7,"*** YOU MUST PICK ONE OF THE FIRST THREE FACTORS A,B or C ***" S REENTSW=1 Q
18 I ((FACT'["D")&(FACT'["E")&(FACT'["F")) W !,*7,"*** YOU MUST PICK ONE OF THE SECOND THREE FACTORS D,E or F ***" S REENTSW=1 Q
19 I ((FACT'["G")&(FACT'["H")&(FACT'["I")) W !,*7,"*** YOU MUST PICK ONE OF THE THIRD THREE FACTORS G,H or I ***" S REENTSW=1 Q
20 I ((FACT'["J")&(FACT'["K")&(FACT'["L")) W !,*7,"*** YOU MUST PICK ONE OF THE FOURTH THREE FACTORS J,K or L ***" S REENTSW=1 Q
21 I ((FACT'["M")&(FACT'["N")&(FACT'["O")) W !,*7,"*** YOU MUST PICK ONE OF THE FIFTH THREE FACTORS M,N or O ***" S REENTSW=1 Q
22 S FACTORS=FACT F I=1:1:$L(FACT) S:I=1 FACTX=$E(FACT,1) S:I'=1 FACTX=FACTX_","_$E(FACT,I)
23 S CHANGESW=1
24EN2 ;DETERMINE NEW CLASSIFICATION
25 S (CAT(1),CAT(2),CAT(3))=0
26 F I="A","D","G","J","M" S:FACTORS[I CAT(1)=CAT(1)+1
27 F I="B","E","H","K","N" S:FACTORS[I CAT(2)=CAT(2)+1
28 F I="C","F","I","L","O" S:FACTORS[I CAT(3)=CAT(3)+1
29 I ((CAT(1)>CAT(2))&(CAT(1)>CAT(3))) S CLASSX=1 G CHKCLASS
30 I (((CAT(2)>CAT(1))!(CAT(2)=CAT(1)))&(CAT(2)>CAT(3))) S CLASSX=2 G CHKCLASS
31 S CLASSX=3
32CHKCLASS ;ENTER NEW CLASSIFICATION IF DESIRED
33 Q:NURSNSW=1
34 I $D(XCLAS) I ((NURSCKSW=1)&(CLASSX=XCLAS)) S CHANGESW=1
35CHKCLAS1 ;
36 W !,"Enter Classification: " W:(CLASSX'="") CLASSX,"//" R X:DTIME S X=$E(X,1,2)
37 I (X="^")!('$T) D EN4^NURACE8 S OUTSW=1 Q
38 I X["?" W !,"ANSWER WITH A NUMBER BETWEEN 1 AND 3" G CHKCLAS1
39 I $L(X)=0 S:CHANGESW=1 CONFIGX="COMPUTER" Q
40 I (($L(X)>1)!(X?1A)!(X<1)!(X>3)) W *7," *** BAD ENTRY - TRY AGAIN ***" G CHKCLASS
41 I X=CLASSX S:CHANGESW=1 CONFIGX="COMPUTER" Q
42 S CHANGESW=1,CLASSX=X,CONFIGX="USER"
43 Q
Note: See TracBrowser for help on using the repository browser.