Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NURSCPL

NURSCPL.m

Go to the documentation of this file.
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