Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NURSCUTL

NURSCUTL.m

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