source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURACE2.m@ 623

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1NURACE2 ;HIRMFO/RM-PATIENT CLASSIFICATION MEDICAL/SURGICAL ;NOVEMBER 17, 1986
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ;DETERMINE IF FACTORS ENTERED VALID
4 S ABORTSW=0,CHANGESW=0,NURS1SW=0,NURS4SW=0,NURS6SW=0,NURS9SW=0
5 I FACT["?" D EN2^NURACE3 S REENTSW=1 Q
6 F I=1:1:$L(FACT) S:(($E(FACT,I)'?1N)!($E(FACT,I)'>0)!($E(FACT,I)'<10)) 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 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 !,*7,"**** NO FACTORS ENTERED - CLASSIFICATION NOT UPDATED ****" H 3 S OUTSW=1 Q
11 I NURS1SW=1 W !,*7,"*** #1 CANNOT BE USED WITH NUMBERS 2,3,4,5, or 6 ***" S REENTSW=1 Q
12 I NURS4SW=1 W !,*7,"*** #4 CANNOT BE USED WITH NUMBERS 2 or 3 ***" S REENTSW=1 Q
13 I NURS6SW=1 W !,*7,"*** #5 and #6 CANNOT BE USED TOGETHER ***" S REENTSW=1 Q
14 I NURS9SW=1 W !,*7,"*** #8 and #9 CANNOT BE USED TOGETHER ***" S REENTSW=1 Q
15 I ((FACT="")!(FACT=FACTORS)) S NURSCKSW=1 G EN2
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
18 G EN2
19ONECK ;DETERMINE IF FACTORS CAN BE USED WITH EACH OTHER
20 I FACT[1 I ((FACT[2)!(FACT[3)!(FACT[4)!(FACT[5)!(FACT[6)) S NURS1SW=1
21 I FACT[4 I ((FACT[2)!(FACT[3)) S NURS4SW=1
22 I ((FACT[5)&(FACT[6)) S NURS6SW=1
23 I ((FACT[8)&(FACT[9)) S NURS9SW=1
24 Q
25EN2 ;CALCULATE NEW CLASSIFICATION
26 I FACTORS[9 S CLASSX=4 G CHKCLASS
27 S (CAT(1),CAT(2),CAT(3),CAT(4))=0
28 I FACTORS[1 S CAT(1)=CAT(1)+1
29 F I=2,3,5,7 S:FACTORS[I CAT(2)=CAT(2)+1
30 F I=2,3,4,5,6,7,8 S:FACTORS[I CAT(3)=CAT(3)+1
31 F I=4,6,7,8 S:FACTORS[I CAT(4)=CAT(4)+1
32 S CAT(1)=CAT(1)+1,CAT(2)=CAT(2)+1,CAT(3)=CAT(3)+.5
33 I ((CAT(1)>CAT(2))&(CAT(1)>CAT(3))&(CAT(1)>CAT(4))) S CLASSX=1 G CHKCLASS
34 I (((CAT(2)>CAT(1))!(CAT(2)=CAT(1)))&(CAT(2)>CAT(3))&(CAT(2)>CAT(4))) S CLASSX=2 G CHKCLASS
35 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
36 S CLASSX=4
37CHKCLASS ;ENTER IN CLASSIFICATION IF WANT TO CHANGE
38 Q:NURSNSW=1
39 I $D(XCLAS) I ((NURSCKSW=1)&(CLASSX=XCLAS)) S CHANGESW=1
40CHKCLAS1 ;
41 W !,"Enter Classification: " W:(CLASSX'="") CLASSX,"//" R X:DTIME S X=$E(X,1,2)
42 I (X="^")!('$T) D EN4^NURACE8 L -^NURSF(214,DFN) S OUTSW=1 Q
43 I X["?" W !,"ANSWER WITH A NUMBER BETWEEN 1 AND 4" G CHKCLAS1
44 I $L(X)=0 S:CHANGESW=1 CONFIGX="COMPUTER" Q
45 I (($L(X)>1)!(X?1A)!(X<1)!(X>4)) W *7," *** BAD ENTRY - TRY AGAIN ***" G CHKCLASS
46 I X=CLASSX S:CHANGESW=1 CONFIGX="COMPUTER" Q
47 S CHANGESW=1,CLASSX=X,CONFIGX="USER"
48 Q
Note: See TracBrowser for help on using the repository browser.