source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURSCUTL.m@ 1670

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