- 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 Feb 18, 2025@23:48:20 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