source: FOIAVistA/tag/r/NURSING_SERVICE-NUR/NURACHDC.m@ 628

NURACHDC ;HIRMFO/MD,FT-HEMODIALYSIS PATIENTS TO ACUITY TOTALS ; 3/20/03 12:44pm
 ;;4.0;NURSING SERVICE;**7,17,38**;Apr 25, 1997
EN1 ;ADD HEMODIALYSIS PATIENT TO AMIS COUNT
 Q:'$D(^DIC(213.9,1,"OFF"))  Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
 S HRSW=$O(^NURSF(213.3,"B","HEMODIALYSIS",0))_"^H",(NACT,NUROUT)=0 G PATCK
EN2 ;ADD RECOVERY ROOM PATIENT TO AMIS COUNT
 Q:'$D(^DIC(213.9,1,"OFF"))  Q:$P(^DIC(213.9,1,"OFF"),"^")=1
 S HRSW=$O(^NURSF(213.3,"B","RECOVERY ROOM",0))_"^R",NUROUT=0,NACT=1
PATCK S NASK=1,DIC(0)="EQM" D EN5^NURSCUTL
 G:DFN'>0 QUIT
 S PATNAM=$P(Y,"^",2)
 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)
 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
 G:NUROUT QUIT
 D CONTPRO G:NUROUT QUIT
 G PATCK
QUIT ; KILL LOCAL VARIABLES
 K ^TMP($J) D ^NURAKILL
 Q
CONTPRO ; UPDATE ACUITY TOTALS
 W !,$S($P(HRSW,"^",2)="H":"The Nurse who performed the hemodialysis is from which unit: ",$P(HRSW,"^",2)="R":"Recovery Room Location: ",1:"")
 I $P(HRSW,"^",2)="R",+HRSW S NURDEFLT=$$LOCDEF^NURACHDC() W:NURDEFLT'="" NURDEFLT_"//"
 R WARD:DTIME
 I WARD["^"!'$T S NUROUT=1 Q
 I $D(NURDEFLT),WARD="" S WARD=NURDEFLT
 K NURDEFLT
 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
 S WARD=+Y
LOCK 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
CHK I $$DUPCLAS^NURSCUTL($G(NDATEX),DFN) S NDATEX=(NDATEX+.00001) G CHK
 S X=NDATEX_"^"_DFN_"^"_1_"^"_"N/A"_"^"_"C"_"^"_DUZ_"^^"_WARD_"^"_HRSW,^NURSA(214.6,DA,0)=X
 S ^NURSA(214.6,"AA",$P(X,"^",2),9999999-$P(X,"^"),DA)=""
 S ^NURSA(214.6,"B",$E($P(X,"^",1),1,30),DA)=""
 S ^NURSA(214.6,"C",$E($P(X,"^",2),1,30),DA)=""
 S ^NURSA(214.6,"E",$E($P(X,"^",8),1,30),DA)=""
 S ^NURSA(214.6,"ACNT",$P(X,"^")\1,WARD,$E($P(X,"^",10),1,30),DA)=""
 S $P(^NURSA(214.6,0),"^",3,4)=DA_"^"_($P(^NURSA(214.6,0),"^",4)+1) L -^NURSA(214.6,DA,0)
 W !!,PATNAM," HAS BEEN ADDED TO THE "_$S($P(HRSW,"^",2)="H":"HEMODIALYSIS",$P(HRSW,"^",2)="R":"RECOVERY ROOM")_" COUNT."
 Q
EDIT 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
 I X="@" D DELETE Q
 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
 S NDATEX(2)=+Y,DIE="^NURSA(214.6,",DR=".01////^S X=NDATEX(2);5//;6//" D ^DIE
 I '($P(NDATA,"^",2,11)=^NURSA(214.6,+DA,0)) S $P(^(0),"^",6)=DUZ
 S NUROUT=1
 Q
DELETE 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
 I %=1 S DIK="^NURSA(214.6," D ^DIK S (DA,DA(1))=""
 S NUROUT=1 Q
LOCDEF() ; find first active Nurs Location file (211.4) entry which has a
 ; Recovery Room bedsection
 N NURFOUND,NURBED,NURLOC S (NURFOUND,NURLOC)=0
 F  S NURLOC=$O(^NURSF(211.4,"D","A",NURLOC)) Q:NURFOUND!(NURLOC'>0)  D  Q:NURFOUND
 .  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
 .   Q
 Q $S(NURFOUND=1:$P($G(^SC($P(^NURSF(211.4,+NURLOC,0),U),0)),U),1:"")
 ;