NURSCPL ;HIRMFO/RM-ADMISSION MODULE TO ADMIT PATIENT TO NURSING ;4/10/96
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; admits patient into nursing system
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
D EN1^NURSAWCK I NURSBAD D EN1^NURSAMSG K NURSBAD,BADWARD Q
N DFN K NURSBAD S NURSTX=X,DFN=DA
I $S('$D(^NURSF(214,DFN,0)):1,$P(^(0),"^",1)'="":0,1:1) S (X,DA)=DFN,^NURSF(214,DA,0)=X,$P(^NURSF(214,0),"^",3,4)=DA_"^"_($P(^NURSF(214,0),"^",4)+1) F NURSI=0:0 S NURSI=$O(^DD(214,.01,1,NURSI)) Q:NURSI'>0 X ^(NURSI,1)
D ADDSTAT,QUIT
Q
ADDSTAT ; SETS MAS WARD TO NURSING WARD
S NURSDAT=$S($D(^NURSF(214,DFN,0)):^(0),1:""),NURSOWRD=$P(NURSDAT,"^",3),NURSOSTA=$P(NURSDAT,"^",2),NURSOBED=$P(NURSDAT,"^",4),NURSODDT=$P(NURSDAT,"^",6)
F NURSI=0:0 S NURSI=$O(^DIC(42,"B",NURSTX,NURSI)) Q:NURSI'>0 S NURSWR1=NURSI Q:$S('$D(^DIC(42,NURSWR1,"I")):1,$P(^("I"),"^")="I":0,1:1)
S NURSWARD="" I NURSWR1'="" F NURSI=0:0 S NURSI=$O(^NURSF(211.4,"C",NURSWR1,NURSI)) Q:NURSI'>0 S NURSWARD=NURSI Q:$S('$D(^NURSF(211.4,NURSWARD,"I")):1,$P(^("I"),"^")="I":0,1:0)
S NURSWR2=$S(NURSWARD'="":$O(^NURSF(211.4,"C",NURSWR1,NURSWARD,"")),1:"")
S NURSTAT=$S(NURSWARD="":"I",'$D(^NURSF(211.4,NURSWARD,1)):"I",$P(^(1),"^",1)="A":"A",1:"I")
S NURSWR3=$S($D(^NURSF(211.4,NURSWARD,3,NURSWR2,0)):$P(^(0),"^",2),1:"") I NURSWR3="" S NURSWR3=$O(^NURSF(211.4,NURSWARD,4,0)) S:NURSWR3'="" NURSWR3=$S($D(^NURSF(211.4,NURSWARD,4,NURSWR3,0)):$P(^(0),"^"),1:"")
S NURSBED=$S(NURSWR3'="":NURSWR3,1:$O(^NURSF(213.3,"B","MEDICAL (EXCLUDE SCI)","")))
S DA=DFN F NURSJ=1:1:3,5 S X=$S(NURSJ=1:NURSOSTA,NURSJ=2:NURSOWRD,NURSJ=5:NURSODDT,1:NURSOBED) I X'="" F NURSI=0:0 S NURSI=$O(^DD(214,NURSJ,1,NURSI)) Q:NURSI'>0 X ^(NURSI,2)
S $P(^NURSF(214,DA,0),"^",2,6)=NURSTAT_"^"_NURSWARD_"^"_NURSBED_"^"_DT_"^" F NURSJ=1:1:4 S X=$S(NURSJ=1:NURSTAT,NURSJ=2:NURSWARD,NURSJ=3:NURSBED,1:DT) I X'="" F NURSI=0:0 S NURSI=$O(^DD(214,NURSJ,1,NURSI)) Q:NURSI'>0 X ^(NURSI,1)
Q
EN2 ; discharge patient from nursing system
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
S NURSTX=X,DFN=DA
I $P($G(^NURSF(214,DFN,0)),"^")="" S (X,DA)=DFN,^NURSF(214,DA,0)=X,$P(^NURSF(214,0),"^",3,4)=DA_"^"_($P(^NURSF(214,0),"^",4)+1) F NURSI=0:0 S NURSI=$O(^DD(214,.01,1,NURSI)) Q:NURSI'>0 X ^DD(214,.01,1,NURSI,1)
S X="A",DA=DFN F NURSI=0:0 S NURSI=$O(^DD(214,1,1,NURSI)) Q:NURSI'>0 X ^(NURSI,2)
S X="I",$P(^NURSF(214,DA,0),"^",2)="I" F NURSI=0:0 S NURSI=$O(^DD(214,1,1,NURSI)) Q:NURSI'>0 X ^(NURSI,1)
QUIT ; KILL LOCAL VARIABLES
S X=NURSTX,DA=DFN K NURSADM,NURSDA,NURSDAT,NURSDATE,NURSI,NURSJ,NURSOBED,NURSOSTA,NURSTAT,NURSTX,NURSWARD,NURSWR1,NURSBED,NURSWR2,NURSOWRD,NURSWR3
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSCPL 2675 printed Nov 22, 2024@17:31:49 Page 2
NURSCPL ;HIRMFO/RM-ADMISSION MODULE TO ADMIT PATIENT TO NURSING ;4/10/96
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; admits patient into nursing system
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
QUIT
+2 DO EN1^NURSAWCK
IF NURSBAD
DO EN1^NURSAMSG
KILL NURSBAD,BADWARD
QUIT
+3 NEW DFN
KILL NURSBAD
SET NURSTX=X
SET DFN=DA
+4 IF $SELECT('$DATA(^NURSF(214,DFN,0)):1,$PIECE(^(0),"^",1)'="":0,1:1)
SET (X,DA)=DFN
SET ^NURSF(214,DA,0)=X
SET $PIECE(^NURSF(214,0),"^",3,4)=DA_"^"_($PIECE(^NURSF(214,0),"^",4)+1)
FOR NURSI=0:0
SET NURSI=$ORDER(^DD(214,.01,1,NURSI))
if NURSI'>0
QUIT
XECUTE ^(NURSI,1)
+5 DO ADDSTAT
DO QUIT
+6 QUIT
ADDSTAT ; SETS MAS WARD TO NURSING WARD
+1 SET NURSDAT=$SELECT($DATA(^NURSF(214,DFN,0)):^(0),1:"")
SET NURSOWRD=$PIECE(NURSDAT,"^",3)
SET NURSOSTA=$PIECE(NURSDAT,"^",2)
SET NURSOBED=$PIECE(NURSDAT,"^",4)
SET NURSODDT=$PIECE(NURSDAT,"^",6)
+2 FOR NURSI=0:0
SET NURSI=$ORDER(^DIC(42,"B",NURSTX,NURSI))
if NURSI'>0
QUIT
SET NURSWR1=NURSI
if $SELECT('$DATA(^DIC(42,NURSWR1,"I"))
QUIT
+3 SET NURSWARD=""
IF NURSWR1'=""
FOR NURSI=0:0
SET NURSI=$ORDER(^NURSF(211.4,"C",NURSWR1,NURSI))
if NURSI'>0
QUIT
SET NURSWARD=NURSI
if $SELECT('$DATA(^NURSF(211.4,NURSWARD,"I"))
QUIT
+4 SET NURSWR2=$SELECT(NURSWARD'="":$ORDER(^NURSF(211.4,"C",NURSWR1,NURSWARD,"")),1:"")
+5 SET NURSTAT=$SELECT(NURSWARD="":"I",'$DATA(^NURSF(211.4,NURSWARD,1)):"I",$PIECE(^(1),"^",1)="A":"A",1:"I")
+6 SET NURSWR3=$SELECT($DATA(^NURSF(211.4,NURSWARD,3,NURSWR2,0)):$PIECE(^(0),"^",2),1:"")
IF NURSWR3=""
SET NURSWR3=$ORDER(^NURSF(211.4,NURSWARD,4,0))
if NURSWR3'=""
SET NURSWR3=$SELECT($DATA(^NURSF(211.4,NURSWARD,4,NURSWR3,0)):$PIECE(^(0),"^"),1:"")
+7 SET NURSBED=$SELECT(NURSWR3'="":NURSWR3,1:$ORDER(^NURSF(213.3,"B","MEDICAL (EXCLUDE SCI)","")))
+8 SET DA=DFN
FOR NURSJ=1:1:3,5
SET X=$SELECT(NURSJ=1:NURSOSTA,NURSJ=2:NURSOWRD,NURSJ=5:NURSODDT,1:NURSOBED)
IF X'=""
FOR NURSI=0:0
SET NURSI=$ORDER(^DD(214,NURSJ,1,NURSI))
if NURSI'>0
QUIT
XECUTE ^(NURSI,2)
+9 SET $PIECE(^NURSF(214,DA,0),"^",2,6)=NURSTAT_"^"_NURSWARD_"^"_NURSBED_"^"_DT_"^"
FOR NURSJ=1:1:4
SET X=$SELECT(NURSJ=1:NURSTAT,NURSJ=2:NURSWARD,NURSJ=3:NURSBED,1:DT)
IF X'=""
FOR NURSI=0:0
SET NURSI=$ORDER(^DD(214,NURSJ,1,NURSI))
if NURSI'>0
QUIT
XECUTE ^(NURSI,1)
+10 QUIT
EN2 ; discharge patient from nursing system
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
QUIT
+2 SET NURSTX=X
SET DFN=DA
+3 IF $PIECE($GET(^NURSF(214,DFN,0)),"^")=""
SET (X,DA)=DFN
SET ^NURSF(214,DA,0)=X
SET $PIECE(^NURSF(214,0),"^",3,4)=DA_"^"_($PIECE(^NURSF(214,0),"^",4)+1)
FOR NURSI=0:0
SET NURSI=$ORDER(^DD(214,.01,1,NURSI))
if NURSI'>0
QUIT
XECUTE ^DD(214,.01,1,NURSI,1)
+4 SET X="A"
SET DA=DFN
FOR NURSI=0:0
SET NURSI=$ORDER(^DD(214,1,1,NURSI))
if NURSI'>0
QUIT
XECUTE ^(NURSI,2)
+5 SET X="I"
SET $PIECE(^NURSF(214,DA,0),"^",2)="I"
FOR NURSI=0:0
SET NURSI=$ORDER(^DD(214,1,1,NURSI))
if NURSI'>0
QUIT
XECUTE ^(NURSI,1)
QUIT ; KILL LOCAL VARIABLES
+1 SET X=NURSTX
SET DA=DFN
KILL NURSADM,NURSDA,NURSDAT,NURSDATE,NURSI,NURSJ,NURSOBED,NURSOSTA,NURSTAT,NURSTX,NURSWARD,NURSWR1,NURSBED,NURSWR2,NURSOWRD,NURSWR3
+2 QUIT
