- 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 Feb 18, 2025@23:47:56 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
