source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURSCPL.m@ 770

Last change on this file since 770 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1NURSCPL ;HIRMFO/RM-ADMISSION MODULE TO ADMIT PATIENT TO NURSING ;4/10/96
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ; admits patient into nursing system
4 Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
5 D EN1^NURSAWCK I NURSBAD D EN1^NURSAMSG K NURSBAD,BADWARD Q
6 N DFN K NURSBAD S NURSTX=X,DFN=DA
7 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)
8 D ADDSTAT,QUIT
9 Q
10ADDSTAT ; SETS MAS WARD TO NURSING WARD
11 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)
12 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)
13 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)
14 S NURSWR2=$S(NURSWARD'="":$O(^NURSF(211.4,"C",NURSWR1,NURSWARD,"")),1:"")
15 S NURSTAT=$S(NURSWARD="":"I",'$D(^NURSF(211.4,NURSWARD,1)):"I",$P(^(1),"^",1)="A":"A",1:"I")
16 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:"")
17 S NURSBED=$S(NURSWR3'="":NURSWR3,1:$O(^NURSF(213.3,"B","MEDICAL (EXCLUDE SCI)","")))
18 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)
19 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)
20 Q
21EN2 ; discharge patient from nursing system
22 Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
23 S NURSTX=X,DFN=DA
24 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)
25 S X="A",DA=DFN F NURSI=0:0 S NURSI=$O(^DD(214,1,1,NURSI)) Q:NURSI'>0 X ^(NURSI,2)
26 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)
27QUIT ; KILL LOCAL VARIABLES
28 S X=NURSTX,DA=DFN K NURSADM,NURSDA,NURSDAT,NURSDATE,NURSI,NURSJ,NURSOBED,NURSOSTA,NURSTAT,NURSTX,NURSWARD,NURSWR1,NURSBED,NURSWR2,NURSOWRD,NURSWR3
29 Q
Note: See TracBrowser for help on using the repository browser.