| 1 | NURACE0 ;HIRMFO/RM-PATIENT CLASSIFICATION DRIVER ;4/15/88
|
|---|
| 2 | ;;4.0;NURSING SERVICE;**3**;Apr 25, 1997
|
|---|
| 3 | EN1 ; ENTRY FROM ROUTINES NURACEW1 or NURACEW
|
|---|
| 4 | Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
|
|---|
| 5 | S CLASSREV=0 G SELT1
|
|---|
| 6 | EN2 ; ENTRY FROM OPTION NURAPC-REVIND OR ROUTINE NURACEW
|
|---|
| 7 | Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
|
|---|
| 8 | S CLASSREV=1
|
|---|
| 9 | SELT1 ; SET USER NAME
|
|---|
| 10 | S IOP=ION D QUIT,^%ZIS W @IOF S U="^" K IOP
|
|---|
| 11 | S NURSUSER=$P(^VA(200,DUZ,0),"^",1)
|
|---|
| 12 | SELTLOP ;ENTER STAFF DATA
|
|---|
| 13 | S NURSNSW=0,NURSCKSW=0,NOREVSW=0,NURSRTSW=0,NASK=1
|
|---|
| 14 | I $D(NURSTABL) G:TABLSW=1 KILL S X="`"_+NURSTABL(TCNT),TABLSW=1,NASK=0
|
|---|
| 15 | S DIC(0)="EMZQ",NACT=1 D EN5^NURSCUTL G KILL:DFN'>0 D ^NURSAPCH
|
|---|
| 16 | I NURSX'="LEAVE"&(NURSX'="AWOL")&(NURSX'="OTH. FAC.") G AROUND
|
|---|
| 17 | STAT W !!," THIS PATIENT IS ",$S(NURSX="LEAVE":"ON "_NURSX,NURSX="AWOL":NURSX,NURSX="OTH. FAC.":"IN ANOTHER FACILITY",1:""),", DO YOU STILL WISH TO CLASSIFY"
|
|---|
| 18 | S %=2 D YN^DICN
|
|---|
| 19 | G KILL:%=-1,SELTLOP:%=2,AROUND:%=1
|
|---|
| 20 | W !!," ANSWER YES OR NO " G STAT
|
|---|
| 21 | AROUND D 1^VADPT S NURSNAM=VADM(1),SSN=VA("PID")
|
|---|
| 22 | S NURSRMBD=VAIN(5)
|
|---|
| 23 | S NAX=^NURSF(214,DFN,0)
|
|---|
| 24 | S NURSWARD=$S($D(NAX):$P(NAX,U,3),1:"")
|
|---|
| 25 | S NURSBS=$S($D(NAX):$P(NAX,U,4),1:"")
|
|---|
| 26 | D EN6^NURSCUTL S PADMDT=$P(VAIN(7),U),PADMDT=$S(PADMDT'="":$E(PADMDT,4,5)_"/"_$E(PADMDT,6,7)_"/"_$E(PADMDT,2,3),1:"")
|
|---|
| 27 | STARTIT ;CONTINUE CLASSIFICATION
|
|---|
| 28 | I NURSBS=""!(NURSWARD="") W $C(7),!!," BAD LOCATION/BED SECTION DATA-CANNOT CLASSIFY " G KILL
|
|---|
| 29 | S NURSBSF=$S($D(^NURSF(213.3,NURSBS,0)):$P(^(0),U,1),1:"")
|
|---|
| 30 | I NURSBS=8!(NURSBS=6)!(NURSBS=10) W !!,$C(7),"CANNOT CLASSIFY ",NURSBSF," PATIENTS " G KILL
|
|---|
| 31 | S NURSCLAS("CL")=1 D EN2^NURSCUTL
|
|---|
| 32 | A I NURSCLAS'>0 S (CLASSX,CONFIGX,USERX,FACTX,COMMENTX,USENO,FACTORS,DATEX)="" G STARTREV
|
|---|
| 33 | S NCX=$S($D(^NURSA(214.6,NURSCLAS,0)):^(0),1:""),NURSBS1=$P(NCX,"^",9)
|
|---|
| 34 | I NURSBS1="" W $C(7),"****BAD PREVIOUS CLASSIFICATION DATA CANNOT PROCESS THIS PATIENT****" Q
|
|---|
| 35 | I NURSBS'=NURSBS1 S (CLASSX,CONFIGX,USERX,FACTX,COMMENTX,USENO,FACTORS,DATEX)="",CLASSREV=0 G STARTREV
|
|---|
| 36 | S DATEX=$P(NCX,"^",1),CLASSX=$P(NCX,"^",3),CONFIGX=$P(NCX,"^",5)
|
|---|
| 37 | S:CONFIGX="C" CONFIGX="COMPUTER" S:CONFIGX="U" CONFIGX="USER"
|
|---|
| 38 | S FACTX="",FACTORS=$P(NCX,"^",4),USENO=$P(NCX,"^",6),COMMENTX=$P(NCX,"^",7),USERX=$P(^VA(200,USENO,0),"^",1)
|
|---|
| 39 | I FACTORS'="N/A" F I=1:1:$L(FACTORS) S:I=1 FACTX=$E(FACTORS,1) S:I'=1 FACTX=FACTX_","_$E(FACTORS,I)
|
|---|
| 40 | E S FACTX="N/A"
|
|---|
| 41 | STARTREV ; SET VARIABLES IF REVIEWING PATIENT RECORD
|
|---|
| 42 | D EN1^NURACE7
|
|---|
| 43 | G SELTLOP
|
|---|
| 44 | CHKJOB ;
|
|---|
| 45 | ; if acuity job did not run print warning, but do not stop user from
|
|---|
| 46 | ; classifying patients
|
|---|
| 47 | I $S('$D(^DIC(213.9,1,"DATE")):1,$P(^("DATE"),"^")'=DT:1,'$P(^("DATE"),"^",2):1,1:0) W !! D EN3^NURACE8
|
|---|
| 48 | Q
|
|---|
| 49 | KILL ;KILL CLASSREV VARIABLE
|
|---|
| 50 | K CLASSREV
|
|---|
| 51 | QUIT ;KILL LOCAL VARIABLES
|
|---|
| 52 | K %DT,ABORTSW,CAT,CHANGESW,NURSBS1,CK,CLASSX,COMMENTX,CONFIGX,DA,DATEX,DIC,DFN,NURS8SW,NURSCLAS,CHKVAR,FACT,FACTORS,FACTX,FCK,NURS5SW,NURS4SW,I,J,NOREVSW,REENTSW,NURSRVDT,NURSRTSW,NURSREV,NEWREV,NACT,NAX,NCX,NRX,NURSX,NURS11SW,TX,VAROOT
|
|---|
| 53 | K NS1,NURSA,NURSTRAN,NURSOLDC,NASK,FACT1 D KVAR^VADPT K VA
|
|---|
| 54 | K NURS9SW,NURSADM,NURSCKSW,NURSTCLS,NURMDSW,NWFCTSW,NXT,NURS1SW,OUTSW,PADMDT,NURSNAM,SSN,PREV,REVDATE,REVIEWER,REVNO,SAVEX,NURS7SW,NURS6SW,NURS10SW,NURS3SW,NURS13SW,NURSUSER,USENO,USERX,NURSBS,XCLAS,NURSWARD,NURSRMBD,NURSBSF,%,NPWARD
|
|---|
| 55 | Q
|
|---|
