- 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
