- NURSALED ;HIRMFO/RM,FT-LOCATION FILE EDIT ROUTINE ;6/11/89
- ;;4.0;NURSING SERVICE;**17**;Apr 25, 1997
- EN1 ; ENTRY TO EDIT LOCATION FILE ENTRY FROM NURSAFUD ROUTINE
- S NURSWARD=+Y,NURSWARD(0)=$P(Y(0),"^"),NURSWARD(0,0)=Y(0,0),NURSNEW=+$P(Y,"^",3)
- NAME ;
- W !,"NAME: "_NURSWARD(0,0)_"// " R X:DTIME S X=$S('$T:"^",X="":NURSWARD(0,0),1:X) G Q1:"^"[X I X="@" W $C(7) S XQH="NURS-LOCATION-DELETE" D EN^XQH K XQH G NAME
- I X?1"?".E W $C(7),!?5,"Answer with Nursing Unit name. Answer must be 2-30 characters",!?5,"in length. You may put the letters 'NUR ' in front of the unit",!?5,"name, but if you do not the software will take care of it." G NAME
- I X?1P.E!(X'?.ANP)!(X["""") W $C(7)," ??" G NAME
- S X=$S(X'?1"NUR ".E:"NUR "_X,1:X) I $L(X)<2!($L(X)>30) W $C(7),!?5,"Answer must be between 2 and 30 characters in length." G NAME
- S NURFACIL=$$EN8^NURSAFU0() S:$$SITE^VASITE()'>0 NURFACIL="Y"
- I X'=("NUR "_NURSWARD(0,0)) S NURLOC=X,DIE="^SC(",DR=".01///^S X=NURLOC;S:NURFACIL=""Y"" Y=""@1"";3///^S X=$P($$SITE^VASITE(),U,2);S Y=0;@1;3",DA=NURSWARD(0) D ^DIE K NURFACIL G:$D(Y) Q1
- S DA=$P($G(^NURSF(211.4,+NURSWARD,0)),U,1) I DA>0 S DIE="^SC(",DR="3R~HOSPITAL LOCATION INSTITUTION" D ^DIE
- G:$D(Y) Q1 ;quit if user up-arrows out
- S DIE="^NURSF(211.4,",DR="S:$$EN7^NURSAFU0()'=""Y"" Y=""@1"";.03R;S Y=""@2"";@1;.03///^S X=""NURSING"";@2;1T~;1.5T~",DA=NURSWARD D ^DIE
- G:$D(Y) Q1 ;quit if user up-arrows out
- I $D(X),X="I",'$D(^NURSF(211.4,DA,3,0))#2 G Q1
- MAS ;
- S NURSOMAS=+$O(^NURSF(211.4,NURSWARD,3,0)) G:'NURSOMAS ASKM
- OMAS ;
- K OMAS S Z=1 F X=0:0 S X=$O(^NURSF(211.4,NURSWARD,3,X)) Q:X'>0 S Y=$S($D(^NURSF(211.4,NURSWARD,3,X,0)):$P(^(0),"^"),1:"") S:Y'="" OMAS(Z)=X_"^"_Y,Z=Z+1
- S OMAS=Z-1 W !!,"Below is a listing of associated MAS wards"
- S Z=0 F X=0:0 S X=$O(OMAS(X)) Q:X'>0 W !?2,$J(X,2),". ",$S($D(^DIC(42,+$P(OMAS(X),"^",2),0)):$P(^(0),"^"),1:"") S Z=Z+1 D LINCK Q:Y="^"
- ASKM ;
- D ASKM0 G Q1:"^"[NURSX I NURSX="A"!(NURSX="B")!(NURSX="D"&NURSOMAS) W " ",$P($T(@NURSX),";;",2),! D ADDM^NURSALE0:NURSX="A",DELM^NURSALE0:NURSX="D" G Q1:NURSX="^",ABED:NURSX="B",MAS
- ABED ;
- S NURSOBED=+$O(^NURSF(211.4,NURSWARD,4,0)) G:'NURSOBED ASKB
- OBED ;
- K OBED S Z=1 F X=0:0 S X=$O(^NURSF(211.4,NURSWARD,4,X)) Q:X'>0 S Y=$S($D(^NURSF(211.4,NURSWARD,4,X,0)):$P(^(0),"^"),1:"") S:Y'="" OBED(Z)=X_"^"_Y,Z=Z+1
- S OBED=Z-1 W !!?7,"AMIS Bed section",?43,"Associated MAS ward"
- S Z=0 F X=0:0 S X=$O(OBED(X)) Q:X'>0 W !,$J(X,2),". ",$S($D(^NURSF(213.3,+$P(OBED(X),"^",2),0)):$P(^(0),"^"),1:"") S Z=Z+1 D LINCK Q:Y="^" D PMAS Q:Y="^"
- ASKB ;
- D ASKB^NURSALE0 G Q1:"^"[NURSX I NURSX="A"!(NURSX="B")!((NURSX="D"!(NURSX="E"))&NURSOBED) W " ",$P($T(@NURSX),";;",2),! D ADDB^NURSALE0:NURSX="A",DELB^NURSALE0:NURSX="D",EDM^NURSALE0:NURSX="E" G Q1:NURSX="^",BYPB:NURSX="B",ABED
- BYPB ;
- G Q1:NURSREV W ! S DR="[NURS-I-PRIORITY 1A]",DIE="^NURSF(211.4,",DA=NURSWARD D ^DIE
- D ^NURSBPO
- Q1 ;
- D ^NURSKILL
- Q
- PMAS ;
- S Y="",B=$O(^NURSF(211.4,"ABS",+$P(OBED(X),"^",2),NURSWARD,3,0)) Q:B'>0
- F A=B:0 W:A'=B ! S:A'=B Z=Z+1 D:A'=B LINCK Q:Y="^" S C=$S($D(^NURSF(211.4,NURSWARD,3,A,0)):$P(^(0),"^"),1:"") W ?41,$S($D(^DIC(42,+C,0)):$P(^(0),"^"),1:"") S A=$O(^NURSF(211.4,"ABS",+$P(OBED(X),"^",2),NURSWARD,3,A)) Q:A'>0
- Q
- LINCK ;
- I Z>(IOSL-3) W !,"Press return to continue or ""^"" to exit: " R Y:DTIME S:'$T Y="^" Q:Y="^" S Z=0
- Q
- ASKM0 ;
- W:'NURSOMAS !!,"There are no MAS wards associated with this Nursing unit."
- W !,"Would you like to (A)dd new MAS wards" W:NURSOMAS ", (D)elete existing units from the",!,"above listing" W " or (B)ypass " W:'NURSOMAS ! W "this prompt (A"_$S(NURSOMAS:"/D",1:"")_"/B): "_$S(NURSOMAS:"B",NURSNEW:"A",1:"B")_"// "
- R X:DTIME S NURSX=$S('$T:"^",X'="":$S(X'?1L:X,1:$C($A(X)-32)),NURSOMAS:"B",NURSNEW:"A",1:"B") Q:"^"[NURSX!(NURSX="B")!(NURSX="A")!(NURSX="D"&NURSOMAS)
- I NURSX?1"?".E W !?4,$C(7),"ANSWER WITH A IF YOU WOULD LIKE TO ADD MORE MAS WARDS FOR THIS UNIT" W:NURSOMAS ",",!?16,"D IF YOU WOULD LIKE TO DELETE MAS WARDS FROM THE ABOVE LISTING,"
- I W !?13,"OR B IF YOU WOULD LIKE TO DO NOTHING AND BYPASS THIS PROMPT." G ASKM0
- W !?4,$C(7),"INVALID ENTRY, TYPE ? TO GET MORE HELP" G ASKM0
- ;
- A ;;ADD NEW ENTRIES
- B ;;BYPASS PROMPT
- D ;;DELETE EXISTING ENTRIES
- E ;;EDIT RELATIONSHIP
- NURSALED ;HIRMFO/RM,FT-LOCATION FILE EDIT ROUTINE ;6/11/89
- +1 ;;4.0;NURSING SERVICE;**17**;Apr 25, 1997
- EN1 ; ENTRY TO EDIT LOCATION FILE ENTRY FROM NURSAFUD ROUTINE
- +1 SET NURSWARD=+Y
- SET NURSWARD(0)=$PIECE(Y(0),"^")
- SET NURSWARD(0,0)=Y(0,0)
- SET NURSNEW=+$PIECE(Y,"^",3)
- NAME ;
- +1 WRITE !,"NAME: "_NURSWARD(0,0)_"// "
- READ X:DTIME
- SET X=$SELECT('$TEST:"^",X="":NURSWARD(0,0),1:X)
- IF "^"[X
- GOTO Q1
- IF X="@"
- WRITE $CHAR(7)
- SET XQH="NURS-LOCATION-DELETE"
- DO EN^XQH
- KILL XQH
- GOTO NAME
- +2 IF X?1"?".E
- WRITE $CHAR(7),!?5,"Answer with Nursing Unit name. Answer must be 2-30 characters",!?5,"in length. You may put the letters 'NUR ' in front of the unit",!?5,"name, but if you do not the software will take care of it."
- GOTO NAME
- +3 IF X?1P.E!(X'?.ANP)!(X["""")
- WRITE $CHAR(7)," ??"
- GOTO NAME
- +4 SET X=$SELECT(X'?1"NUR ".E:"NUR "_X,1:X)
- IF $LENGTH(X)<2!($LENGTH(X)>30)
- WRITE $CHAR(7),!?5,"Answer must be between 2 and 30 characters in length."
- GOTO NAME
- +5 SET NURFACIL=$$EN8^NURSAFU0()
- IF $$SITE^VASITE()'>0
- SET NURFACIL="Y"
- +6 IF X'=("NUR "_NURSWARD(0,0))
- SET NURLOC=X
- SET DIE="^SC("
- SET DR=".01///^S X=NURLOC;S:NURFACIL=""Y"" Y=""@1"";3///^S X=$P($$SITE^VASITE(),U,2);S Y=0;@1;3"
- SET DA=NURSWARD(0)
- DO ^DIE
- KILL NURFACIL
- IF $DATA(Y)
- GOTO Q1
- +7 SET DA=$PIECE($GET(^NURSF(211.4,+NURSWARD,0)),U,1)
- IF DA>0
- SET DIE="^SC("
- SET DR="3R~HOSPITAL LOCATION INSTITUTION"
- DO ^DIE
- +8 ;quit if user up-arrows out
- IF $DATA(Y)
- GOTO Q1
- +9 SET DIE="^NURSF(211.4,"
- SET DR="S:$$EN7^NURSAFU0()'=""Y"" Y=""@1"";.03R;S Y=""@2"";@1;.03///^S X=""NURSING"";@2;1T~;1.5T~"
- SET DA=NURSWARD
- DO ^DIE
- +10 ;quit if user up-arrows out
- IF $DATA(Y)
- GOTO Q1
- +11 IF $DATA(X)
- IF X="I"
- IF '$DATA(^NURSF(211.4,DA,3,0))#2
- GOTO Q1
- MAS ;
- +1 SET NURSOMAS=+$ORDER(^NURSF(211.4,NURSWARD,3,0))
- IF 'NURSOMAS
- GOTO ASKM
- OMAS ;
- +1 KILL OMAS
- SET Z=1
- FOR X=0:0
- SET X=$ORDER(^NURSF(211.4,NURSWARD,3,X))
- IF X'>0
- QUIT
- SET Y=$SELECT($DATA(^NURSF(211.4,NURSWARD,3,X,0)):$PIECE(^(0),"^"),1:"")
- IF Y'=""
- SET OMAS(Z)=X_"^"_Y
- SET Z=Z+1
- +2 SET OMAS=Z-1
- WRITE !!,"Below is a listing of associated MAS wards"
- +3 SET Z=0
- FOR X=0:0
- SET X=$ORDER(OMAS(X))
- IF X'>0
- QUIT
- WRITE !?2,$JUSTIFY(X,2),". ",$SELECT($DATA(^DIC(42,+$PIECE(OMAS(X),"^",2),0)):$PIECE(^(0),"^"),1:"")
- SET Z=Z+1
- DO LINCK
- IF Y="^"
- QUIT
- ASKM ;
- +1 DO ASKM0
- IF "^"[NURSX
- GOTO Q1
- IF NURSX="A"!(NURSX="B")!(NURSX="D"&NURSOMAS)
- WRITE " ",$PIECE($TEXT(@NURSX),";;",2),!
- IF NURSX="A"
- DO ADDM^NURSALE0
- IF NURSX="D"
- DO DELM^NURSALE0
- IF NURSX="^"
- GOTO Q1
- IF NURSX="B"
- GOTO ABED
- GOTO MAS
- ABED ;
- +1 SET NURSOBED=+$ORDER(^NURSF(211.4,NURSWARD,4,0))
- IF 'NURSOBED
- GOTO ASKB
- OBED ;
- +1 KILL OBED
- SET Z=1
- FOR X=0:0
- SET X=$ORDER(^NURSF(211.4,NURSWARD,4,X))
- IF X'>0
- QUIT
- SET Y=$SELECT($DATA(^NURSF(211.4,NURSWARD,4,X,0)):$PIECE(^(0),"^"),1:"")
- IF Y'=""
- SET OBED(Z)=X_"^"_Y
- SET Z=Z+1
- +2 SET OBED=Z-1
- WRITE !!?7,"AMIS Bed section",?43,"Associated MAS ward"
- +3 SET Z=0
- FOR X=0:0
- SET X=$ORDER(OBED(X))
- IF X'>0
- QUIT
- WRITE !,$JUSTIFY(X,2),". ",$SELECT($DATA(^NURSF(213.3,+$PIECE(OBED(X),"^",2),0)):$PIECE(^(0),"^"),1:"")
- SET Z=Z+1
- DO LINCK
- IF Y="^"
- QUIT
- DO PMAS
- IF Y="^"
- QUIT
- ASKB ;
- +1 DO ASKB^NURSALE0
- IF "^"[NURSX
- GOTO Q1
- IF NURSX="A"!(NURSX="B")!((NURSX="D"!(NURSX="E"))&NURSOBED)
- WRITE " ",$PIECE($TEXT(@NURSX),";;",2),!
- IF NURSX="A"
- DO ADDB^NURSALE0
- IF NURSX="D"
- DO DELB^NURSALE0
- IF NURSX="E"
- DO EDM^NURSALE0
- IF NURSX="^"
- GOTO Q1
- IF NURSX="B"
- GOTO BYPB
- GOTO ABED
- BYPB ;
- +1 IF NURSREV
- GOTO Q1
- WRITE !
- SET DR="[NURS-I-PRIORITY 1A]"
- SET DIE="^NURSF(211.4,"
- SET DA=NURSWARD
- DO ^DIE
- +2 DO ^NURSBPO
- Q1 ;
- +1 DO ^NURSKILL
- +2 QUIT
- PMAS ;
- +1 SET Y=""
- SET B=$ORDER(^NURSF(211.4,"ABS",+$PIECE(OBED(X),"^",2),NURSWARD,3,0))
- IF B'>0
- QUIT
- +2 FOR A=B:0
- IF A'=B
- WRITE !
- IF A'=B
- SET Z=Z+1
- IF A'=B
- DO LINCK
- IF Y="^"
- QUIT
- SET C=$SELECT($DATA(^NURSF(211.4,NURSWARD,3,A,0)):$PIECE(^(0),"^"),1:"")
- WRITE ?41,$SELECT($DATA(^DIC(42,+C,0)):$PIECE(^(0),"^"),1:"")
- SET A=$ORDER(^NURSF(211.4,"ABS",+$PIECE(OBED(X),"^",2),NURSWARD,3,A))
- IF A'>0
- QUIT
- +3 QUIT
- LINCK ;
- +1 IF Z>(IOSL-3)
- WRITE !,"Press return to continue or ""^"" to exit: "
- READ Y:DTIME
- IF '$TEST
- SET Y="^"
- IF Y="^"
- QUIT
- SET Z=0
- +2 QUIT
- ASKM0 ;
- +1 IF 'NURSOMAS
- WRITE !!,"There are no MAS wards associated with this Nursing unit."
- +2 WRITE !,"Would you like to (A)dd new MAS wards"
- IF NURSOMAS
- WRITE ", (D)elete existing units from the",!,"above listing"
- WRITE " or (B)ypass "
- IF 'NURSOMAS
- WRITE !
- WRITE "this prompt (A"_$SELECT(NURSOMAS:"/D",1:"")_"/B): "_$SELECT(NURSOMAS:"B",NURSNEW:"A",1:"B")_"// "
- +3 READ X:DTIME
- SET NURSX=$SELECT('$TEST:"^",X'="":$SELECT(X'?1L:X,1:$CHAR($ASCII(X)-32)),NURSOMAS:"B",NURSNEW:"A",1:"B")
- IF "^"[NURSX!(NURSX="B")!(NURSX="A")!(NURSX="D"&NURSOMAS)
- QUIT
- +4 IF NURSX?1"?".E
- WRITE !?4,$CHAR(7),"ANSWER WITH A IF YOU WOULD LIKE TO ADD MORE MAS WARDS FOR THIS UNIT"
- IF NURSOMAS
- WRITE ",",!?16,"D IF YOU WOULD LIKE TO DELETE MAS WARDS FROM THE ABOVE LISTING,"
- +5 IF $TEST
- WRITE !?13,"OR B IF YOU WOULD LIKE TO DO NOTHING AND BYPASS THIS PROMPT."
- GOTO ASKM0
- +6 WRITE !?4,$CHAR(7),"INVALID ENTRY, TYPE ? TO GET MORE HELP"
- GOTO ASKM0
- +7 ;
- A ;;ADD NEW ENTRIES
- B ;;BYPASS PROMPT
- D ;;DELETE EXISTING ENTRIES
- E ;;EDIT RELATIONSHIP
