source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURACE9.m@ 711

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1NURACE9 ;HIRMFO/MD-PATIENT CLASSIFICATION MEDICAL (SCI) ;7/89
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ;VALIDATE SCI FACTORS
4 S (ABORTSW,CHANGESW,NURS1SW,NURS3SW,NURS5SW,NURS7SW,NURS9SW,NURS11SW,NURS13SW)=0
5 I FACT["?" D EN5^NURACE3 S REENTSW=1 Q
6 F I=1:1:$L(FACT) S:(($E(FACT,I)'?1A)!($A(FACT,I)<65)!($A(FACT,I)>76)) ABORTSW=1 Q:ABORTSW=1 S FACT($E(FACT,I))=0
7 I ABORTSW=1 W $C(7)," *** BAD ENTRY - TRY AGAIN ***" S REENTSW=1 Q
8 D ONECK
9 S FACT="",NXT="" F I=0:0 S NXT=$O(FACT(NXT)) Q:NXT="" S FACT=FACT_NXT
10 I ((FACT="")&(FACTORS="")) W !,$C(7),"**** NO FACTORS ENTERED - CLASSIFICATION NOT UPDATED ****" H 3 S OUTSW=1 Q
11 I NURS1SW=1 W !,$C(7),"*** A CANNOT BE USED WITH NUMBERS B,C,D,E,F,G,H or I ***" S REENTSW=1 Q
12 I NURS3SW=1 W !,$C(7),"*** B CANNOT BE USED WITH NUMBER C ***" S REENTSW=1 Q
13 I NURS5SW=1 W !,$C(7),"*** E CANNOT BE USED WITH NUMBER D ***" S REENTSW=1 Q
14 I NURS7SW=1 W !,$C(7),"*** F and G CANNOT BE USED TOGETHER ***" S REENTSW=1 Q
15 I NURS9SW=1 W !,$C(7),"*** H and I CANNOT BE USED TOGETHER ***" S REENTSW=1 Q
16 I NURS11SW=1 W !,$C(7),"*** J and K CANNOT BE USED TOGETHER ***" S REENTSW=1 Q
17 I NURS13SW=1 W !,$C(7),"*** A and L CANNOT BE USED TOGETHER ***" S REENTSW=1 Q
18 I ((FACT="")!(FACT=FACTORS)) S NURSCKSW=1 G EN2
19 S FACTORS=FACT F I=1:1:$L(FACT) S:I=1 FACTX=$E(FACT,1) S:I'=1 FACTX=FACTX_","_$E(FACT,I)
20 S CHANGESW=1
21 G EN2
22ONECK ;DETERMINE IF FACTORS CAN BE USED WITH EACH OTHER
23 I FACT["A" I ((FACT["B")!(FACT["C")!(FACT["D")!(FACT["E")!(FACT["F")!(FACT["G")!(FACT["H")!(FACT["I")) S NURS1SW=1
24 I FACT["B"&(FACT["C") S NURS3SW=1
25 I FACT["E" I FACT["D" S NURS5SW=1
26 I ((FACT["F")&(FACT["G")) S NURS7SW=1
27 I ((FACT["H")&(FACT["I")) S NURS9SW=1
28 I ((FACT["J")&(FACT["K")) S NURS11SW=1
29 I ((FACT["A")&(FACT["L")) S NURS13SW=1
30 Q
31EN2 ;CALCULATE NEW SCI CLASSIFICATION
32 I FACTORS["A" S CLASSX=1 G CHKCLASS
33 I FACTORS["L" S CLASSX=5 G CHKCLASS
34 S (CAT(1),CAT(2),CAT(3),CAT(4))=0
35 F I="B","D","F","H" S:FACTORS[I CAT(2)=CAT(2)+1
36 F I="B","C","D","E","F","G","H","I","J" S:FACTORS[I CAT(3)=CAT(3)+1
37 F I="C","E","G","I","J","K" S:FACTORS[I CAT(4)=CAT(4)+1
38 S CAT(1)=CAT(1)+1,CAT(2)=CAT(2)+1,CAT(3)=CAT(3)+.5
39 I (((CAT(2)>CAT(3))!(CAT(2)=CAT(3)))&(CAT(2)>CAT(4))) S CLASSX=2 G CHKCLASS
40 I (((CAT(3)>CAT(2))!(CAT(3)=CAT(2)))&(CAT(3)>CAT(4))) S CLASSX=3 G CHKCLASS
41 S CLASSX=4
42CHKCLASS ;ENTER IN CLASSIFICATION IF WANT TO CHANGE
43 Q:NURSNSW=1
44 I $D(XCLAS) I ((NURSCKSW=1)&(CLASSX=XCLAS)) S CHANGESW=1
45CHKCLAS1 ;
46 W !,"Enter Classification: " W:(CLASSX'="") CLASSX,"//" R X:DTIME S X=$E(X,1,2)
47 I (X="^")!('$T) D EN4^NURACE8 S OUTSW=1 Q
48 I X["?" W !,"ANSWER WITH A NUMBER BETWEEN 1 AND 5" G CHKCLAS1
49 I $L(X)=0 S:CHANGESW=1 CONFIGX="COMPUTER" Q
50 I (($L(X)>1)!(X?1A)!(X<1)!(X>5)) W *7," *** BAD ENTRY - TRY AGAIN ***" G CHKCLASS
51 I X=CLASSX S:CHANGESW=1 CONFIGX="COMPUTER" Q
52 S CHANGESW=1,CLASSX=X,CONFIGX="USER"
53 Q
Note: See TracBrowser for help on using the repository browser.