- 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 Feb 18, 2025@23:48:10 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