[613] | 1 | NURSBPO ;HIRMFO/MD,FT-NURS POSITION CONTROL FILE BUDGETED FTEE EDIT ;5/14/01 13:47
|
---|
| 2 | ;;4.0;NURSING SERVICE;**2,16,35**;Apr 25, 1997
|
---|
| 3 | S NUROUT=0,NLOC=NURSWARD(0),NL1=NURSWARD
|
---|
| 4 | SPOS ;
|
---|
| 5 | S DIC=211.3,DIC(0)="AEMQZ",DIC("A")="Select SERVICE POSITION: " D ^DIC K DIC I +Y'>0 S NUROUT=1 G QUIT
|
---|
| 6 | S NURSCAT=$P($G(Y(0)),U,5),NURSPOS=+Y,DA(1)=$O(^NURSF(211.8,"AA",NLOC,NURSCAT,0))
|
---|
| 7 | I '$D(^NURSF(211.8,"AA",+NLOC,NURSCAT)) D NEWASK G:NUROUT QUIT
|
---|
| 8 | S DA(1)=$O(^NURSF(211.8,"AA",+NLOC,NURSCAT,0)),DA=$O(^NURSF(211.8,DA(1),2,"B",+NURSPOS,0))
|
---|
| 9 | I +DA'>0 D
|
---|
| 10 | . S NPWARD=NL1 D EN6^NURSAUTL W $C(7),!,?3,"ARE YOU ADDING "_Y(0,0)_" AS A NEW SERVICE POSITION FOR "_NPWARD S %=1 D YN^DICN I %'=1 S NUROUT=1 Q
|
---|
| 11 | . S:$G(^NURSF(211.8,DA(1),2,0))="" ^(0)="^211.83P^^" S DIC="^NURSF(211.8,DA(1),2,",DIC(0)="L",X=+NURSPOS,DIC("DR")=".05///^S X=$$NPRI^NURSBPO(NURSPOS);1" K DD D FILE^DICN K DIC
|
---|
| 12 | . Q
|
---|
| 13 | G:$G(NUROUT) QUIT
|
---|
| 14 | I +DA>0 S DIE="^NURSF(211.8,DA(1),2,",DR=".01//;.05///^S X=$$NPRI^NURSBPO(NURSPOS);1" D ^DIE W !
|
---|
| 15 | G SPOS
|
---|
| 16 | QUIT D ^NURSKILL
|
---|
| 17 | Q
|
---|
| 18 | NEWASK ; Add an entry to the NURS POSITION CONTROL file (#211.8)
|
---|
| 19 | N X,Y
|
---|
| 20 | S NURCAT=$S(NURSCAT="R":"RN",NURSCAT="L":"LPN",NURSCAT="N":"NA",NURSCAT="C":"CLERICAL",NURSCAT="O":"OTHER",NURSCAT="A":"ADMIN OFFICER",NURSCAT="S":"SUMMER EMPLOYEE",1:""),NPWARD=NL1 D EN6^NURSAUTL
|
---|
| 21 | W $C(7),!,"There is no "_NURCAT_" entry for "_NPWARD_".",!,"Would you like to add it" S %=1 D YN^DICN I %'=1 S NUROUT=1 Q
|
---|
| 22 | S DIC="^NURSF(211.8,",DIC(0)="LZ",DIC("S")="I $P(^(0),U,2)=NURSCAT",X=$P(^NURSF(211.4,NL1,0),"^")
|
---|
| 23 | S DIC("DR")=".02///^S X=NURSCAT" K DD D FILE^DICN K DIC
|
---|
| 24 | S ^NURSF(211.8,+Y,1,0)="^211.82ID^^"
|
---|
| 25 | Q
|
---|
| 26 | NPRI(NPOS) ; Calculate priority sequence based on the service position.
|
---|
| 27 | N NPRISEQ
|
---|
| 28 | S NPRISEQ=+$P($G(^NURSF(211.3,NPOS,0)),U,3)
|
---|
| 29 | Q NPRISEQ
|
---|
| 30 | DUPCHK(DA,X) ; Check if ABBREVIATION value is already used in FILE 211.3.
|
---|
| 31 | ; Called from FILE 211.3, ABBREVIATION field (#.01) - ^DD(211.3,.01,0)
|
---|
| 32 | ; Returns 1 - the value of X is already being used by another entry
|
---|
| 33 | ; 0 - the value of X is NOT being used by another entry
|
---|
| 34 | ; Requires DA - IEN of the FILE 211.3 entry
|
---|
| 35 | ; X = .01 field value
|
---|
| 36 | N NURFLAG,NURLOOP
|
---|
| 37 | S (NURFLAG,NURLOOP)=0
|
---|
| 38 | F S NURLOOP=$O(^NURSF(211.3,"B",X,NURLOOP)) Q:'NURLOOP D
|
---|
| 39 | .I NURLOOP'=DA S NURFLAG=1
|
---|
| 40 | .Q
|
---|
| 41 | Q NURFLAG
|
---|