source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURACE1.m@ 1397

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