NURSBPO.m

NURSBPO ;HIRMFO/MD,FT-NURS POSITION CONTROL FILE BUDGETED FTEE EDIT ;5/14/01  13:47

 ;;4.0;NURSING SERVICE;**2,16,35**;Apr 25, 1997

 S NUROUT=0,NLOC=NURSWARD(0),NL1=NURSWARD

SPOS ;

 S DIC=211.3,DIC(0)="AEMQZ",DIC("A")="Select SERVICE POSITION: " D ^DIC K DIC I +Y'>0 S NUROUT=1 G QUIT

 S NURSCAT=$P($G(Y(0)),U,5),NURSPOS=+Y,DA(1)=$O(^NURSF(211.8,"AA",NLOC,NURSCAT,0))

 I '$D(^NURSF(211.8,"AA",+NLOC,NURSCAT)) D NEWASK G:NUROUT QUIT

 S DA(1)=$O(^NURSF(211.8,"AA",+NLOC,NURSCAT,0)),DA=$O(^NURSF(211.8,DA(1),2,"B",+NURSPOS,0))

 I +DA'>0 D

 .  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

 .  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

 .  Q

 G:$G(NUROUT) QUIT

 I +DA>0 S DIE="^NURSF(211.8,DA(1),2,",DR=".01//;.05///^S X=$$NPRI^NURSBPO(NURSPOS);1" D ^DIE W !

 G SPOS

QUIT D ^NURSKILL

 Q

NEWASK ; Add an entry to the NURS POSITION CONTROL file (#211.8)

 N X,Y

 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

 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

 S DIC="^NURSF(211.8,",DIC(0)="LZ",DIC("S")="I $P(^(0),U,2)=NURSCAT",X=$P(^NURSF(211.4,NL1,0),"^")

 S DIC("DR")=".02///^S X=NURSCAT" K DD D FILE^DICN K DIC

 S ^NURSF(211.8,+Y,1,0)="^211.82ID^^"

 Q

NPRI(NPOS) ; Calculate priority sequence based on the service position.

 N NPRISEQ

 S NPRISEQ=+$P($G(^NURSF(211.3,NPOS,0)),U,3)

 Q NPRISEQ

DUPCHK(DA,X) ; Check if ABBREVIATION value is already used in FILE 211.3.

 ; Called from FILE 211.3, ABBREVIATION field (#.01) - ^DD(211.3,.01,0)

 ; Returns 1 - the value of X is already being used by another entry

 ;         0 - the value of X is NOT being used by another entry

 ; Requires DA - IEN of the FILE 211.3 entry

 ;           X = .01 field value

 N NURFLAG,NURLOOP

 S (NURFLAG,NURLOOP)=0

 F  S NURLOOP=$O(^NURSF(211.3,"B",X,NURLOOP)) Q:'NURLOOP  D

 .I NURLOOP'=DA S NURFLAG=1

 .Q

 Q NURFLAG

NURSBPO   ;HIRMFO/MD,FT-NURS POSITION CONTROL FILE BUDGETED FTEE EDIT ;5/14/01  13:47

 +1       ;;4.0;NURSING SERVICE;**2,16,35**;Apr 25, 1997

 +2        SET NUROUT=0

           SET NLOC=NURSWARD(0)

           SET NL1=NURSWARD

SPOS      ;

 +1        SET DIC=211.3

           SET DIC(0)="AEMQZ"

           SET DIC("A")="Select SERVICE POSITION: "

           DO ^DIC

           KILL DIC

           IF +Y'>0

               SET NUROUT=1

               GOTO QUIT

 +2        SET NURSCAT=$PIECE($GET(Y(0)),U,5)

           SET NURSPOS=+Y

           SET DA(1)=$ORDER(^NURSF(211.8,"AA",NLOC,NURSCAT,0))

 +3        IF '$DATA(^NURSF(211.8,"AA",+NLOC,NURSCAT))

               DO NEWASK

               IF NUROUT

                   GOTO QUIT

 +4        SET DA(1)=$ORDER(^NURSF(211.8,"AA",+NLOC,NURSCAT,0))

           SET DA=$ORDER(^NURSF(211.8,DA(1),2,"B",+NURSPOS,0))

 +5        IF +DA'>0

               Begin DoDot:1

 +6                SET NPWARD=NL1

                   DO EN6^NURSAUTL

                   WRITE $CHAR(7),!,?3,"ARE YOU ADDING "_Y(0,0)_" AS A NEW SERVICE POSITION FOR "_NPWARD

                   SET %=1

                   DO YN^DICN

                   IF %'=1

                       SET NUROUT=1

                       QUIT 

 +7                IF $GET(^NURSF(211.8,DA(1),2,0))=""

                       SET ^(0)="^211.83P^^"

                   SET DIC="^NURSF(211.8,DA(1),2,"

                   SET DIC(0)="L"

                   SET X=+NURSPOS

                   SET DIC("DR")=".05///^S X=$$NPRI^NURSBPO(NURSPOS);1"

                   KILL DD

                   DO FILE^DICN

                   KILL DIC

 +8                QUIT 

               End DoDot:1

 +9        IF $GET(NUROUT)

               GOTO QUIT

 +10       IF +DA>0

               SET DIE="^NURSF(211.8,DA(1),2,"

               SET DR=".01//;.05///^S X=$$NPRI^NURSBPO(NURSPOS);1"

               DO ^DIE

               WRITE !

 +11       GOTO SPOS

QUIT       DO ^NURSKILL

 +1        QUIT 

NEWASK    ; Add an entry to the NURS POSITION CONTROL file (#211.8)

 +1        NEW X,Y

 +2        SET NURCAT=$SELECT(NURSCAT="R":"RN",NURSCAT="L":"LPN",NURSCAT="N":"NA",NURSCAT="C":"CLERICAL",NURSCAT="O":"OTHER",NURSCAT="A":"ADMIN OFFICER",NURSCAT="S":"SUMMER EMPLOYEE",1:"")

           SET NPWARD=NL1

           DO EN6^NURSAUTL

 +3        WRITE $CHAR(7),!,"There is no "_NURCAT_" entry for "_NPWARD_".",!,"Would you like to add it"

           SET %=1

           DO YN^DICN

           IF %'=1

               SET NUROUT=1

               QUIT 

 +4        SET DIC="^NURSF(211.8,"

           SET DIC(0)="LZ"

           SET DIC("S")="I $P(^(0),U,2)=NURSCAT"

           SET X=$PIECE(^NURSF(211.4,NL1,0),"^")

 +5        SET DIC("DR")=".02///^S X=NURSCAT"

           KILL DD

           DO FILE^DICN

           KILL DIC

 +6        SET ^NURSF(211.8,+Y,1,0)="^211.82ID^^"

 +7        QUIT 

NPRI(NPOS) ; Calculate priority sequence based on the service position.

 +1        NEW NPRISEQ

 +2        SET NPRISEQ=+$PIECE($GET(^NURSF(211.3,NPOS,0)),U,3)

 +3        QUIT NPRISEQ

DUPCHK(DA,X) ; Check if ABBREVIATION value is already used in FILE 211.3.

 +1       ; Called from FILE 211.3, ABBREVIATION field (#.01) - ^DD(211.3,.01,0)

 +2       ; Returns 1 - the value of X is already being used by another entry

 +3       ;         0 - the value of X is NOT being used by another entry

 +4       ; Requires DA - IEN of the FILE 211.3 entry

 +5       ;           X = .01 field value

 +6        NEW NURFLAG,NURLOOP

 +7        SET (NURFLAG,NURLOOP)=0

 +8        FOR 

               SET NURLOOP=$ORDER(^NURSF(211.3,"B",X,NURLOOP))

               IF 'NURLOOP

                   QUIT 

               Begin DoDot:1

 +9                IF NURLOOP'=DA

                       SET NURFLAG=1

 +10               QUIT 

               End DoDot:1

 +11       QUIT NURFLAG