source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURACE1.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1NURACE1 ;HIRMFO/RM/MD-PATIENT CLASSIFICATION DRIVER-cont ;11/4/87
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ;BEGIN PRINTING PATIENT INFO
4 W !,?13,"PATIENT CLASSIFICATION ",NURSBSF
5 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
6 I NURSBS'=11 W !,"FACTORS:" G NURSWBYP
7NURSWBYP ;PRINT REST OF PATIENT INFO
8 D FACTPRNT Q:OUTSW
9 I CLASSX="" G EDITIT1:'CLASSREV,PRTREV
10 I NURSBS=11 D EN5^NURACE8 G PRTREV:CLASSREV,PRTCONT
11 W !!,?8,"Current Classification: ",CLASSX," Factors: ",FACTX," (",CONFIGX,")"
12 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
13 W !,?8,"Comments: ",COMMENTX
14 W !,?8,"Last user to classify: ",USERX
15 W !,?8,"Last date/time classified: "
16 I DATEX'="" S Y=DATEX D:+Y D^DIQ W Y
17 I NURSBS=4,FACTORS="N/A" S (CLASSX,FACTX)="",REENTSW=0 G EDITCONT
18 G:CLASSREV=0 PRTCONT
19PRTREV ;PRINT REVIEW INFO IF REVIEWING
20 I ((CLASSX="")&(FACTX="")) G EDITIT1
21 W !,?8,"Last reviewed by: ",REVIEWER
22 W !,?8,"Last date/time reviewed: "
23 I REVDATE'="" S Y=REVDATE D:+Y D^DIQ W Y
24PRTREV1 ;
25 W !!,"Do you wish to override this classification" S %=2 D YN^DICN
26 I %=-1 D EN4^NURACE8 L -^NURSF(214,DFN) S OUTSW=1 Q
27 I %=0 W !,"ANSWER YES OR NO" G PRTREV1
28 I %=1 G EDITIT1
29 S NOREVSW=1
30 Q
31PRTCONT ;FINISH PRINTING PATIENT INFO
32 I CLASSX="" G EDITIT1
33PRTCONT1 ;
34 W !,"Do you wish to retain this as the current classification" S %=1 D YN^DICN
35 I %=-1 D EN4^NURACE8 S OUTSW=1 Q
36 I %=1 S NURSRTSW=1 Q
37 I %=2 G EDITIT1
38 W !,"ANSWER YES OR NO" G PRTCONT1
39EDITIT1 ;GO TO EDIT PATIENT CLASSIFICATION
40 S REENTSW=0
41 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
42 G EDITCONT
43EDITIT2 ;
44 I %=-1!(%=2) S OUTSW=1 D EN4^NURACE8 Q
45 I %=1 S CLASSREV=0 G EDITCONT
46 W !,"ANSWER YES OR NO" G EDITIT1
47EDITCONT ;
48 L +^NURSF(214,DFN):0 I '$T W !!,$C(7),"THIS PATIENT IS BEING EDITED, TRY LATER!!" S OUTSW=1 Q
49 I (NURSBS=11) D EN6^NURACE8 L -^NURSF(214,DFN) Q
50 W !!,"PATIENT: ",NURSNAM," SSN: ",SSN
51 I NURSBS=5!(NURSBS=9) W !,"Choose one factor from each group."
52 W !,"Enter Factors: " W:(FACTX'="") FACTX,"// "
53 K FACT S FACT="",CK=""
54 R FACT:DTIME S FACT=$E(FACT,1,30)
55 I (FACT="^")!('$T) D EN4^NURACE8 L -^NURSF(214,DFN) S OUTSW=1 Q
56 I $L(FACT)>20 W !,$C(7),"This is an invalid response!" G EDITCONT
57 F I=1:1:$L(FACT) S:$E(FACT,I)'="," CK=CK_$E(FACT,I)
58 S FACT=CK
59 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
60 I OUTSW L -^NURSF(214,DFN) Q
61 I '(NURSBS=11),REENTSW L -^NURSF(214,DFN) G EDITIT1
62 Q
63FACTCK ;
64 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
65 Q
66FACTPRNT ; PRINT FACTOR LISTS
67 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
68 Q
Note: See TracBrowser for help on using the repository browser.