source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURSALE0.m@ 1696

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