NURSUT1 ;HIRMFO/RM,MD-NURS POSITION CONTROL FILE EDIT UTILITY (CONT) ; 5/16/03 5:10pm
;;4.0;NURSING SERVICE;**2,7,13,39**;Apr 25, 1997
EN1 ; ENTRY FROM ASD1 FROM 211.82,.01, ASD2 FROM 211.82,3 AND ASD3 FROM
; 211.82,5 CROSSREFERENCES. THE VARIABLE NUR WILL BE SET TO THE
; FOLLOWING: FIELD NUMBER CALLING XREF^$S(0:KILL LOGIC,1:SET LOGIC)
N DIK
S NUR(211.82)=$S($D(^NURSF(211.8,DA(1),1,DA,0)):^(0),1:""),NUR("SDT")=$S(+NUR=.01:X,1:+NUR(211.82)),NUR("VDT")=$S(+NUR=3:X,1:$P(NUR(211.82),"^",6))
I +NUR=.01 S:$P(NUR,"^",2) ^NURSF(211.8,"ASD",2,DA(1),DA)="" K:'$P(NUR,"^",2) ^NURSF(211.8,"ASD",2,DA(1),DA)
I +NUR=3 S:$P(NUR,"^",2) ^NURSF(211.8,"ASD",1,DA(1),DA)="" K:'$P(NUR,"^",2) ^NURSF(211.8,"ASD",1,DA(1),DA)
D EMP Q
EN1B ; ENTRY POINT TO KILL "ASD" X-REF AFTER ADDED TO 213.5 DURING ACT/SEP BATCH JOB
N DIK
S NUR(211.82)=$S($D(^NURSF(211.8,DA(1),1,DA,0)):^(0),1:""),NUR("SDT")=$S(+NUR=.01:X,1:+NUR(211.82)),NUR("VDT")=$S(+NUR=3:X,1:$P(NUR(211.82),"^",6))
I NUR("SDT")'>DT,+NUR=.01 K ^NURSF(211.8,"ASD",2,DA(1),DA)
I NUR("VDT")'>DT,+NUR=3 K ^NURSF(211.8,"ASD",1,DA(1),DA)
EMP D STTUPD I +NUR=.01!(+NUR=3) S NUR("PE")=NUR D EN1^NURSAPE0
K NUR
Q
STTUPD ; CHECK IF UPDATE OF STATUS FIELD IN FILE 210 IS NECESSARY
S NUR(0)=X D NOW^%DTC S X=NUR(0),NURSDT=%,(NURSEMP,NUR(200))=$P(NUR(211.82),"^",2) G:NUR(200)'>0 QSU S NUR(200)=$P(NUR(211.82),"^",2)
S NUR(210)=$O(^NURSF(210,"B",NUR(200),0)) G QSU:NUR(210)'>0 S NUR("OST")=$S($D(^NURSF(210,NUR(210),0)):$P(^(0),"^",2),1:"")
I NUR("OST")'="A",NUR("OST")'="I",+$$EN1^NURSUT0($G(NURSEMP),$G(NURSDT)) S NUR("NST")="A" D SETST
I '+$$EN1^NURSUT0($G(NURSEMP),$G(NURSDT)) S NUR(211.9)=$S(+NUR=5:X,1:$P(NUR(211.82),"^",8)),NUR("NST")=$S(NURSTAT:"A",$D(^NURSF(211.9,+NUR(211.9),0)):$P(^(0),"^",3),1:"R") I NUR("NST")'="",NUR("NST")'=NUR("OST") D SETST
QSU Q
SETST ; CHANGE STATUS FIELD OF FILE 210
N DA,X S DA=$O(^NURSF(210,"B",NUR(200),0)) Q:DA'>0
I NUR("OST")'="" S X=NUR("OST") K ^NURSF(210,"AC",X,DA)
I NUR("NST")'="" S X=NUR("NST"),$P(^NURSF(210,DA,0),"^",2)=X,DIK="^NURSF(210," D IX1^DIK
Q
EN4(NACT,NASK) ; ENTRY POINT FOR BEDSIDE TERMINAL PATIENT LOOK-UP
I '$D(^NURSC(214.8,0)) S NURBEDSW=0 Q
S IEN=0,IEN=$O(^NURSC(214.8,"B",ION,IEN)),ROOMBED=$S(+IEN>0:$P(^NURSC(214.8,IEN,0),U,2),1:""),PATIENT=""
I ROOMBED'="" S IEN=0,IEN=$O(^DPT("RM",ROOMBED,IEN)),PATIENT=$S(+IEN>0:$P(^DPT(IEN,0),U,1),1:"") W !!,?5,"Room-Bed: ",ROOMBED,!,?6,"Patient: ",PATIENT
S:'(DIC(0)["A") DIC(0)="A"_DIC(0) S:'(PATIENT="") DIC("B")=PATIENT
S DIC("A")="Select PATIENT NAME: "
W ! S DFN="",DIC="^DPT(" D ^DIC K DIC S:$L($P(Y,"^",2)) X=$P(Y,"^",2) I $D(DTOUT)!$D(DUOUT) S DFN="" G QUIT
I +Y>0,NACT,'$D(^NURSF(214,"C","A",+Y)) S Y=-2
I +Y>0 S DFN=+Y K DIC W ! G QUIT
I X'["?",(X?1U.UP1","1U.UP) W !!,$C(7),$S('NACT!(NACT&(Y=-1)):"PATIENT not admitted with MAS -- notify MAS",1:"PATIENT is not active in the Nursing system -- notify Nursing ADP coordinator")
QUIT K DTOUT,DUOUT,IEN,LOOP,PATIENT,ROOMBED
Q
DBL ;CHECK FOR ROOM-BED DUPLICATE ENTRIES
I X="" K X Q
S IEN=0,IEN=$O(^NURSC(214.8,"C",X,IEN))
I +IEN>0 W *7,!!,?5,"That ROOM-BED is already associated with ION VALUE "_$P(^NURSC(214.8,IEN,0),U,1)_" " K X
K IEN Q
CLOSE ; CLOSE DEVICE
W !
I '+$G(NUROUT) D ENDPG
D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
Q
ENDPG ; HANDLE EOP
I $E($G(IOST))'="C" Q
K DIR S DIR(0)="E" D ^DIR K DIR S NUROUT=$S(+Y'>0:1,1:0)
Q
LOCSTAT(NURLOC) ; CHECK FOR ACTIVE EMPLOYEES ON NURS LOCATION
N NURPOS,NPOSDA S NURACTV=0
S NURPOS="" F S NURPOS=$O(^NURSF(211.8,"B",+NURLOC,NURPOS)) Q:NURPOS'>0 S NPOSDA=0 F S NPOSDA=$O(^NURSF(211.8,NURPOS,1,NPOSDA)) Q:NPOSDA'>0 I $G(^NURSF(211.8,NURPOS,1,NPOSDA,0))'="" D
. I $P($G(^NURSF(211.8,NURPOS,1,NPOSDA,0)),U,6)=""!($P($G(^(0)),U,6)'<DT) S NURACTV=1 Q
. Q
Q NURACTV
CHKSTAT ; INPUT TRANSFORM FOR STATUS FIELD OF NURS LOCATION FILE
N NURLOC S NURLOC=+$G(^NURSF(211.4,+DA,0)),NURLOC(1)=$P(^SC(+$G(^NURSF(211.4,DA,0)),0),"^"),NURLOC(1)=$P(NURLOC(1),"NUR ",2),NURSTAT=0,NURSTAT=$S($G(X)="I":+$$LOCSTAT^NURSUT1(NURLOC),1:0)
I $G(X)="I",$G(NURSTAT)>0 D
. W $C(7),!!,NURLOC(1)," HAS ACTIVE STAFF ASSIGNED AND CANNOT BE DEACTIVATED: ",!!,"Generate an FTEE report for this location to identify active staff members",!,"who should be transferred prior to deactivation!" D ENDPG^NURSUT1
. Q
Q
BUDCAT(D0) ; COMPUTE BUDGET CATEGORY FTEE FOR A LOCATION
N D1 S X=0
S D1=0 F S D1=$O(^NURSF(211.8,D0,2,D1)) Q:D1'>0 I $D(^NURSF(211.8,D0,2,D1,0)) S X=(X+$P(^(0),U,2))
Q X
NODATA ; NO DATA ROUTINE FOR LOCATION REPORTS
W !!,"THERE IS NO DATA FOR ",NL1
Q
NURSUT1 ;HIRMFO/RM,MD-NURS POSITION CONTROL FILE EDIT UTILITY (CONT) ; 5/16/03 5:10pm
+1 ;;4.0;NURSING SERVICE;**2,7,13,39**;Apr 25, 1997
EN1 ; ENTRY FROM ASD1 FROM 211.82,.01, ASD2 FROM 211.82,3 AND ASD3 FROM
+1 ; 211.82,5 CROSSREFERENCES. THE VARIABLE NUR WILL BE SET TO THE
+2 ; FOLLOWING: FIELD NUMBER CALLING XREF^$S(0:KILL LOGIC,1:SET LOGIC)
+3 NEW DIK
+4 SET NUR(211.82)=$SELECT($DATA(^NURSF(211.8,DA(1),1,DA,0)):^(0),1:"")
SET NUR("SDT")=$SELECT(+NUR=.01:X,1:+NUR(211.82))
SET NUR("VDT")=$SELECT(+NUR=3:X,1:$PIECE(NUR(211.82),"^",6))
+5 IF +NUR=.01
IF $PIECE(NUR,"^",2)
SET ^NURSF(211.8,"ASD",2,DA(1),DA)=""
IF '$PIECE(NUR,"^",2)
KILL ^NURSF(211.8,"ASD",2,DA(1),DA)
+6 IF +NUR=3
IF $PIECE(NUR,"^",2)
SET ^NURSF(211.8,"ASD",1,DA(1),DA)=""
IF '$PIECE(NUR,"^",2)
KILL ^NURSF(211.8,"ASD",1,DA(1),DA)
+7 DO EMP
QUIT
EN1B ; ENTRY POINT TO KILL "ASD" X-REF AFTER ADDED TO 213.5 DURING ACT/SEP BATCH JOB
+1 NEW DIK
+2 SET NUR(211.82)=$SELECT($DATA(^NURSF(211.8,DA(1),1,DA,0)):^(0),1:"")
SET NUR("SDT")=$SELECT(+NUR=.01:X,1:+NUR(211.82))
SET NUR("VDT")=$SELECT(+NUR=3:X,1:$PIECE(NUR(211.82),"^",6))
+3 IF NUR("SDT")'>DT
IF +NUR=.01
KILL ^NURSF(211.8,"ASD",2,DA(1),DA)
+4 IF NUR("VDT")'>DT
IF +NUR=3
KILL ^NURSF(211.8,"ASD",1,DA(1),DA)
EMP DO STTUPD
IF +NUR=.01!(+NUR=3)
SET NUR("PE")=NUR
DO EN1^NURSAPE0
+1 KILL NUR
+2 QUIT
STTUPD ; CHECK IF UPDATE OF STATUS FIELD IN FILE 210 IS NECESSARY
+1 SET NUR(0)=X
DO NOW^%DTC
SET X=NUR(0)
SET NURSDT=%
SET (NURSEMP,NUR(200))=$PIECE(NUR(211.82),"^",2)
IF NUR(200)'>0
GOTO QSU
SET NUR(200)=$PIECE(NUR(211.82),"^",2)
+2 SET NUR(210)=$ORDER(^NURSF(210,"B",NUR(200),0))
IF NUR(210)'>0
GOTO QSU
SET NUR("OST")=$SELECT($DATA(^NURSF(210,NUR(210),0)):$PIECE(^(0),"^",2),1:"")
+3 IF NUR("OST")'="A"
IF NUR("OST")'="I"
IF +$$EN1^NURSUT0($GET(NURSEMP),$GET(NURSDT))
SET NUR("NST")="A"
DO SETST
+4 IF '+$$EN1^NURSUT0($GET(NURSEMP),$GET(NURSDT))
SET NUR(211.9)=$SELECT(+NUR=5:X,1:$PIECE(NUR(211.82),"^",8))
SET NUR("NST")=$SELECT(NURSTAT:"A",$DATA(^NURSF(211.9,+NUR(211.9),0)):$PIECE(^(0),"^",3),1:"R")
IF NUR("NST")'=""
IF NUR("NST")'=NUR("OST")
DO SETST
QSU QUIT
SETST ; CHANGE STATUS FIELD OF FILE 210
+1 NEW DA,X
SET DA=$ORDER(^NURSF(210,"B",NUR(200),0))
IF DA'>0
QUIT
+2 IF NUR("OST")'=""
SET X=NUR("OST")
KILL ^NURSF(210,"AC",X,DA)
+3 IF NUR("NST")'=""
SET X=NUR("NST")
SET $PIECE(^NURSF(210,DA,0),"^",2)=X
SET DIK="^NURSF(210,"
DO IX1^DIK
+4 QUIT
EN4(NACT,NASK) ; ENTRY POINT FOR BEDSIDE TERMINAL PATIENT LOOK-UP
+1 IF '$DATA(^NURSC(214.8,0))
SET NURBEDSW=0
QUIT
+2 SET IEN=0
SET IEN=$ORDER(^NURSC(214.8,"B",ION,IEN))
SET ROOMBED=$SELECT(+IEN>0:$PIECE(^NURSC(214.8,IEN,0),U,2),1:"")
SET PATIENT=""
+3 IF ROOMBED'=""
SET IEN=0
SET IEN=$ORDER(^DPT("RM",ROOMBED,IEN))
SET PATIENT=$SELECT(+IEN>0:$PIECE(^DPT(IEN,0),U,1),1:"")
WRITE !!,?5,"Room-Bed: ",ROOMBED,!,?6,"Patient: ",PATIENT
+4 IF '(DIC(0)["A")
SET DIC(0)="A"_DIC(0)
IF '(PATIENT="")
SET DIC("B")=PATIENT
+5 SET DIC("A")="Select PATIENT NAME: "
+6 WRITE !
SET DFN=""
SET DIC="^DPT("
DO ^DIC
KILL DIC
IF $LENGTH($PIECE(Y,"^",2))
SET X=$PIECE(Y,"^",2)
IF $DATA(DTOUT)!$DATA(DUOUT)
SET DFN=""
GOTO QUIT
+7 IF +Y>0
IF NACT
IF '$DATA(^NURSF(214,"C","A",+Y))
SET Y=-2
+8 IF +Y>0
SET DFN=+Y
KILL DIC
WRITE !
GOTO QUIT
+9 IF X'["?"
IF (X?1U.UP1","1U.UP)
WRITE !!,$CHAR(7),$SELECT('NACT!(NACT&(Y=-1)):"PATIENT not admitted with MAS -- notify MAS",1:"PATIENT is not active in the Nursing system -- notify Nursing ADP coordinator")
QUIT KILL DTOUT,DUOUT,IEN,LOOP,PATIENT,ROOMBED
+1 QUIT
DBL ;CHECK FOR ROOM-BED DUPLICATE ENTRIES
+1 IF X=""
KILL X
QUIT
+2 SET IEN=0
SET IEN=$ORDER(^NURSC(214.8,"C",X,IEN))
+3 IF +IEN>0
WRITE *7,!!,?5,"That ROOM-BED is already associated with ION VALUE "_$PIECE(^NURSC(214.8,IEN,0),U,1)_" "
KILL X
+4 KILL IEN
QUIT
CLOSE ; CLOSE DEVICE
+1 WRITE !
+2 IF '+$GET(NUROUT)
DO ENDPG
+3 DO ^%ZISC
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 QUIT
ENDPG ; HANDLE EOP
+1 IF $EXTRACT($GET(IOST))'="C"
QUIT
+2 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET NUROUT=$SELECT(+Y'>0:1,1:0)
+3 QUIT
LOCSTAT(NURLOC) ; CHECK FOR ACTIVE EMPLOYEES ON NURS LOCATION
+1 NEW NURPOS,NPOSDA
SET NURACTV=0
+2 SET NURPOS=""
FOR
SET NURPOS=$ORDER(^NURSF(211.8,"B",+NURLOC,NURPOS))
IF NURPOS'>0
QUIT
SET NPOSDA=0
FOR
SET NPOSDA=$ORDER(^NURSF(211.8,NURPOS,1,NPOSDA))
IF NPOSDA'>0
QUIT
IF $GET(^NURSF(211.8,NURPOS,1,NPOSDA,0))'=""
Begin DoDot:1
+3 IF $PIECE($GET(^NURSF(211.8,NURPOS,1,NPOSDA,0)),U,6)=""!($PIECE($GET(^(0)),U,6)'<DT)
SET NURACTV=1
QUIT
+4 QUIT
End DoDot:1
+5 QUIT NURACTV
CHKSTAT ; INPUT TRANSFORM FOR STATUS FIELD OF NURS LOCATION FILE
+1 NEW NURLOC
SET NURLOC=+$GET(^NURSF(211.4,+DA,0))
SET NURLOC(1)=$PIECE(^SC(+$GET(^NURSF(211.4,DA,0)),0),"^")
SET NURLOC(1)=$PIECE(NURLOC(1),"NUR ",2)
SET NURSTAT=0
SET NURSTAT=$SELECT($GET(X)="I":+$$LOCSTAT^NURSUT1(NURLOC),1:0)
+2 IF $GET(X)="I"
IF $GET(NURSTAT)>0
Begin DoDot:1
+3 WRITE $CHAR(7),!!,NURLOC(1)," HAS ACTIVE STAFF ASSIGNED AND CANNOT BE DEACTIVATED: ",!!,"Generate an FTEE report for this location to identify active staff members",!,"who should be transferred prior to deactivation!"
DO ENDPG^NURSUT1
+4 QUIT
End DoDot:1
+5 QUIT
BUDCAT(D0) ; COMPUTE BUDGET CATEGORY FTEE FOR A LOCATION
+1 NEW D1
SET X=0
+2 SET D1=0
FOR
SET D1=$ORDER(^NURSF(211.8,D0,2,D1))
IF D1'>0
QUIT
IF $DATA(^NURSF(211.8,D0,2,D1,0))
SET X=(X+$PIECE(^(0),U,2))
+3 QUIT X
NODATA ; NO DATA ROUTINE FOR LOCATION REPORTS
+1 WRITE !!,"THERE IS NO DATA FOR ",NL1
+2 QUIT
