NURAED01.m

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

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