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

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1NURSALE0 ;HIRMFO/RM-LOCATION FILE EDIT ROUTINE ;11/4/89
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3ASKB ;
4 W:'NURSOBED !!,"There are no AMIS bed sections associated with this Nursing unit."
5 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,"
6 W " or (B)ypass " W:'NURSOBED ! W "this prompt (A"_$S(NURSOBED:"/D/E",1:"")_"/B): "_$S(NURSOBED:"B",NURSNEW:"A",1:"B")_"// "
7 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)
8 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"
9 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,"
10 I W !?13,"OR B IF YOU WOULD LIKE TO DO NOTHING AND BYPASS THIS PROMPT." G ASKB
11 W !?4,$C(7),"INVALID ENTRY, TYPE ? TO GET MORE HELP" G ASKB
12 ;
13ADDM ;
14 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
15 S DA(1)=NURSWARD,NURSMLT=3,X=+Y D ADD W !
16 G ADDM
17DELM ;
18 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
19 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
20 Q
21EDM ;
22 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
23 S DA=$O(^NURSF(211.4,"C",+Y,NURSWARD,0)) Q:DA'>0
24 S DR="1 AMIS BED SECTION~;",DA(1)=NURSWARD,DIE="^NURSF(211.4,DA(1),3," D ^DIE I $D(Y) S NURSX="^" Q
25 W ! G EDM
26ADDB ;
27 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
28 S DA(1)=NURSWARD,NURSMLT=4,X=+Y D ADD W !
29 G ADDB
30DELB ;
31 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
32 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
33 Q
34DIC D ^DIC S:$D(DTOUT)!$D(DUOUT) NURSX="^" K DTOUT,DUOUT,DIC Q
35ADD ;
36 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
37 S NURSZN=^NURSF(211.4,DA(1),NURSMLT,0),DA=$P(NURSZN,"^",3)+1
38 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)
39 S DIK="^NURSF(211.4,DA(1),NURSMLT," D IX1^DIK K DIK
40 L -^NURSF(211.4,DA(1),NURSMLT,DA,0) Q
41VERIFY ;
42 K NURSD S NURSY=2
43 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
44 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)_")"
45 Q
46DMAS ;
47 S NURSB=$P(OBED(NURSD),"^",2)
48 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
49 K DIDEL Q
Note: See TracBrowser for help on using the repository browser.