69 lines
3.1 KiB
Mathematica
69 lines
3.1 KiB
Mathematica
NURACE1 ;HIRMFO/RM/MD-PATIENT CLASSIFICATION DRIVER-cont ;11/4/87
|
|
;;4.0;NURSING SERVICE;;Apr 25, 1997
|
|
EN1 ;BEGIN PRINTING PATIENT INFO
|
|
W !,?13,"PATIENT CLASSIFICATION ",NURSBSF
|
|
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
|
|
I NURSBS'=11 W !,"FACTORS:" G NURSWBYP
|
|
NURSWBYP ;PRINT REST OF PATIENT INFO
|
|
D FACTPRNT Q:OUTSW
|
|
I CLASSX="" G EDITIT1:'CLASSREV,PRTREV
|
|
I NURSBS=11 D EN5^NURACE8 G PRTREV:CLASSREV,PRTCONT
|
|
W !!,?8,"Current Classification: ",CLASSX," Factors: ",FACTX," (",CONFIGX,")"
|
|
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
|
|
W !,?8,"Comments: ",COMMENTX
|
|
W !,?8,"Last user to classify: ",USERX
|
|
W !,?8,"Last date/time classified: "
|
|
I DATEX'="" S Y=DATEX D:+Y D^DIQ W Y
|
|
I NURSBS=4,FACTORS="N/A" S (CLASSX,FACTX)="",REENTSW=0 G EDITCONT
|
|
G:CLASSREV=0 PRTCONT
|
|
PRTREV ;PRINT REVIEW INFO IF REVIEWING
|
|
I ((CLASSX="")&(FACTX="")) G EDITIT1
|
|
W !,?8,"Last reviewed by: ",REVIEWER
|
|
W !,?8,"Last date/time reviewed: "
|
|
I REVDATE'="" S Y=REVDATE D:+Y D^DIQ W Y
|
|
PRTREV1 ;
|
|
W !!,"Do you wish to override this classification" S %=2 D YN^DICN
|
|
I %=-1 D EN4^NURACE8 L -^NURSF(214,DFN) S OUTSW=1 Q
|
|
I %=0 W !,"ANSWER YES OR NO" G PRTREV1
|
|
I %=1 G EDITIT1
|
|
S NOREVSW=1
|
|
Q
|
|
PRTCONT ;FINISH PRINTING PATIENT INFO
|
|
I CLASSX="" G EDITIT1
|
|
PRTCONT1 ;
|
|
W !,"Do you wish to retain this as the current classification" S %=1 D YN^DICN
|
|
I %=-1 D EN4^NURACE8 S OUTSW=1 Q
|
|
I %=1 S NURSRTSW=1 Q
|
|
I %=2 G EDITIT1
|
|
W !,"ANSWER YES OR NO" G PRTCONT1
|
|
EDITIT1 ;GO TO EDIT PATIENT CLASSIFICATION
|
|
S REENTSW=0
|
|
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
|
|
G EDITCONT
|
|
EDITIT2 ;
|
|
I %=-1!(%=2) S OUTSW=1 D EN4^NURACE8 Q
|
|
I %=1 S CLASSREV=0 G EDITCONT
|
|
W !,"ANSWER YES OR NO" G EDITIT1
|
|
EDITCONT ;
|
|
L +^NURSF(214,DFN):0 I '$T W !!,$C(7),"THIS PATIENT IS BEING EDITED, TRY LATER!!" S OUTSW=1 Q
|
|
I (NURSBS=11) D EN6^NURACE8 L -^NURSF(214,DFN) Q
|
|
W !!,"PATIENT: ",NURSNAM," SSN: ",SSN
|
|
I NURSBS=5!(NURSBS=9) W !,"Choose one factor from each group."
|
|
W !,"Enter Factors: " W:(FACTX'="") FACTX,"// "
|
|
K FACT S FACT="",CK=""
|
|
R FACT:DTIME S FACT=$E(FACT,1,30)
|
|
I (FACT="^")!('$T) D EN4^NURACE8 L -^NURSF(214,DFN) S OUTSW=1 Q
|
|
I $L(FACT)>20 W !,$C(7),"This is an invalid response!" G EDITCONT
|
|
F I=1:1:$L(FACT) S:$E(FACT,I)'="," CK=CK_$E(FACT,I)
|
|
S FACT=CK
|
|
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
|
|
I OUTSW L -^NURSF(214,DFN) Q
|
|
I '(NURSBS=11),REENTSW L -^NURSF(214,DFN) G EDITIT1
|
|
Q
|
|
FACTCK ;
|
|
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
|
|
Q
|
|
FACTPRNT ; PRINT FACTOR LISTS
|
|
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
|
|
Q
|