- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSBPO 2286 printed Feb 18, 2025@23:48:07 Page 2
- 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
