NURSCUTL ;HIRMFO/MD-RM-UTILITY ROUTINE FOR NURSING CLINICAL ;6/6/96
;;4.0;NURSING SERVICE;**7,28**;Apr 25, 1997;
EN2 ; LOOKUP OF THE LATEST PATIENT CLASSIFICATION FROM 214.6 FILE
; FLAG NURSCLAS("CL") = $S(1:CHECK CURR. LOC. = CLAS. LOC.,0:ELSE,
; 2:GET FIRST CLASS WHERE CURR.LOC=CLASS.LOC NURSCLASS("WARD")=CURR.LOC)
S NURSCLAS(0)="",NURSCLAS="" S:'$D(NURSCLAS("DATE")) NURSCLAS("DATE")=0
I NURSCLAS("CL")=1,'$D(NURSCLAS("WARD")) S NURSCLAS("WARD")=$P(^NURSF(214,DFN,0),U,3)
GC S NURSCLAS(0)=$O(^NURSA(214.6,"AA",DFN,NURSCLAS(0))) G Q2:NURSCLAS(0)=""!(NURSCLAS("CL")=2&(9999999-NURSCLAS(0)<NURSCLAS("DATE")))
K NURSCLAS("D") F CHKVAR=0:0 S CHKVAR=$O(^NURSA(214.6,"AA",DFN,NURSCLAS(0),CHKVAR)) Q:CHKVAR'>0 S NURSCLAS("D",-CHKVAR)=""
S NURSCLAS=""
F CHKVAR=0:0 S NURSCLAS=$O(NURSCLAS("D",NURSCLAS)) Q:NURSCLAS="" I $D(^NURSA(214.6,-NURSCLAS,0)),$P(^(0),"^",10)="",$S(NURSCLAS("CL")'=2:1,1:$P(^(0),U,8)=NURSCLAS("WARD")) S NURSCLAS=-NURSCLAS Q
G:NURSCLAS'>0 GC S NURSCOMP=$S(NURSADM'="":$P(VAIN(7),"^"),$D(^NURSF(214,DFN,0)):$P(^(0),"^",5),1:"")
I '(+NURSCLAS("CL")),NURSCOMP'="",$P(^NURSA(214.6,+$G(NURSCLAS),0),U)'>NURSCOMP,$P(^(0),U,8)=$G(NWARD),+^(0)[RPTDATE G Q2
I NURSCOMP'="",$P(^NURSA(214.6,NURSCLAS,0),"^",1)>NURSCOMP,$S('+NURSCLAS("CL"):1,$P(^NURSA(214.6,NURSCLAS,0),"^",8)=NURSCLAS("WARD"):1,1:0) G Q2
S NURSCLAS=""
Q2 S CHKVAR=NURSCLAS K NURSCLAS S NURSCLAS=CHKVAR K NURSCOMP,CHKVAR
Q
EN3 ; MUMPS "AA" XREF FOR FILE 214.7
; THE NURSDFN, NURSA, AND NURSR VARIABLES ARE KILLED IN THE XREF
S (NURSDFN,NURSA,NURSR)=""
Q:'$D(^NURSA(214.7,DA,0)) S NURSDFN=$P(^(0),U,2),NURSR=$P(^(0),U,1)
Q
EN4 ; SCREEN FOR CLASSIFICATION DATE FIELDS
I $D(DA),$D(^NURSA(214.7,DA,0)),$P(^(0),U,2)'="",$D(^NURSA(214.6,"AA",$P(^NURSA(214.7,DA,0),U,2),9999999-$P(^NURSA(214.6,Y,0),U,1),Y))
Q
EN5 ; LOOKUP ON THE PATIENT FILE FOR PATIENT NAME
G:'NASK A5 W !!,"Select PATIENT NAME: " R X:DTIME
I "^"[X!('$T) S DFN="" K DIC Q
A5 S DIC="^DPT(" D ^DIC S:X=" "&$L($P(Y,"^",2)) X=$P(Y,"^",2)
I +Y>0,NACT,'$D(^NURSF(214,"C","A",+Y)) S Y=-2
I +Y>0!'NASK S DFN=+Y K DIC W ! Q
I X'["?",(X?1U.UP1","1U.UP) W !!,*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")
G EN5
Q
EN6 ; FIND THE CURRENT ADMISSION FOR THE PATIENT (DFN IS PATIENT IEN)
D INP^VADPT
;S VAIP("V")="VAIN" D IN5^VADPT
S NURSMAS=$S('$D(VAIN(4)):"",1:$P(VAIN(4),"^",2))
I NURSMAS="" K NURSMAS S NURSADM="" Q
S NURSADM=$S($D(VAIN(1)):$P(VAIN(1),"^",1),1:"") K NURSMAS
Q
SETXREF ; SET UP ADT INTERFACE IN PATIENT FILE
W !!,"Set up 'trigger' in Patient File to create Nursing Patient entries"
S DA=0 F NURSI=0:0 S NURSI=$O(^DD(2,.1,1,NURSI)) Q:NURSI'>0 S DA=NURSI I $D(^DD(2,.1,1,NURSI,0)),$P(^(0),"^",2)="ANURS" Q
S:$P(^DD(2,.1,1,DA,0),"^",2)'="ANURS" DA=DA+1
S ^DD(2,.1,1,DA,0)="2^ANURS^MUMPS",^(1)="S %X=X,X=""NURSCPL"" X ^%ZOSF(""TEST"") S X=%X D:$T EN1^NURSCPL",^(2)="S %X=X,X=""NURSCPL"" X ^%ZOSF(""TEST"") S X=%X D:$T EN2^NURSCPL"
S ^DD(2,0,"IX","ANURS",2,.1)=""
Q
KILLXREF ; DELETE ADT INTERFACE IN PATIENT FILE
W !!,"Kill 'triggers' in Patient File that creates Nursing entries."
F NURSI=0:0 S NURSI=$O(^DD(2,.1,1,NURSI)) Q:NURSI'>0 I $D(^DD(2,.1,1,NURSI,0)),$P(^(0),"^",2)="ANURS" K ^DD(2,.1,1,NURSI)
K ^DD(2,0,"IX","ANURS",2,.1)
Q
EN7 ; POC ENTRY POINT FOR PATIENT LOOK-UP
S (NURQUIT,NURBEDSW)=0 S:$D(^DIC(214.8)) NURBEDSW=1 I NURBEDSW D EN4^NURSUT1(NACT,NASK) S:DFN'>0 Y=-1
I 'NURBEDSW D EN5^NURSCUTL S:DFN'>0 Y=-1
K NURBEDSW I +Y'>0 S DFN="",NURQUIT=1
Q
DUPCLAS(DATEX,DFN) ; CHECK FOR DUPLICATE ENTRY IN NURS CLASSIFICATION (#214.6)
; FILE. IF A DUPLICATE EXISTS A ONE IS RETURNED OTHERWISE
; A ZERO IS RETURNED
S DUPCLAS=0,DUPCLAS=$S($D(^NURSA(214.6,"AA",DFN,(9999999-DATEX))):1,1:0)
Q DUPCLAS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSCUTL 3863 printed Dec 13, 2024@02:21:54 Page 2
NURSCUTL ;HIRMFO/MD-RM-UTILITY ROUTINE FOR NURSING CLINICAL ;6/6/96
+1 ;;4.0;NURSING SERVICE;**7,28**;Apr 25, 1997;
EN2 ; LOOKUP OF THE LATEST PATIENT CLASSIFICATION FROM 214.6 FILE
+1 ; FLAG NURSCLAS("CL") = $S(1:CHECK CURR. LOC. = CLAS. LOC.,0:ELSE,
+2 ; 2:GET FIRST CLASS WHERE CURR.LOC=CLASS.LOC NURSCLASS("WARD")=CURR.LOC)
+3 SET NURSCLAS(0)=""
SET NURSCLAS=""
if '$DATA(NURSCLAS("DATE"))
SET NURSCLAS("DATE")=0
+4 IF NURSCLAS("CL")=1
IF '$DATA(NURSCLAS("WARD"))
SET NURSCLAS("WARD")=$PIECE(^NURSF(214,DFN,0),U,3)
GC SET NURSCLAS(0)=$ORDER(^NURSA(214.6,"AA",DFN,NURSCLAS(0)))
if NURSCLAS(0)=""!(NURSCLAS("CL")=2&(9999999-NURSCLAS(0)<NURSCLAS("DATE")))
GOTO Q2
+1 KILL NURSCLAS("D")
FOR CHKVAR=0:0
SET CHKVAR=$ORDER(^NURSA(214.6,"AA",DFN,NURSCLAS(0),CHKVAR))
if CHKVAR'>0
QUIT
SET NURSCLAS("D",-CHKVAR)=""
+2 SET NURSCLAS=""
+3 FOR CHKVAR=0:0
SET NURSCLAS=$ORDER(NURSCLAS("D",NURSCLAS))
if NURSCLAS=""
QUIT
IF $DATA(^NURSA(214.6,-NURSCLAS,0))
IF $PIECE(^(0),"^",10)=""
IF $SELECT(NURSCLAS("CL")'=2:1,1:$PIECE(^(0),U,8)=NURSCLAS("WARD"))
SET NURSCLAS=-NURSCLAS
QUIT
+4 if NURSCLAS'>0
GOTO GC
SET NURSCOMP=$SELECT(NURSADM'="":$PIECE(VAIN(7),"^"),$DATA(^NURSF(214,DFN,0)):$PIECE(^(0),"^",5),1:"")
+5 IF '(+NURSCLAS("CL"))
IF NURSCOMP'=""
IF $PIECE(^NURSA(214.6,+$GET(NURSCLAS),0),U)'>NURSCOMP
IF $PIECE(^(0),U,8)=$GET(NWARD)
IF +^(0)[RPTDATE
GOTO Q2
+6 IF NURSCOMP'=""
IF $PIECE(^NURSA(214.6,NURSCLAS,0),"^",1)>NURSCOMP
IF $SELECT('+NURSCLAS("CL"):1,$PIECE(^NURSA(214.6,NURSCLAS,0),"^",8)=NURSCLAS("WARD"):1,1:0)
GOTO Q2
+7 SET NURSCLAS=""
Q2 SET CHKVAR=NURSCLAS
KILL NURSCLAS
SET NURSCLAS=CHKVAR
KILL NURSCOMP,CHKVAR
+1 QUIT
EN3 ; MUMPS "AA" XREF FOR FILE 214.7
+1 ; THE NURSDFN, NURSA, AND NURSR VARIABLES ARE KILLED IN THE XREF
+2 SET (NURSDFN,NURSA,NURSR)=""
+3 if '$DATA(^NURSA(214.7,DA,0))
QUIT
SET NURSDFN=$PIECE(^(0),U,2)
SET NURSR=$PIECE(^(0),U,1)
+4 QUIT
EN4 ; SCREEN FOR CLASSIFICATION DATE FIELDS
+1 IF $DATA(DA)
IF $DATA(^NURSA(214.7,DA,0))
IF $PIECE(^(0),U,2)'=""
IF $DATA(^NURSA(214.6,"AA",$PIECE(^NURSA(214.7,DA,0),U,2),9999999-$PIECE(^NURSA(214.6,Y,0),U,1),Y))
+2 QUIT
EN5 ; LOOKUP ON THE PATIENT FILE FOR PATIENT NAME
+1 if 'NASK
GOTO A5
WRITE !!,"Select PATIENT NAME: "
READ X:DTIME
+2 IF "^"[X!('$TEST)
SET DFN=""
KILL DIC
QUIT
A5 SET DIC="^DPT("
DO ^DIC
if X=" "&$LENGTH($PIECE(Y,"^",2))
SET X=$PIECE(Y,"^",2)
+1 IF +Y>0
IF NACT
IF '$DATA(^NURSF(214,"C","A",+Y))
SET Y=-2
+2 IF +Y>0!'NASK
SET DFN=+Y
KILL DIC
WRITE !
QUIT
+3 IF X'["?"
IF (X?1U.UP1","1U.UP)
WRITE !!,*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")
+4 GOTO EN5
+5 QUIT
EN6 ; FIND THE CURRENT ADMISSION FOR THE PATIENT (DFN IS PATIENT IEN)
+1 DO INP^VADPT
+2 ;S VAIP("V")="VAIN" D IN5^VADPT
+3 SET NURSMAS=$SELECT('$DATA(VAIN(4)):"",1:$PIECE(VAIN(4),"^",2))
+4 IF NURSMAS=""
KILL NURSMAS
SET NURSADM=""
QUIT
+5 SET NURSADM=$SELECT($DATA(VAIN(1)):$PIECE(VAIN(1),"^",1),1:"")
KILL NURSMAS
+6 QUIT
SETXREF ; SET UP ADT INTERFACE IN PATIENT FILE
+1 WRITE !!,"Set up 'trigger' in Patient File to create Nursing Patient entries"
+2 SET DA=0
FOR NURSI=0:0
SET NURSI=$ORDER(^DD(2,.1,1,NURSI))
if NURSI'>0
QUIT
SET DA=NURSI
IF $DATA(^DD(2,.1,1,NURSI,0))
IF $PIECE(^(0),"^",2)="ANURS"
QUIT
+3 if $PIECE(^DD(2,.1,1,DA,0),"^",2)'="ANURS"
SET DA=DA+1
+4 SET ^DD(2,.1,1,DA,0)="2^ANURS^MUMPS"
SET ^(1)="S %X=X,X=""NURSCPL"" X ^%ZOSF(""TEST"") S X=%X D:$T EN1^NURSCPL"
SET ^(2)="S %X=X,X=""NURSCPL"" X ^%ZOSF(""TEST"") S X=%X D:$T EN2^NURSCPL"
+5 SET ^DD(2,0,"IX","ANURS",2,.1)=""
+6 QUIT
KILLXREF ; DELETE ADT INTERFACE IN PATIENT FILE
+1 WRITE !!,"Kill 'triggers' in Patient File that creates Nursing entries."
+2 FOR NURSI=0:0
SET NURSI=$ORDER(^DD(2,.1,1,NURSI))
if NURSI'>0
QUIT
IF $DATA(^DD(2,.1,1,NURSI,0))
IF $PIECE(^(0),"^",2)="ANURS"
KILL ^DD(2,.1,1,NURSI)
+3 KILL ^DD(2,0,"IX","ANURS",2,.1)
+4 QUIT
EN7 ; POC ENTRY POINT FOR PATIENT LOOK-UP
+1 SET (NURQUIT,NURBEDSW)=0
if $DATA(^DIC(214.8))
SET NURBEDSW=1
IF NURBEDSW
DO EN4^NURSUT1(NACT,NASK)
if DFN'>0
SET Y=-1
+2 IF 'NURBEDSW
DO EN5^NURSCUTL
if DFN'>0
SET Y=-1
+3 KILL NURBEDSW
IF +Y'>0
SET DFN=""
SET NURQUIT=1
+4 QUIT
DUPCLAS(DATEX,DFN) ; CHECK FOR DUPLICATE ENTRY IN NURS CLASSIFICATION (#214.6)
+1 ; FILE. IF A DUPLICATE EXISTS A ONE IS RETURNED OTHERWISE
+2 ; A ZERO IS RETURNED
+3 SET DUPCLAS=0
SET DUPCLAS=$SELECT($DATA(^NURSA(214.6,"AA",DFN,(9999999-DATEX))):1,1:0)
+4 QUIT DUPCLAS
