source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURACHDC.m@ 1147

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1NURACHDC ;HIRMFO/MD,FT-HEMODIALYSIS PATIENTS TO ACUITY TOTALS ; 3/20/03 12:44pm
2 ;;4.0;NURSING SERVICE;**7,17,38**;Apr 25, 1997
3EN1 ;ADD HEMODIALYSIS PATIENT TO AMIS COUNT
4 Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
5 S HRSW=$O(^NURSF(213.3,"B","HEMODIALYSIS",0))_"^H",(NACT,NUROUT)=0 G PATCK
6EN2 ;ADD RECOVERY ROOM PATIENT TO AMIS COUNT
7 Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^")=1
8 S HRSW=$O(^NURSF(213.3,"B","RECOVERY ROOM",0))_"^R",NUROUT=0,NACT=1
9PATCK S NASK=1,DIC(0)="EQM" D EN5^NURSCUTL
10 G:DFN'>0 QUIT
11 S PATNAM=$P(Y,"^",2)
12 S X="N",%DT="T" D ^%DT S NDATEX=+Y S:$E(NDATEX,8)'="." NDATEX=$E(NDATEX,1,7)_".00001" S NDATEX(0)=(+Y\1),HRSW(0)=$P(HRSW,U,2)
13 F DA(1)=0:0 S DA(1)=$O(^NURSA(214.6,"ACNT",NDATEX(0),DA(1))) Q:DA(1)'>0!(NUROUT) F DA=0:0 S DA=$O(^NURSA(214.6,"ACNT",NDATEX(0),DA(1),HRSW(0),DA)) Q:DA'>0!(NUROUT) I $P(^NURSA(214.6,DA,0),U,2)=DFN D EDIT Q
14 G:NUROUT QUIT
15 D CONTPRO G:NUROUT QUIT
16 G PATCK
17QUIT ; KILL LOCAL VARIABLES
18 K ^TMP($J) D ^NURAKILL
19 Q
20CONTPRO ; UPDATE ACUITY TOTALS
21 W !,$S($P(HRSW,"^",2)="H":"The Nurse who performed the hemodialysis is from which unit: ",$P(HRSW,"^",2)="R":"Recovery Room Location: ",1:"")
22 I $P(HRSW,"^",2)="R",+HRSW S NURDEFLT=$$LOCDEF^NURACHDC() W:NURDEFLT'="" NURDEFLT_"//"
23 R WARD:DTIME
24 I WARD["^"!'$T S NUROUT=1 Q
25 I $D(NURDEFLT),WARD="" S WARD=NURDEFLT
26 K NURDEFLT
27 S X=WARD,DIC="^NURSF(211.4,",DIC(0)="QEMZ",DIC("S")="I $S('$D(^(""I"")):1,$P(^(""I""),U)'=""I"":1,1:0),$S('$D(^(1)):1,$P(^(1),U)=""A"":1,1:0)" D ^DIC K DIC G:+Y'>0 CONTPRO
28 S WARD=+Y
29LOCK S DA=($P(^NURSA(214.6,0),"^",3)+1) L +^NURSA(214.6,DA,0):0 I '$T!$D(^NURSA(214.6,DA)) G LOCK
30CHK I $$DUPCLAS^NURSCUTL($G(NDATEX),DFN) S NDATEX=(NDATEX+.00001) G CHK
31 S X=NDATEX_"^"_DFN_"^"_1_"^"_"N/A"_"^"_"C"_"^"_DUZ_"^^"_WARD_"^"_HRSW,^NURSA(214.6,DA,0)=X
32 S ^NURSA(214.6,"AA",$P(X,"^",2),9999999-$P(X,"^"),DA)=""
33 S ^NURSA(214.6,"B",$E($P(X,"^",1),1,30),DA)=""
34 S ^NURSA(214.6,"C",$E($P(X,"^",2),1,30),DA)=""
35 S ^NURSA(214.6,"E",$E($P(X,"^",8),1,30),DA)=""
36 S ^NURSA(214.6,"ACNT",$P(X,"^")\1,WARD,$E($P(X,"^",10),1,30),DA)=""
37 S $P(^NURSA(214.6,0),"^",3,4)=DA_"^"_($P(^NURSA(214.6,0),"^",4)+1) L -^NURSA(214.6,DA,0)
38 W !!,PATNAM," HAS BEEN ADDED TO THE "_$S($P(HRSW,"^",2)="H":"HEMODIALYSIS",$P(HRSW,"^",2)="R":"RECOVERY ROOM")_" COUNT."
39 Q
40EDIT S NDATA=DA_"^"_^NURSA(214.6,DA,0) S Y=+$P(NDATA,U,2) D D^DIQ S NDATA(1)=Y W !!,"CLASSIFICATION DATE/TIME: "_Y_"//" R X:DTIME I X="^"!('$T) S NUROUT=1 Q
41 I X="@" D DELETE Q
42 S:X="" X=NDATA(1) S %DT="R" D ^%DT I X["?"!'((+Y\1)=($P(NDATA,U,2)\1)) W $C(7),!!,"Enter a date/time on "_$P(NDATA(1),"@") G EDIT
43 S NDATEX(2)=+Y,DIE="^NURSA(214.6,",DR=".01////^S X=NDATEX(2);5//;6//" D ^DIE
44 I '($P(NDATA,"^",2,11)=^NURSA(214.6,+DA,0)) S $P(^(0),"^",6)=DUZ
45 S NUROUT=1
46 Q
47DELETE W !!,$C(7),?3,"SURE YOU WANT TO DELETE THE "_NDATA(1)_" ENTRY " D YN^DICN I '(%>0) W !!,?5,"ANSWER YES OR NO" K % G DELETE
48 I %=1 S DIK="^NURSA(214.6," D ^DIK S (DA,DA(1))=""
49 S NUROUT=1 Q
50LOCDEF() ; find first active Nurs Location file (211.4) entry which has a
51 ; Recovery Room bedsection
52 N NURFOUND,NURBED,NURLOC S (NURFOUND,NURLOC)=0
53 F S NURLOC=$O(^NURSF(211.4,"D","A",NURLOC)) Q:NURFOUND!(NURLOC'>0) D Q:NURFOUND
54 . S NURBED=0 F S NURBED=$O(^NURSF(211.4,NURLOC,4,NURBED)) Q:NURFOUND!(NURBED'>0) I +$P($G(^NURSF(211.4,NURLOC,4,NURBED,0)),U)=+HRSW S NURFOUND=1
55 . Q
56 Q $S(NURFOUND=1:$P($G(^SC($P(^NURSF(211.4,+NURLOC,0),U),0)),U),1:"")
57 ;
Note: See TracBrowser for help on using the repository browser.