64 lines
3.7 KiB
Mathematica
64 lines
3.7 KiB
Mathematica
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
|