source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURACE4.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

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