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

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1NURSCUTL ;HIRMFO/MD-RM-UTILITY ROUTINE FOR NURSING CLINICAL ;6/6/96
2 ;;4.0;NURSING SERVICE;**7,28**;Apr 25, 1997;
3EN2 ; LOOKUP OF THE LATEST PATIENT CLASSIFICATION FROM 214.6 FILE
4 ; FLAG NURSCLAS("CL") = $S(1:CHECK CURR. LOC. = CLAS. LOC.,0:ELSE,
5 ; 2:GET FIRST CLASS WHERE CURR.LOC=CLASS.LOC NURSCLASS("WARD")=CURR.LOC)
6 S NURSCLAS(0)="",NURSCLAS="" S:'$D(NURSCLAS("DATE")) NURSCLAS("DATE")=0
7 I NURSCLAS("CL")=1,'$D(NURSCLAS("WARD")) S NURSCLAS("WARD")=$P(^NURSF(214,DFN,0),U,3)
8GC S NURSCLAS(0)=$O(^NURSA(214.6,"AA",DFN,NURSCLAS(0))) G Q2:NURSCLAS(0)=""!(NURSCLAS("CL")=2&(9999999-NURSCLAS(0)<NURSCLAS("DATE")))
9 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)=""
10 S NURSCLAS=""
11 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
12 G:NURSCLAS'>0 GC S NURSCOMP=$S(NURSADM'="":$P(VAIN(7),"^"),$D(^NURSF(214,DFN,0)):$P(^(0),"^",5),1:"")
13 I '(+NURSCLAS("CL")),NURSCOMP'="",$P(^NURSA(214.6,+$G(NURSCLAS),0),U)'>NURSCOMP,$P(^(0),U,8)=$G(NWARD),+^(0)[RPTDATE G Q2
14 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
15 S NURSCLAS=""
16Q2 S CHKVAR=NURSCLAS K NURSCLAS S NURSCLAS=CHKVAR K NURSCOMP,CHKVAR
17 Q
18EN3 ; MUMPS "AA" XREF FOR FILE 214.7
19 ; THE NURSDFN, NURSA, AND NURSR VARIABLES ARE KILLED IN THE XREF
20 S (NURSDFN,NURSA,NURSR)=""
21 Q:'$D(^NURSA(214.7,DA,0)) S NURSDFN=$P(^(0),U,2),NURSR=$P(^(0),U,1)
22 Q
23EN4 ; SCREEN FOR CLASSIFICATION DATE FIELDS
24 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))
25 Q
26EN5 ; LOOKUP ON THE PATIENT FILE FOR PATIENT NAME
27 G:'NASK A5 W !!,"Select PATIENT NAME: " R X:DTIME
28 I "^"[X!('$T) S DFN="" K DIC Q
29A5 S DIC="^DPT(" D ^DIC S:X=" "&$L($P(Y,"^",2)) X=$P(Y,"^",2)
30 I +Y>0,NACT,'$D(^NURSF(214,"C","A",+Y)) S Y=-2
31 I +Y>0!'NASK S DFN=+Y K DIC W ! Q
32 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")
33 G EN5
34 Q
35EN6 ; FIND THE CURRENT ADMISSION FOR THE PATIENT (DFN IS PATIENT IEN)
36 D INP^VADPT
37 ;S VAIP("V")="VAIN" D IN5^VADPT
38 S NURSMAS=$S('$D(VAIN(4)):"",1:$P(VAIN(4),"^",2))
39 I NURSMAS="" K NURSMAS S NURSADM="" Q
40 S NURSADM=$S($D(VAIN(1)):$P(VAIN(1),"^",1),1:"") K NURSMAS
41 Q
42SETXREF ; SET UP ADT INTERFACE IN PATIENT FILE
43 W !!,"Set up 'trigger' in Patient File to create Nursing Patient entries"
44 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
45 S:$P(^DD(2,.1,1,DA,0),"^",2)'="ANURS" DA=DA+1
46 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"
47 S ^DD(2,0,"IX","ANURS",2,.1)=""
48 Q
49KILLXREF ; DELETE ADT INTERFACE IN PATIENT FILE
50 W !!,"Kill 'triggers' in Patient File that creates Nursing entries."
51 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)
52 K ^DD(2,0,"IX","ANURS",2,.1)
53 Q
54EN7 ; POC ENTRY POINT FOR PATIENT LOOK-UP
55 S (NURQUIT,NURBEDSW)=0 S:$D(^DIC(214.8)) NURBEDSW=1 I NURBEDSW D EN4^NURSUT1(NACT,NASK) S:DFN'>0 Y=-1
56 I 'NURBEDSW D EN5^NURSCUTL S:DFN'>0 Y=-1
57 K NURBEDSW I +Y'>0 S DFN="",NURQUIT=1
58 Q
59DUPCLAS(DATEX,DFN) ; CHECK FOR DUPLICATE ENTRY IN NURS CLASSIFICATION (#214.6)
60 ; FILE. IF A DUPLICATE EXISTS A ONE IS RETURNED OTHERWISE
61 ; A ZERO IS RETURNED
62 S DUPCLAS=0,DUPCLAS=$S($D(^NURSA(214.6,"AA",DFN,(9999999-DATEX))):1,1:0)
63 Q DUPCLAS
Note: See TracBrowser for help on using the repository browser.