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:"")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURACHDC 3478 printed Nov 22, 2024@17:29:09 Page 2
NURACHDC ;HIRMFO/MD,FT-HEMODIALYSIS PATIENTS TO ACUITY TOTALS ; 3/20/03 12:44pm
+1 ;;4.0;NURSING SERVICE;**7,17,38**;Apr 25, 1997
EN1 ;ADD HEMODIALYSIS PATIENT TO AMIS COUNT
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
QUIT
+2 SET HRSW=$ORDER(^NURSF(213.3,"B","HEMODIALYSIS",0))_"^H"
SET (NACT,NUROUT)=0
GOTO PATCK
EN2 ;ADD RECOVERY ROOM PATIENT TO AMIS COUNT
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),"^")=1
QUIT
+2 SET HRSW=$ORDER(^NURSF(213.3,"B","RECOVERY ROOM",0))_"^R"
SET NUROUT=0
SET NACT=1
PATCK SET NASK=1
SET DIC(0)="EQM"
DO EN5^NURSCUTL
+1 if DFN'>0
GOTO QUIT
+2 SET PATNAM=$PIECE(Y,"^",2)
+3 SET X="N"
SET %DT="T"
DO ^%DT
SET NDATEX=+Y
if $EXTRACT(NDATEX,8)'="."
SET NDATEX=$EXTRACT(NDATEX,1,7)_".00001"
SET NDATEX(0)=(+Y\1)
SET HRSW(0)=$PIECE(HRSW,U,2)
+4 FOR DA(1)=0:0
SET DA(1)=$ORDER(^NURSA(214.6,"ACNT",NDATEX(0),DA(1)))
if DA(1)'>0!(NUROUT)
QUIT
FOR DA=0:0
SET DA=$ORDER(^NURSA(214.6,"ACNT",NDATEX(0),DA(1),HRSW(0),DA))
if DA'>0!(NUROUT)
QUIT
IF $PIECE(^NURSA(214.6,DA,0),U,2)=DFN
DO EDIT
QUIT
+5 if NUROUT
GOTO QUIT
+6 DO CONTPRO
if NUROUT
GOTO QUIT
+7 GOTO PATCK
QUIT ; KILL LOCAL VARIABLES
+1 KILL ^TMP($JOB)
DO ^NURAKILL
+2 QUIT
CONTPRO ; UPDATE ACUITY TOTALS
+1 WRITE !,$SELECT($PIECE(HRSW,"^",2)="H":"The Nurse who performed the hemodialysis is from which unit: ",$PIECE(HRSW,"^",2)="R":"Recovery Room Location: ",1:"")
+2 IF $PIECE(HRSW,"^",2)="R"
IF +HRSW
SET NURDEFLT=$$LOCDEF^NURACHDC()
if NURDEFLT'=""
WRITE NURDEFLT_"//"
+3 READ WARD:DTIME
+4 IF WARD["^"!'$TEST
SET NUROUT=1
QUIT
+5 IF $DATA(NURDEFLT)
IF WARD=""
SET WARD=NURDEFLT
+6 KILL NURDEFLT
+7 SET X=WARD
SET DIC="^NURSF(211.4,"
SET DIC(0)="QEMZ"
SET 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)"
DO ^DIC
KILL DIC
if +Y'>0
GOTO CONTPRO
+8 SET WARD=+Y
LOCK SET DA=($PIECE(^NURSA(214.6,0),"^",3)+1)
LOCK +^NURSA(214.6,DA,0):0
IF '$TEST!$DATA(^NURSA(214.6,DA))
GOTO LOCK
CHK IF $$DUPCLAS^NURSCUTL($GET(NDATEX),DFN)
SET NDATEX=(NDATEX+.00001)
GOTO CHK
+1 SET X=NDATEX_"^"_DFN_"^"_1_"^"_"N/A"_"^"_"C"_"^"_DUZ_"^^"_WARD_"^"_HRSW
SET ^NURSA(214.6,DA,0)=X
+2 SET ^NURSA(214.6,"AA",$PIECE(X,"^",2),9999999-$PIECE(X,"^"),DA)=""
+3 SET ^NURSA(214.6,"B",$EXTRACT($PIECE(X,"^",1),1,30),DA)=""
+4 SET ^NURSA(214.6,"C",$EXTRACT($PIECE(X,"^",2),1,30),DA)=""
+5 SET ^NURSA(214.6,"E",$EXTRACT($PIECE(X,"^",8),1,30),DA)=""
+6 SET ^NURSA(214.6,"ACNT",$PIECE(X,"^")\1,WARD,$EXTRACT($PIECE(X,"^",10),1,30),DA)=""
+7 SET $PIECE(^NURSA(214.6,0),"^",3,4)=DA_"^"_($PIECE(^NURSA(214.6,0),"^",4)+1)
LOCK -^NURSA(214.6,DA,0)
+8 WRITE !!,PATNAM," HAS BEEN ADDED TO THE "_$SELECT($PIECE(HRSW,"^",2)="H":"HEMODIALYSIS",$PIECE(HRSW,"^",2)="R":"RECOVERY ROOM")_" COUNT."
+9 QUIT
EDIT SET NDATA=DA_"^"_^NURSA(214.6,DA,0)
SET Y=+$PIECE(NDATA,U,2)
DO D^DIQ
SET NDATA(1)=Y
WRITE !!,"CLASSIFICATION DATE/TIME: "_Y_"//"
READ X:DTIME
IF X="^"!('$TEST)
SET NUROUT=1
QUIT
+1 IF X="@"
DO DELETE
QUIT
+2 if X=""
SET X=NDATA(1)
SET %DT="R"
DO ^%DT
IF X["?"!'((+Y\1)=($PIECE(NDATA,U,2)\1))
WRITE $CHAR(7),!!,"Enter a date/time on "_$PIECE(NDATA(1),"@")
GOTO EDIT
+3 SET NDATEX(2)=+Y
SET DIE="^NURSA(214.6,"
SET DR=".01////^S X=NDATEX(2);5//;6//"
DO ^DIE
+4 IF '($PIECE(NDATA,"^",2,11)=^NURSA(214.6,+DA,0))
SET $PIECE(^(0),"^",6)=DUZ
+5 SET NUROUT=1
+6 QUIT
DELETE WRITE !!,$CHAR(7),?3,"SURE YOU WANT TO DELETE THE "_NDATA(1)_" ENTRY "
DO YN^DICN
IF '(%>0)
WRITE !!,?5,"ANSWER YES OR NO"
KILL %
GOTO DELETE
+1 IF %=1
SET DIK="^NURSA(214.6,"
DO ^DIK
SET (DA,DA(1))=""
+2 SET NUROUT=1
QUIT
LOCDEF() ; find first active Nurs Location file (211.4) entry which has a
+1 ; Recovery Room bedsection
+2 NEW NURFOUND,NURBED,NURLOC
SET (NURFOUND,NURLOC)=0
+3 FOR
SET NURLOC=$ORDER(^NURSF(211.4,"D","A",NURLOC))
if NURFOUND!(NURLOC'>0)
QUIT
Begin DoDot:1
+4 SET NURBED=0
FOR
SET NURBED=$ORDER(^NURSF(211.4,NURLOC,4,NURBED))
if NURFOUND!(NURBED'>0)
QUIT
IF +$PIECE($GET(^NURSF(211.4,NURLOC,4,NURBED,0)),U)=+HRSW
SET NURFOUND=1
+5 QUIT
End DoDot:1
if NURFOUND
QUIT
+6 QUIT $SELECT(NURFOUND=1:$PIECE($GET(^SC($PIECE(^NURSF(211.4,+NURLOC,0),U),0)),U),1:"")
+7 ;
