source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURSUT1.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1NURSUT1 ;HIRMFO/RM,MD-NURS POSITION CONTROL FILE EDIT UTILITY (CONT) ; 5/16/03 5:10pm
2 ;;4.0;NURSING SERVICE;**2,7,13,39**;Apr 25, 1997
3EN1 ; ENTRY FROM ASD1 FROM 211.82,.01, ASD2 FROM 211.82,3 AND ASD3 FROM
4 ; 211.82,5 CROSSREFERENCES. THE VARIABLE NUR WILL BE SET TO THE
5 ; FOLLOWING: FIELD NUMBER CALLING XREF^$S(0:KILL LOGIC,1:SET LOGIC)
6 N DIK
7 S NUR(211.82)=$S($D(^NURSF(211.8,DA(1),1,DA,0)):^(0),1:""),NUR("SDT")=$S(+NUR=.01:X,1:+NUR(211.82)),NUR("VDT")=$S(+NUR=3:X,1:$P(NUR(211.82),"^",6))
8 I +NUR=.01 S:$P(NUR,"^",2) ^NURSF(211.8,"ASD",2,DA(1),DA)="" K:'$P(NUR,"^",2) ^NURSF(211.8,"ASD",2,DA(1),DA)
9 I +NUR=3 S:$P(NUR,"^",2) ^NURSF(211.8,"ASD",1,DA(1),DA)="" K:'$P(NUR,"^",2) ^NURSF(211.8,"ASD",1,DA(1),DA)
10 D EMP Q
11EN1B ; ENTRY POINT TO KILL "ASD" X-REF AFTER ADDED TO 213.5 DURING ACT/SEP BATCH JOB
12 N DIK
13 S NUR(211.82)=$S($D(^NURSF(211.8,DA(1),1,DA,0)):^(0),1:""),NUR("SDT")=$S(+NUR=.01:X,1:+NUR(211.82)),NUR("VDT")=$S(+NUR=3:X,1:$P(NUR(211.82),"^",6))
14 I NUR("SDT")'>DT,+NUR=.01 K ^NURSF(211.8,"ASD",2,DA(1),DA)
15 I NUR("VDT")'>DT,+NUR=3 K ^NURSF(211.8,"ASD",1,DA(1),DA)
16EMP D STTUPD I +NUR=.01!(+NUR=3) S NUR("PE")=NUR D EN1^NURSAPE0
17 K NUR
18 Q
19STTUPD ; CHECK IF UPDATE OF STATUS FIELD IN FILE 210 IS NECESSARY
20 S NUR(0)=X D NOW^%DTC S X=NUR(0),NURSDT=%,(NURSEMP,NUR(200))=$P(NUR(211.82),"^",2) G:NUR(200)'>0 QSU S NUR(200)=$P(NUR(211.82),"^",2)
21 S NUR(210)=$O(^NURSF(210,"B",NUR(200),0)) G QSU:NUR(210)'>0 S NUR("OST")=$S($D(^NURSF(210,NUR(210),0)):$P(^(0),"^",2),1:"")
22 I NUR("OST")'="A",NUR("OST")'="I",+$$EN1^NURSUT0($G(NURSEMP),$G(NURSDT)) S NUR("NST")="A" D SETST
23 I '+$$EN1^NURSUT0($G(NURSEMP),$G(NURSDT)) S NUR(211.9)=$S(+NUR=5:X,1:$P(NUR(211.82),"^",8)),NUR("NST")=$S(NURSTAT:"A",$D(^NURSF(211.9,+NUR(211.9),0)):$P(^(0),"^",3),1:"R") I NUR("NST")'="",NUR("NST")'=NUR("OST") D SETST
24QSU Q
25SETST ; CHANGE STATUS FIELD OF FILE 210
26 N DA,X S DA=$O(^NURSF(210,"B",NUR(200),0)) Q:DA'>0
27 I NUR("OST")'="" S X=NUR("OST") K ^NURSF(210,"AC",X,DA)
28 I NUR("NST")'="" S X=NUR("NST"),$P(^NURSF(210,DA,0),"^",2)=X,DIK="^NURSF(210," D IX1^DIK
29 Q
30EN4(NACT,NASK) ; ENTRY POINT FOR BEDSIDE TERMINAL PATIENT LOOK-UP
31 I '$D(^NURSC(214.8,0)) S NURBEDSW=0 Q
32 S IEN=0,IEN=$O(^NURSC(214.8,"B",ION,IEN)),ROOMBED=$S(+IEN>0:$P(^NURSC(214.8,IEN,0),U,2),1:""),PATIENT=""
33 I ROOMBED'="" S IEN=0,IEN=$O(^DPT("RM",ROOMBED,IEN)),PATIENT=$S(+IEN>0:$P(^DPT(IEN,0),U,1),1:"") W !!,?5,"Room-Bed: ",ROOMBED,!,?6,"Patient: ",PATIENT
34 S:'(DIC(0)["A") DIC(0)="A"_DIC(0) S:'(PATIENT="") DIC("B")=PATIENT
35 S DIC("A")="Select PATIENT NAME: "
36 W ! S DFN="",DIC="^DPT(" D ^DIC K DIC S:$L($P(Y,"^",2)) X=$P(Y,"^",2) I $D(DTOUT)!$D(DUOUT) S DFN="" G QUIT
37 I +Y>0,NACT,'$D(^NURSF(214,"C","A",+Y)) S Y=-2
38 I +Y>0 S DFN=+Y K DIC W ! G QUIT
39 I X'["?",(X?1U.UP1","1U.UP) W !!,$C(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")
40QUIT K DTOUT,DUOUT,IEN,LOOP,PATIENT,ROOMBED
41 Q
42DBL ;CHECK FOR ROOM-BED DUPLICATE ENTRIES
43 I X="" K X Q
44 S IEN=0,IEN=$O(^NURSC(214.8,"C",X,IEN))
45 I +IEN>0 W *7,!!,?5,"That ROOM-BED is already associated with ION VALUE "_$P(^NURSC(214.8,IEN,0),U,1)_" " K X
46 K IEN Q
47CLOSE ; CLOSE DEVICE
48 W !
49 I '+$G(NUROUT) D ENDPG
50 D ^%ZISC
51 I $D(ZTQUEUED) S ZTREQ="@"
52 Q
53ENDPG ; HANDLE EOP
54 I $E($G(IOST))'="C" Q
55 K DIR S DIR(0)="E" D ^DIR K DIR S NUROUT=$S(+Y'>0:1,1:0)
56 Q
57LOCSTAT(NURLOC) ; CHECK FOR ACTIVE EMPLOYEES ON NURS LOCATION
58 N NURPOS,NPOSDA S NURACTV=0
59 S NURPOS="" F S NURPOS=$O(^NURSF(211.8,"B",+NURLOC,NURPOS)) Q:NURPOS'>0 S NPOSDA=0 F S NPOSDA=$O(^NURSF(211.8,NURPOS,1,NPOSDA)) Q:NPOSDA'>0 I $G(^NURSF(211.8,NURPOS,1,NPOSDA,0))'="" D
60 . I $P($G(^NURSF(211.8,NURPOS,1,NPOSDA,0)),U,6)=""!($P($G(^(0)),U,6)'<DT) S NURACTV=1 Q
61 . Q
62 Q NURACTV
63CHKSTAT ; INPUT TRANSFORM FOR STATUS FIELD OF NURS LOCATION FILE
64 N NURLOC S NURLOC=+$G(^NURSF(211.4,+DA,0)),NURLOC(1)=$P(^SC(+$G(^NURSF(211.4,DA,0)),0),"^"),NURLOC(1)=$P(NURLOC(1),"NUR ",2),NURSTAT=0,NURSTAT=$S($G(X)="I":+$$LOCSTAT^NURSUT1(NURLOC),1:0)
65 I $G(X)="I",$G(NURSTAT)>0 D
66 . W $C(7),!!,NURLOC(1)," HAS ACTIVE STAFF ASSIGNED AND CANNOT BE DEACTIVATED: ",!!,"Generate an FTEE report for this location to identify active staff members",!,"who should be transferred prior to deactivation!" D ENDPG^NURSUT1
67 . Q
68 Q
69BUDCAT(D0) ; COMPUTE BUDGET CATEGORY FTEE FOR A LOCATION
70 N D1 S X=0
71 S D1=0 F S D1=$O(^NURSF(211.8,D0,2,D1)) Q:D1'>0 I $D(^NURSF(211.8,D0,2,D1,0)) S X=(X+$P(^(0),U,2))
72 Q X
73NODATA ; NO DATA ROUTINE FOR LOCATION REPORTS
74 W !!,"THERE IS NO DATA FOR ",NL1
75 Q
Note: See TracBrowser for help on using the repository browser.