VistA-WorldVistAEHR/r/NURSING_SERVICE-NUR/NURSCPLE.m

42 lines
2.0 KiB
Mathematica

NURSCPLE ;HIRMFO/RM,FT/MD-BACKUP BED CONTROL FOR NURSING SERVICE ;4/23/97
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; ENTRY FROM ROUTINE NURACE0 TO UPDATE NURS PATIENT LOCATION
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
S NADM=0 D EDT
Q1 ; KILL LOCAL VARIABLES
D ^NURSKILL
Q
EDT W !! S NASK=1,DIC(0)="EQM",NACT=0 D EN5^NURSCUTL G:DFN="" Q1 I '$D(^NURSF(214,"C","A",DFN)),'NADM W !,$C(7),"Patient not admitted in Nursing Package" G Q1
L +^NURSF(214,DFN):3 I '$T W !,"CANNOT EDIT AT THIS TIME" G Q1
D:NADM ADM
S NURLSCR=1,DA=DFN,DIE="^NURSF(214,"
S DR="2Select Nursing Unit;S NURSS=$S('$D(^NURSF(211.4,X,""I"")):""A"",$P(^(""I""),U)=""A"":""A"",1:""I""),NURSS=$S(NURSS=""I"":""I"",'$D(^(1)):""A"",1:$P(^(1),U));1///^S X=NURSS;K NURSS;3Select Nursing Bed Section"
D ^DIE K NURLSCR L -^NURSF(214,DFN)
I $S('$D(^NURSF(214,DFN,0)):1,$P(^(0),"^",3)="":1,$P(^(0),"^",4)="":1,1:0) S DA=DFN,DIK="^NURSF(214," D ^DIK W !,$C(7),"Patient not admitted to Nursing!!"
Q
EN2 ; CALLED FROM OPTION NURSPT-ACT BACKUP TO MAS TO ADMIT PATIENT
; INTO NURSING SERVICE.
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
S NADM=1 D EDT
G Q1
ADM S DA=DFN,DIE=214,DR=$S('$D(^NURSF(214,DFN,0)):".01///^S X=""`""_DFN;",1:"")_"1///^S X=""A"";4///^S X=DT;5///@" D ^DIE
D DEM^VADPT W !!,VADM(1)," has been admitted into the NURSING SYSTEM."
Q
EN3 ; ENTRY FOR INDIVIDUAL PATIENT CENSUS
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
S NURQUEUE=0,NASK=1,DIC(0)="EQM",NACT=1 W ! D EN5^NURSCUTL
G:DFN="" QUIT^NURSCPLC
S NPWARD=$P(^NURSF(214,DFN,0),"^",3) D EN6^NURSAUTL S NURSWARD=NPWARD
S NSEC=$S('$D(^NURSF(214,DFN,0)):"",$P(^(0),"^",4)="":"",'$D(^NURSF(213.3,$P(^NURSF(214,DFN,0),"^",4),0)):"",1:$P(^NURSF(213.3,$P(^NURSF(214,DFN,0),"^",4),1),"^",1))
D FNDCLAS^NURSCPLC D OERR^VADPT
S N1=VADM(1),SSN=VA("PID"),NBED=VAIN(5)
D ^NURSAPCH
W !,"NAME: "_N1_" "_SSN
W !,"UNIT: "_NURSWARD
W !,"ROOM-BED: "_NBED
W !,"ABSENCE: "_NURSX
W !,"BED SEC: "_NSEC
W !,"ACUITY: "_NURCAT
D QUIT^NURSCPLC
Q