NURSALE0 ;HIRMFO/RM-LOCATION FILE EDIT ROUTINE ;11/4/89
;;4.0;NURSING SERVICE;;Apr 25, 1997
ASKB ;
W:'NURSOBED !!,"There are no AMIS bed sections associated with this Nursing unit."
W !,"Would you like to (A)dd new AMIS bed sections" W:NURSOBED ", (D)elete existing AMIS",!,"bed sections from the above listing, (E)dit the associated MAS ward",!,"relationship,"
W " or (B)ypass " W:'NURSOBED ! W "this prompt (A"_$S(NURSOBED:"/D/E",1:"")_"/B): "_$S(NURSOBED:"B",NURSNEW:"A",1:"B")_"// "
R X:DTIME S NURSX=$S('$T:"^",X'="":$S(X'?1L:X,1:$C($A(X)-32)),NURSOBED:"B",NURSNEW:"A",1:"B") Q:"^"[NURSX!(NURSX="A")!(NURSX="B")!((NURSX="D"!(NURSX="E"))&NURSOBED)
I NURSX?1"?".E W !?4,$C(7),"ANSWER WITH A IF YOU WOULD LIKE TO ADD MORE AMIS BED SECTIONS FOR",!?18,"THIS UNIT"
I W:NURSOBED ",",!?16,"D IF YOU WOULD LIKE TO DELETE AMIS BED SECTIONS FROM THE",!?18,"ABOVE LISTING,",!?16,"E IF YOU WOULD LIKE TO CHANGE THE ASSOCIATED MAS LISTING,"
I W !?13,"OR B IF YOU WOULD LIKE TO DO NOTHING AND BYPASS THIS PROMPT." G ASKB
W !?4,$C(7),"INVALID ENTRY, TYPE ? TO GET MORE HELP" G ASKB
;
ADDM ;
S DIC="^DIC(42,",DIC(0)="AEQ",DIC("A")="Select MAS ward to add: ",DIC("S")="I '$D(^NURSF(211.4,""C"",+Y,NURSWARD))" D DIC Q:+Y'>0
S DA(1)=NURSWARD,NURSMLT=3,X=+Y D ADD W !
G ADDM
DELM ;
W !,"Select the number",$S(OMAS>1:"(s)",1:"")," of the entries you wish to delete (1",$S(OMAS>1:"-"_OMAS,1:""),"): " R X:DTIME S:'$T X="^" S:X="^" NURSX="^" Q:"^"[X S NURSW=OMAS D VERIFY G:'NURSY DELM
S DA(1)=NURSWARD,DIK="^NURSF(211.4,DA(1),3," F NURSD=0:0 S NURSD=$O(NURSD(NURSD)) Q:NURSD'>0 S DA=$S($D(OMAS(NURSD)):+OMAS(NURSD),1:"") D:DA>0 ^DIK
Q
EDM ;
S DIC="^DIC(42,",DIC(0)="AEQ",DIC("A")="Select associated MAS ward: ",DIC("S")="I $D(^NURSF(211.4,""C"",+Y,NURSWARD))" D DIC Q:+Y'>0
S DA=$O(^NURSF(211.4,"C",+Y,NURSWARD,0)) Q:DA'>0
S DR="1 AMIS BED SECTION~;",DA(1)=NURSWARD,DIE="^NURSF(211.4,DA(1),3," D ^DIE I $D(Y) S NURSX="^" Q
W ! G EDM
ADDB ;
S DIC="^NURSF(213.3,",DIC(0)="AEQ",DIC("A")="Select AMIS bed section to add: ",DIC("S")="I '$D(^NURSF(211.4,""ABS"",+Y,NURSWARD,4))" D DIC Q:+Y'>0
S DA(1)=NURSWARD,NURSMLT=4,X=+Y D ADD W !
G ADDB
DELB ;
W !,"Select the number",$S(OBED>1:"(s)",1:"")," of the entries you wish to delete (1",$S(OBED>1:"-"_OBED,1:""),"): " R X:DTIME S:'$T X="^" S:X="^" NURSX="^" Q:"^"[X S NURSW=OBED D VERIFY G:'NURSY DELB
S DA(1)=NURSWARD,DIK="^NURSF(211.4,DA(1),4," F NURSD=0:0 S NURSD=$O(NURSD(NURSD)) Q:NURSD'>0 S DA=$S($D(OBED(NURSD)):+OBED(NURSD),1:"") D:DA>0 ^DIK,DMAS
Q
DIC D ^DIC S:$D(DTOUT)!$D(DUOUT) NURSX="^" K DTOUT,DUOUT,DIC Q
ADD ;
S NURSSBF=$S(NURSMLT=3:"211.41PI",1:"211.43PA") S:'$D(^NURSF(211.4,DA(1),NURSMLT,0)) ^(0)="^"_NURSSBF_"^0^0" L +^NURSF(211.4,DA(1),NURSMLT,0):0 Q:'$T
S NURSZN=^NURSF(211.4,DA(1),NURSMLT,0),DA=$P(NURSZN,"^",3)+1
S ^NURSF(211.4,DA(1),NURSMLT,DA,0)=X,^NURSF(211.4,DA(1),NURSMLT,0)=$P(NURSZN,"^",1,2)_"^"_DA_"^"_($P(NURSZN,"^",4)+1)
S DIK="^NURSF(211.4,DA(1),NURSMLT," D IX1^DIK K DIK
L -^NURSF(211.4,DA(1),NURSMLT,DA,0) Q
VERIFY ;
K NURSD S NURSY=2
F NURSZ(0)=1:1 S NURSZ=$P(X,",",NURSZ(0)) Q:NURSZ="" S NURSA=+NURSZ,NURSB=$S(+$P(NURSZ,"-",2):+$P(NURSZ,"-",2),1:NURSA) S:NURSA<1!(NURSB<1)!(NURSB>NURSW)!(NURSA>NURSW) NURSY=0 Q:'NURSY F NURSC=NURSA:1:NURSB S NURSD(NURSC)="" S NURSY=1
S:NURSY=2 NURSY=0 I 'NURSY W !?5,$C(7),"ANSWER WITH A NUMBER"_$S(NURSW=1:" ",1:", OR RANGE OF NUMBERS, ")_" WITHIN THE RANGE (1"_$S(NURSW=1:"",1:"-"_NURSW)_")"
Q
DMAS ;
S NURSB=$P(OBED(NURSD),"^",2)
S DIDEL=211.4,DIE="^NURSF(211.4,DA(1),3,",DR="1///@" F DA=0:0 S DA=$O(^NURSF(211.4,"ABS",+NURSB,DA(1),3,DA)) Q:DA'>0 D ^DIE
K DIDEL Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSALE0 3664 printed Oct 16, 2024@18:22:16 Page 2
NURSALE0 ;HIRMFO/RM-LOCATION FILE EDIT ROUTINE ;11/4/89
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
ASKB ;
+1 if 'NURSOBED
WRITE !!,"There are no AMIS bed sections associated with this Nursing unit."
+2 WRITE !,"Would you like to (A)dd new AMIS bed sections"
if NURSOBED
WRITE ", (D)elete existing AMIS",!,"bed sections from the above listing, (E)dit the associated MAS ward",!,"relationship,"
+3 WRITE " or (B)ypass "
if 'NURSOBED
WRITE !
WRITE "this prompt (A"_$SELECT(NURSOBED:"/D/E",1:"")_"/B): "_$SELECT(NURSOBED:"B",NURSNEW:"A",1:"B")_"// "
+4 READ X:DTIME
SET NURSX=$SELECT('$TEST:"^",X'="":$SELECT(X'?1L:X,1:$CHAR($ASCII(X)-32)),NURSOBED:"B",NURSNEW:"A",1:"B")
if "^"[NURSX!(NURSX="A")!(NURSX="B")!((NURSX="D"!(NURSX="E"))&NURSOBED)
QUIT
+5 IF NURSX?1"?".E
WRITE !?4,$CHAR(7),"ANSWER WITH A IF YOU WOULD LIKE TO ADD MORE AMIS BED SECTIONS FOR",!?18,"THIS UNIT"
+6 IF $TEST
if NURSOBED
WRITE ",",!?16,"D IF YOU WOULD LIKE TO DELETE AMIS BED SECTIONS FROM THE",!?18,"ABOVE LISTING,",!?16,"E IF YOU WOULD LIKE TO CHANGE THE ASSOCIATED MAS LISTING,"
+7 IF $TEST
WRITE !?13,"OR B IF YOU WOULD LIKE TO DO NOTHING AND BYPASS THIS PROMPT."
GOTO ASKB
+8 WRITE !?4,$CHAR(7),"INVALID ENTRY, TYPE ? TO GET MORE HELP"
GOTO ASKB
+9 ;
ADDM ;
+1 SET DIC="^DIC(42,"
SET DIC(0)="AEQ"
SET DIC("A")="Select MAS ward to add: "
SET DIC("S")="I '$D(^NURSF(211.4,""C"",+Y,NURSWARD))"
DO DIC
if +Y'>0
QUIT
+2 SET DA(1)=NURSWARD
SET NURSMLT=3
SET X=+Y
DO ADD
WRITE !
+3 GOTO ADDM
DELM ;
+1 WRITE !,"Select the number",$SELECT(OMAS>1:"(s)",1:"")," of the entries you wish to delete (1",$SELECT(OMAS>1:"-"_OMAS,1:""),"): "
READ X:DTIME
if '$TEST
SET X="^"
if X="^"
SET NURSX="^"
if "^"[X
QUIT
SET NURSW=OMAS
DO VERIFY
if 'NURSY
GOTO DELM
+2 SET DA(1)=NURSWARD
SET DIK="^NURSF(211.4,DA(1),3,"
FOR NURSD=0:0
SET NURSD=$ORDER(NURSD(NURSD))
if NURSD'>0
QUIT
SET DA=$SELECT($DATA(OMAS(NURSD)):+OMAS(NURSD),1:"")
if DA>0
DO ^DIK
+3 QUIT
EDM ;
+1 SET DIC="^DIC(42,"
SET DIC(0)="AEQ"
SET DIC("A")="Select associated MAS ward: "
SET DIC("S")="I $D(^NURSF(211.4,""C"",+Y,NURSWARD))"
DO DIC
if +Y'>0
QUIT
+2 SET DA=$ORDER(^NURSF(211.4,"C",+Y,NURSWARD,0))
if DA'>0
QUIT
+3 SET DR="1 AMIS BED SECTION~;"
SET DA(1)=NURSWARD
SET DIE="^NURSF(211.4,DA(1),3,"
DO ^DIE
IF $DATA(Y)
SET NURSX="^"
QUIT
+4 WRITE !
GOTO EDM
ADDB ;
+1 SET DIC="^NURSF(213.3,"
SET DIC(0)="AEQ"
SET DIC("A")="Select AMIS bed section to add: "
SET DIC("S")="I '$D(^NURSF(211.4,""ABS"",+Y,NURSWARD,4))"
DO DIC
if +Y'>0
QUIT
+2 SET DA(1)=NURSWARD
SET NURSMLT=4
SET X=+Y
DO ADD
WRITE !
+3 GOTO ADDB
DELB ;
+1 WRITE !,"Select the number",$SELECT(OBED>1:"(s)",1:"")," of the entries you wish to delete (1",$SELECT(OBED>1:"-"_OBED,1:""),"): "
READ X:DTIME
if '$TEST
SET X="^"
if X="^"
SET NURSX="^"
if "^"[X
QUIT
SET NURSW=OBED
DO VERIFY
if 'NURSY
GOTO DELB
+2 SET DA(1)=NURSWARD
SET DIK="^NURSF(211.4,DA(1),4,"
FOR NURSD=0:0
SET NURSD=$ORDER(NURSD(NURSD))
if NURSD'>0
QUIT
SET DA=$SELECT($DATA(OBED(NURSD)):+OBED(NURSD),1:"")
if DA>0
DO ^DIK
DO DMAS
+3 QUIT
DIC DO ^DIC
if $DATA(DTOUT)!$DATA(DUOUT)
SET NURSX="^"
KILL DTOUT,DUOUT,DIC
QUIT
ADD ;
+1 SET NURSSBF=$SELECT(NURSMLT=3:"211.41PI",1:"211.43PA")
if '$DATA(^NURSF(211.4,DA(1),NURSMLT,0))
SET ^(0)="^"_NURSSBF_"^0^0"
LOCK +^NURSF(211.4,DA(1),NURSMLT,0):0
if '$TEST
QUIT
+2 SET NURSZN=^NURSF(211.4,DA(1),NURSMLT,0)
SET DA=$PIECE(NURSZN,"^",3)+1
+3 SET ^NURSF(211.4,DA(1),NURSMLT,DA,0)=X
SET ^NURSF(211.4,DA(1),NURSMLT,0)=$PIECE(NURSZN,"^",1,2)_"^"_DA_"^"_($PIECE(NURSZN,"^",4)+1)
+4 SET DIK="^NURSF(211.4,DA(1),NURSMLT,"
DO IX1^DIK
KILL DIK
+5 LOCK -^NURSF(211.4,DA(1),NURSMLT,DA,0)
QUIT
VERIFY ;
+1 KILL NURSD
SET NURSY=2
+2 FOR NURSZ(0)=1:1
SET NURSZ=$PIECE(X,",",NURSZ(0))
if NURSZ=""
QUIT
SET NURSA=+NURSZ
SET NURSB=$SELECT(+$PIECE(NURSZ,"-",2):+$PIECE(NURSZ,"-",2),1:NURSA)
if NURSA<1!(NURSB<1)!(NURSB>NURSW)!(NURSA>NURSW)
SET NURSY=0
if 'NURSY
QUIT
FOR NURSC=NURSA:1:NURSB
SET NURSD(NURSC)=""
SET NURSY=1
+3 if NURSY=2
SET NURSY=0
IF 'NURSY
WRITE !?5,$CHAR(7),"ANSWER WITH A NUMBER"_$SELECT(NURSW=1:" ",1:", OR RANGE OF NUMBERS, ")_" WITHIN THE RANGE (1"_$SELECT(NURSW=1:"",1:"-"_NURSW)_")"
+4 QUIT
DMAS ;
+1 SET NURSB=$PIECE(OBED(NURSD),"^",2)
+2 SET DIDEL=211.4
SET DIE="^NURSF(211.4,DA(1),3,"
SET DR="1///@"
FOR DA=0:0
SET DA=$ORDER(^NURSF(211.4,"ABS",+NURSB,DA(1),3,DA))
if DA'>0
QUIT
DO ^DIE
+3 KILL DIDEL
QUIT
