NURAED01 ;HIRMFO/RM-Cont. of NURAED0 routine ;2/26/92
;;4.0;NURSING SERVICE;**3**;Apr 25, 1997
EN1 ; Continuation of EN14^NURAED0
S NUR200SC=$S('$D(^DIC(213.9,1,0)):1,$P(^(0),"^",3)'=0:1,1:0)
S NURIDSP(210)="W ?($X+5),$S($D(^VA(200,$S($D(^NURSF(210,+Y,0)):+$P(^(0),U),1:0),1)):$P(^(1),U,9),1:"""") S DA=+Y D EN2^NURSUT0 W:$D(NPSPOS) ?($X+5),NPSPOS,@(""$E(""_DIC_""+Y,0),0)"") K DA,NPSPOS"
S NURIDSP(200)="W ?($X+5),$S($D(^VA(200,+Y,1)):$P(^(1),U,9),1:"""") S DA=+$O(^NURSF(210,""B"",+Y,"""")) I $D(^NURSF(210,+DA,0)) D EN2^NURSUT0 W:$D(NPSPOS) ?($X+5),NPSPOS,@(""$E(""_DIC_""Y,0),0)"") K DA,NPSPOS"
SEL ;
R !!,"Select Nursing Service Staff Name: ",X:DTIME I "^"[X!'$T S XQUIT=1 G Q14
I X?1"?".E S X="?",DIC=210,DIC(0)="QMEZ",DIC("W")=NURIDSP(DIC) D ^DIC G:'NUR200SC SEL W !!?1,"YOU MAY ALSO ADD A NEW NURS STAFF IF YOU WISH.",! S DIC=200,DIC(0)="QMEZ",DIC("W")=NURIDSP(DIC) D ^DIC G SEL
S DIC=210,DIC(0)="MZ",DIC("W")=NURIDSP(DIC) D ^DIC I +Y>0 W !?7,Y(0,0) X NURIDSP(210)
;I '$D(^NURSF(210,+Y,0)) W !!,$C(7),"** STAFF RECORD DATA MISSING **" S XQUIT=1 G Q14
K DIC I $D(DTOUT)!$D(DUOUT) S XQUIT=1 G Q14
YNOK ;
I +Y>0 W !?9,"...OK" S %=1 D YN^DICN S:%=1 NURSDBA=+Y_"^210" S:%=-1 XQUIT=1,Y=-1 G Q14:%=-1!(%=1),SEL:%=2 I %=0 W !?13,"ANSWER YES OR NO." G YNOK
S DIC("S")="I +Y'="""_$P(Y,"^",2)_"""",DIC=200,DIC(0)="MEZ"_$S(NUR200SC:"L",1:""),DIC("W")=NURIDSP(DIC) S:NUR200SC DLAYGO=200,DIC("DR")="9R",DR(1,200)="" D ^DIC K DIC,DLAYGO S (NUR200,DA)=+Y I $D(DTOUT)!$D(DUOUT) S XQUIT=1 G Q14
S NURX=$O(^NURSF(210,"B",+Y,0)) I +$G(^NURSF(210,+NURX,0)) S Y=$O(^NURSF(210,"B",+Y,0)) W ?15,Y(0,0) G YNOK
K:'+$G(^NURSF(210,+NURX,0)) ^NURSF(210,"B",+Y)
I +Y'>0 W $C(7) W:'NUR200SC !,"You cannot add a 'new' NEW PERSON File entry, call Site Manager" W "??" G SEL
S NURCNT=$P(^NURSF(210,0),"^",4)+1,NURCNT(0)=$P(^(0),"^",3)
ADD Q:$D(NURSADD) S NURCNT(0)=(+NURCNT(0)+1) L +^NURSF(210,NURCNT(0),0):0 I '$T!$D(^NURSF(210,NURCNT(0),0)) G ADD
W $C(7),!?3,"ARE YOU ADDING '",Y(0,0),"' AS A NEW NURS STAFF (THE ",NURCNT,$S(NURCNT#10=1&(NURCNT#100-11):"ST",NURCNT#10=2&(NURCNT#100-12):"ND",NURCNT#10=3&(NURCNT#100-13):"RD",1:"TH"),")" S %=0 D YN^DICN
S:%=-1 XQUIT=1 S:%=2 Y=-1 G Q14:%=-1,SEL:%=2 I '% W $C(7),!?4,"ANSWER 'YES' OR 'NO'" G ADD
S DA=NURCNT(0),^NURSF(210,DA,0)=+Y,^NURSF(210,"B",+Y,DA)="",$P(^NURSF(210,0),"^",3,4)=NURCNT(0)_"^"_NURCNT,DR=28.1,DIE=210 D ^DIE K DIE S NURDA=DA D EN5^NURAED3 S NURSDBA=NURDA_"^210" L -^NURSF(210,NURCNT(0),0)
Q14 K %,DA,DIC,DLAYGO,DR,DTOUT,DUOUT,NI,NUROUT,NUR200,NUR200SC,NURANM,NURCNT,NURDA,NURIDSP,NURSASS,NURSNPOS,NURSPOS,NURSTAT,NURX,NURSX,NURSY,NURSNP,NURSOPOS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAED01 2635 printed Dec 13, 2024@02:19:12 Page 2
NURAED01 ;HIRMFO/RM-Cont. of NURAED0 routine ;2/26/92
+1 ;;4.0;NURSING SERVICE;**3**;Apr 25, 1997
EN1 ; Continuation of EN14^NURAED0
+1 SET NUR200SC=$SELECT('$DATA(^DIC(213.9,1,0)):1,$PIECE(^(0),"^",3)'=0:1,1:0)
+2 SET NURIDSP(210)="W ?($X+5),$S($D(^VA(200,$S($D(^NURSF(210,+Y,0)):+$P(^(0),U),1:0),1)):$P(^(1),U,9),1:"""") S DA=+Y D EN2^NURSUT0 W:$D(NPSPOS) ?($X+5),NPSPOS,@(""$E(""_DIC_""+Y,0),0)"") K DA,NPSPOS"
+3 SET NURIDSP(200)="W ?($X+5),$S($D(^VA(200,+Y,1)):$P(^(1),U,9),1:"""") S DA=+$O(^NURSF(210,""B"",+Y,"""")) I $D(^NURSF(210,+DA,0)) D EN2^NURSUT0 W:$D(NPSPOS) ?($X+5),NPSPOS,@(""$E(""_DIC_""Y,0),0)"") K DA,NPSPOS"
SEL ;
+1 READ !!,"Select Nursing Service Staff Name: ",X:DTIME
IF "^"[X!'$TEST
SET XQUIT=1
GOTO Q14
+2 IF X?1"?".E
SET X="?"
SET DIC=210
SET DIC(0)="QMEZ"
SET DIC("W")=NURIDSP(DIC)
DO ^DIC
if 'NUR200SC
GOTO SEL
WRITE !!?1,"YOU MAY ALSO ADD A NEW NURS STAFF IF YOU WISH.",!
SET DIC=200
SET DIC(0)="QMEZ"
SET DIC("W")=NURIDSP(DIC)
DO ^DIC
GOTO SEL
+3 SET DIC=210
SET DIC(0)="MZ"
SET DIC("W")=NURIDSP(DIC)
DO ^DIC
IF +Y>0
WRITE !?7,Y(0,0)
XECUTE NURIDSP(210)
+4 ;I '$D(^NURSF(210,+Y,0)) W !!,$C(7),"** STAFF RECORD DATA MISSING **" S XQUIT=1 G Q14
+5 KILL DIC
IF $DATA(DTOUT)!$DATA(DUOUT)
SET XQUIT=1
GOTO Q14
YNOK ;
+1 IF +Y>0
WRITE !?9,"...OK"
SET %=1
DO YN^DICN
if %=1
SET NURSDBA=+Y_"^210"
if %=-1
SET XQUIT=1
SET Y=-1
if %=-1!(%=1)
GOTO Q14
if %=2
GOTO SEL
IF %=0
WRITE !?13,"ANSWER YES OR NO."
GOTO YNOK
+2 SET DIC("S")="I +Y'="""_$PIECE(Y,"^",2)_""""
SET DIC=200
SET DIC(0)="MEZ"_$SELECT(NUR200SC:"L",1:"")
SET DIC("W")=NURIDSP(DIC)
if NUR200SC
SET DLAYGO=200
SET DIC("DR")="9R"
SET DR(1,200)=""
DO ^DIC
KILL DIC,DLAYGO
SET (NUR200,DA)=+Y
IF $DATA(DTOUT)!$DATA(DUOUT)
SET XQUIT=1
GOTO Q14
+3 SET NURX=$ORDER(^NURSF(210,"B",+Y,0))
IF +$GET(^NURSF(210,+NURX,0))
SET Y=$ORDER(^NURSF(210,"B",+Y,0))
WRITE ?15,Y(0,0)
GOTO YNOK
+4 if '+$GET(^NURSF(210,+NURX,0))
KILL ^NURSF(210,"B",+Y)
+5 IF +Y'>0
WRITE $CHAR(7)
if 'NUR200SC
WRITE !,"You cannot add a 'new' NEW PERSON File entry, call Site Manager"
WRITE "??"
GOTO SEL
+6 SET NURCNT=$PIECE(^NURSF(210,0),"^",4)+1
SET NURCNT(0)=$PIECE(^(0),"^",3)
ADD if $DATA(NURSADD)
QUIT
SET NURCNT(0)=(+NURCNT(0)+1)
LOCK +^NURSF(210,NURCNT(0),0):0
IF '$TEST!$DATA(^NURSF(210,NURCNT(0),0))
GOTO ADD
+1 WRITE $CHAR(7),!?3,"ARE YOU ADDING '",Y(0,0),"' AS A NEW NURS STAFF (THE ",NURCNT,$SELECT(NURCNT#10=1&(NURCNT#100-11):"ST",NURCNT#10=2&(NURCNT#100-12):"ND",NURCNT#10=3&(NURCNT#100-13):"RD",1:"TH"),")"
SET %=0
DO YN^DICN
+2 if %=-1
SET XQUIT=1
if %=2
SET Y=-1
if %=-1
GOTO Q14
if %=2
GOTO SEL
IF '%
WRITE $CHAR(7),!?4,"ANSWER 'YES' OR 'NO'"
GOTO ADD
+3 SET DA=NURCNT(0)
SET ^NURSF(210,DA,0)=+Y
SET ^NURSF(210,"B",+Y,DA)=""
SET $PIECE(^NURSF(210,0),"^",3,4)=NURCNT(0)_"^"_NURCNT
SET DR=28.1
SET DIE=210
DO ^DIE
KILL DIE
SET NURDA=DA
DO EN5^NURAED3
SET NURSDBA=NURDA_"^210"
LOCK -^NURSF(210,NURCNT(0),0)
Q14 KILL %,DA,DIC,DLAYGO,DR,DTOUT,DUOUT,NI,NUROUT,NUR200,NUR200SC,NURANM,NURCNT,NURDA,NURIDSP,NURSASS,NURSNPOS,NURSPOS,NURSTAT,NURX,NURSX,NURSY,NURSNP,NURSOPOS
+1 QUIT
