- NURA9D11 ;HIRMFO/MD-SORT ROUTINE FOR NS BUDGETED/ACTUAL FTEE BY WARD ;8/23/96 12:05
- ;;4.0;NURSING SERVICE;**3,7,13,22**;Apr 25, 1997
- EN1 ; BUILD LOC-SER.CAT.-SPEC. SORT
- S NURNEN=3
- I 'NURHOSP D G Q
- .; BUILD SORT FROM NURSING "B" XREF
- .S NURSZ="" F S NURSZ=$O(NURSNLOC(NURSZ)) Q:NURSZ="" S NURSIEN=0 F S NURSIEN=$O(NURSNLOC(NURSZ,NURSIEN)) Q:NURSIEN'>0 S NUREQWRD=+$G(NURSNLOC(NURSZ,NURSIEN)) D:+NUREQWRD
- ..S NURNODE4=0 F S NURNODE4=$O(^NURSF(211.8,"B",NUREQWRD,NURNODE4)) Q:NURNODE4'>0 S NURNODE5=0 F S NURNODE5=$O(^NURSF(211.8,NURNODE4,1,NURNODE5)) Q:NURNODE5'>0 D CHK D:'SW
- ...S DA(1)=$S($D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)):$P(^(0),U,2),1:""),DA=$O(^NURSF(210,"B",DA(1),0)) I (+DA>0),'$D(^NURSF(210,"AC","R",+DA)) D CHKPOS^NURAAGS1 D:+NURNEN(1) SETVAR
- ...Q
- ..Q
- .Q
- D ACSORT,EN4^NURSAUTL:NURSZAP=7
- G Q
- EN2 ; SER.CAT-SPEC. SORT
- D ACSORT,EN4^NURSAUTL:NURSZAP=7
- Q K D0,DA,NURNEN,NLOCN,NNM,NPRI,NURSCATY,NSPEC,NPODA,NSPOSN,NURSZORT,NPWARD,NURNODE4,NUREQWRD,NURCAT,NURFLAG,NURSCAT
- Q
- ACSORT ; BUILD SORT FROM NURSING "AC" & "C" XREF
- S Z(1)="" F I=0:0 S Z(1)=$O(^NURSF(210,"AC",Z(1))) Q:Z(1)=""!(Z(1)="R") F DA=0:0 S DA=$O(^NURSF(210,"AC",Z(1),DA)) Q:DA'>0 I $D(^NURSF(210,DA,0)),+^(0) S DA(1)=+^(0) D
- .F NURNODE4=0:0 S NURNODE4=$O(^NURSF(211.8,"C",DA(1),NURNODE4)) Q:NURNODE4'>0 D CHK I 'SW F NURNODE5=0:0 S NURNODE5=$O(^NURSF(211.8,"C",DA(1),NURNODE4,NURNODE5)) Q:NURNODE5'>0 D CHKPOS^NURAAGS1 D:+NURNEN(1) SETVAR
- .Q
- Q
- SETVAR ; SET SUBSCRIPTS FOR GLOBAL SET
- S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP
- Q:'NURSZORT
- ; SET LOCATION VARIABLE NLOCN
- I NURNEN=3 D
- .S NLOCN=$S($D(^NURSF(211.8,NURNODE4,0)):$P(^(0),U),1:"")
- .I +NLOCN S NPWARD=NLOCN D EN7^NURSAUTL S NLOCN(1)=$S(NPWARD'="":$E(NPWARD,1,10),1:" BLANK")
- .Q
- ; SET FACILITY VARIABLE NURFAC(2),PRODUCT LINE VARIABLE NURPROG(2), AND
- ; CATEGORY VARIABLE NURSCATY
- D SETPROG^NURAAGS1,SETFAC^NURAAGS1 D:$G(NURNEN)=2 SETPOS^NURAAGS1 D:NURNEN=1!($G(NURNEN)=3) SETCAT^NURAAGS1
- I (NURNEN=1!(NURNEN=3)),$E($G(NURSCATY))="O",$P($G(NURSCATY),"O ",2)="" S NURSCATY="O"
- I NURMDSW,'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
- I NURPLSW,'$G(NURPROG),$G(NURPROG(1))'=$G(NURPROG(2)) Q
- I $G(NURNEN)=1!($G(NURNEN)=3),$S($E(NURSCATY)'="O":'$D(^TMP("NURSCAT",$J,NURSCATY)),$P($G(NURSCATY),"O ",2)'="":'$D(^TMP("NURSCAT",$J,$E(NURSCATY,3,99))),$P($G(NURSCATY),"O ",2)="":'$D(^TMP("NURSCAT",$J,"O")),1:0) Q
- I NURNEN=2 S NPODA=$O(^NURSF(211.3,"B",NSPOSN,"")) Q:NPODA=""!'$D(^NURSF(211.3,+NPODA,0)) I $G(NURSER)=0,$G(NPOS),$G(NPOS)'=NPODA Q
- I NURNEN=3,$G(NURHOSP)=0,'$D(NURSNLOC(NLOCN(1))) Q
- I NURPLSW S:NURPROG(2)="NURSING" NURPROG(2)=" NURSING"
- I $D(^VA(200,DA(1),0)),$P(^(0),U,1)'="" S NNM=$P(^(0),U,1)
- E S NNM=" BLANK"
- K NSPEC
- Q:$S('$D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)):1,NURSZAP<7:0,$D(NURSZLO($O(^NURSF(211.4,"B",+$P(^NURSF(211.8,NURNODE4,0),U),"")))):0,1:1) I $D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),$P(^(0),U,4)'="" S NSPEC=$P(^(0),U,4)
- I '$D(NSPEC) S NSPEC=" BLANK"
- I 'NSP,NSPC'=NSPEC Q
- ; BUILD TMP ARRAY
- W:$E(IOST)="C"&($R(100)) "." S:$G(NURSORT)="" NURSORT=1
- I NURNEN=3 D
- .N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,NSPEC))
- .I X="" S X=NURSORT,NURSORT=NURSORT+1 S ^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,NSPEC)=X
- .S ^TMP($J,"L1",X,NNM,NURNODE4,NURNODE5,DA)=""
- .Q
- I NURNEN=1 D
- .N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NURSCATY,NSPEC,DA,NURNODE4))
- .I X="" S X=NURSORT,NURSORT=NURSORT+1 S ^TMP($J,"L",NURFAC(2),NURPROG(2),NURSCATY,NSPEC,DA,NURNODE4)=X
- .S ^TMP($J,"L1",X,NNM,NURNODE5)=""
- .Q
- I NURNEN=2 D
- .N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NPRI,NSPOSN,NSPEC,DA,NURNODE4))
- .I X="" S X=NURSORT,NURSORT=NURSORT+1 S ^TMP($J,"L",NURFAC(2),NURPROG(2),NPRI,NSPOSN,NSPEC,DA,NURNODE4)=X
- .S ^TMP($J,"L1",X,NNM,NURNODE5)=""
- .Q
- Q
- CHK ;
- S Z=0,Z=+$O(^NURSF(211.4,"B",+$G(^NURSF(211.8,NURNODE4,0)),0)) S SW=$S('$G(Z):1,$P($G(^NURSF(211.4,Z,"I")),U)="I":1,1:0)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURA9D11 3994 printed Feb 18, 2025@23:45 Page 2
- NURA9D11 ;HIRMFO/MD-SORT ROUTINE FOR NS BUDGETED/ACTUAL FTEE BY WARD ;8/23/96 12:05
- +1 ;;4.0;NURSING SERVICE;**3,7,13,22**;Apr 25, 1997
- EN1 ; BUILD LOC-SER.CAT.-SPEC. SORT
- +1 SET NURNEN=3
- +2 IF 'NURHOSP
- Begin DoDot:1
- +3 ; BUILD SORT FROM NURSING "B" XREF
- +4 SET NURSZ=""
- FOR
- SET NURSZ=$ORDER(NURSNLOC(NURSZ))
- if NURSZ=""
- QUIT
- SET NURSIEN=0
- FOR
- SET NURSIEN=$ORDER(NURSNLOC(NURSZ,NURSIEN))
- if NURSIEN'>0
- QUIT
- SET NUREQWRD=+$GET(NURSNLOC(NURSZ,NURSIEN))
- if +NUREQWRD
- Begin DoDot:2
- +5 SET NURNODE4=0
- FOR
- SET NURNODE4=$ORDER(^NURSF(211.8,"B",NUREQWRD,NURNODE4))
- if NURNODE4'>0
- QUIT
- SET NURNODE5=0
- FOR
- SET NURNODE5=$ORDER(^NURSF(211.8,NURNODE4,1,NURNODE5))
- if NURNODE5'>0
- QUIT
- DO CHK
- if 'SW
- Begin DoDot:3
- +6 SET DA(1)=$SELECT($DATA(^NURSF(211.8,NURNODE4,1,NURNODE5,0)):$PIECE(^(0),U,2),1:"")
- SET DA=$ORDER(^NURSF(210,"B",DA(1),0))
- IF (+DA>0)
- IF '$DATA(^NURSF(210,"AC","R",+DA))
- DO CHKPOS^NURAAGS1
- if +NURNEN(1)
- DO SETVAR
- +7 QUIT
- End DoDot:3
- +8 QUIT
- End DoDot:2
- +9 QUIT
- End DoDot:1
- GOTO Q
- +10 DO ACSORT
- if NURSZAP=7
- DO EN4^NURSAUTL
- +11 GOTO Q
- EN2 ; SER.CAT-SPEC. SORT
- +1 DO ACSORT
- if NURSZAP=7
- DO EN4^NURSAUTL
- Q KILL D0,DA,NURNEN,NLOCN,NNM,NPRI,NURSCATY,NSPEC,NPODA,NSPOSN,NURSZORT,NPWARD,NURNODE4,NUREQWRD,NURCAT,NURFLAG,NURSCAT
- +1 QUIT
- ACSORT ; BUILD SORT FROM NURSING "AC" & "C" XREF
- +1 SET Z(1)=""
- FOR I=0:0
- SET Z(1)=$ORDER(^NURSF(210,"AC",Z(1)))
- if Z(1)=""!(Z(1)="R")
- QUIT
- FOR DA=0:0
- SET DA=$ORDER(^NURSF(210,"AC",Z(1),DA))
- if DA'>0
- QUIT
- IF $DATA(^NURSF(210,DA,0))
- IF +^(0)
- SET DA(1)=+^(0)
- Begin DoDot:1
- +2 FOR NURNODE4=0:0
- SET NURNODE4=$ORDER(^NURSF(211.8,"C",DA(1),NURNODE4))
- if NURNODE4'>0
- QUIT
- DO CHK
- IF 'SW
- FOR NURNODE5=0:0
- SET NURNODE5=$ORDER(^NURSF(211.8,"C",DA(1),NURNODE4,NURNODE5))
- if NURNODE5'>0
- QUIT
- DO CHKPOS^NURAAGS1
- if +NURNEN(1)
- DO SETVAR
- +3 QUIT
- End DoDot:1
- +4 QUIT
- SETVAR ; SET SUBSCRIPTS FOR GLOBAL SET
- +1 SET NURSZORT=1
- if NURSZAP>6
- DO EN3^NURSAUTL
- if NURSZORT&NURSZAP
- DO EN2^NURSAUTL
- +2 if 'NURSZORT
- QUIT
- +3 ; SET LOCATION VARIABLE NLOCN
- +4 IF NURNEN=3
- Begin DoDot:1
- +5 SET NLOCN=$SELECT($DATA(^NURSF(211.8,NURNODE4,0)):$PIECE(^(0),U),1:"")
- +6 IF +NLOCN
- SET NPWARD=NLOCN
- DO EN7^NURSAUTL
- SET NLOCN(1)=$SELECT(NPWARD'="":$EXTRACT(NPWARD,1,10),1:" BLANK")
- +7 QUIT
- End DoDot:1
- +8 ; SET FACILITY VARIABLE NURFAC(2),PRODUCT LINE VARIABLE NURPROG(2), AND
- +9 ; CATEGORY VARIABLE NURSCATY
- +10 DO SETPROG^NURAAGS1
- DO SETFAC^NURAAGS1
- if $GET(NURNEN)=2
- DO SETPOS^NURAAGS1
- if NURNEN=1!($GET(NURNEN)=3)
- DO SETCAT^NURAAGS1
- +11 IF (NURNEN=1!(NURNEN=3))
- IF $EXTRACT($GET(NURSCATY))="O"
- IF $PIECE($GET(NURSCATY),"O ",2)=""
- SET NURSCATY="O"
- +12 IF NURMDSW
- IF '$GET(NURFAC)
- IF $GET(NURFAC(1))'=$GET(NURFAC(2))
- QUIT
- +13 IF NURPLSW
- IF '$GET(NURPROG)
- IF $GET(NURPROG(1))'=$GET(NURPROG(2))
- QUIT
- +14 IF $GET(NURNEN)=1!($GET(NURNEN)=3)
- IF $SELECT($EXTRACT(NURSCATY)'="O":'$DATA(^TMP("NURSCAT",$JOB,NURSCATY)),$PIECE($GET(NURSCATY),"O ",2)'="":'$DATA(^TMP("NURSCAT",$JOB,$EXTRACT(NURSCATY,3,99))),$PIECE($GET(NURSCATY),"O ",2)="":'$DATA(^TMP("NURSCAT",$JOB,"O")),1:0)
- QUIT
- +15 IF NURNEN=2
- SET NPODA=$ORDER(^NURSF(211.3,"B",NSPOSN,""))
- if NPODA=""!'$DATA(^NURSF(211.3,+NPODA,0))
- QUIT
- IF $GET(NURSER)=0
- IF $GET(NPOS)
- IF $GET(NPOS)'=NPODA
- QUIT
- +16 IF NURNEN=3
- IF $GET(NURHOSP)=0
- IF '$DATA(NURSNLOC(NLOCN(1)))
- QUIT
- +17 IF NURPLSW
- if NURPROG(2)="NURSING"
- SET NURPROG(2)=" NURSING"
- +18 IF $DATA(^VA(200,DA(1),0))
- IF $PIECE(^(0),U,1)'=""
- SET NNM=$PIECE(^(0),U,1)
- +19 IF '$TEST
- SET NNM=" BLANK"
- +20 KILL NSPEC
- +21 if $SELECT('$DATA(^NURSF(211.8,NURNODE4,1,NURNODE5,0))
- QUIT
- IF $DATA(^NURSF(211.8,NURNODE4,1,NURNODE5,0))
- IF $PIECE(^(0),U,4)'=""
- SET NSPEC=$PIECE(^(0),U,4)
- +22 IF '$DATA(NSPEC)
- SET NSPEC=" BLANK"
- +23 IF 'NSP
- IF NSPC'=NSPEC
- QUIT
- +24 ; BUILD TMP ARRAY
- +25 if $EXTRACT(IOST)="C"&($RANDOM(100))
- WRITE "."
- if $GET(NURSORT)=""
- SET NURSORT=1
- +26 IF NURNEN=3
- Begin DoDot:1
- +27 NEW X
- SET X=$GET(^TMP($JOB,"L",NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,NSPEC))
- +28 IF X=""
- SET X=NURSORT
- SET NURSORT=NURSORT+1
- SET ^TMP($JOB,"L",NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,NSPEC)=X
- +29 SET ^TMP($JOB,"L1",X,NNM,NURNODE4,NURNODE5,DA)=""
- +30 QUIT
- End DoDot:1
- +31 IF NURNEN=1
- Begin DoDot:1
- +32 NEW X
- SET X=$GET(^TMP($JOB,"L",NURFAC(2),NURPROG(2),NURSCATY,NSPEC,DA,NURNODE4))
- +33 IF X=""
- SET X=NURSORT
- SET NURSORT=NURSORT+1
- SET ^TMP($JOB,"L",NURFAC(2),NURPROG(2),NURSCATY,NSPEC,DA,NURNODE4)=X
- +34 SET ^TMP($JOB,"L1",X,NNM,NURNODE5)=""
- +35 QUIT
- End DoDot:1
- +36 IF NURNEN=2
- Begin DoDot:1
- +37 NEW X
- SET X=$GET(^TMP($JOB,"L",NURFAC(2),NURPROG(2),NPRI,NSPOSN,NSPEC,DA,NURNODE4))
- +38 IF X=""
- SET X=NURSORT
- SET NURSORT=NURSORT+1
- SET ^TMP($JOB,"L",NURFAC(2),NURPROG(2),NPRI,NSPOSN,NSPEC,DA,NURNODE4)=X
- +39 SET ^TMP($JOB,"L1",X,NNM,NURNODE5)=""
- +40 QUIT
- End DoDot:1
- +41 QUIT
- CHK ;
- +1 SET Z=0
- SET Z=+$ORDER(^NURSF(211.4,"B",+$GET(^NURSF(211.8,NURNODE4,0)),0))
- SET SW=$SELECT('$GET(Z):1,$PIECE($GET(^NURSF(211.4,Z,"I")),U)="I":1,1:0)
- +2 QUIT
