- NURAGEN2 ;HIRMFO/JH/MD-GENERIC REPORT GENERATOR FOR ADMIN. part 2 ;MAR 95
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- ;This is a continuation of routine NURAGEN1.
- ;
- F1 S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)),NURSX=0 I NURSORT F S NURSX=$O(^TMP($J,"L1",NURSORT,NPC5,NPC6,NURSX)) Q:NURSX'>0 S ^TMP("NURA",$J,NURFAC,NURPROG,NPC6,NURSX,NURSORT)=""
- Q
- F2 S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)),NURSX=0 I NURSORT F S NURSX=$O(^TMP($J,"L1",NURSORT,NPC5,NPC6,NPC7,NURSX)) Q:NURSX'>0 S ^TMP("NURA",$J,NURFAC,NURPROG,NPC7,NURSX,NURSORT)=""
- Q
- F3 S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)),NURSX=0 I NURSORT F S NURSX=$O(^TMP($J,"L1",NURSORT,NPC5,NPC6,NURSX)) Q:NURSX'>0 S ^TMP("NURA",$J,NURFAC,NURPROG,NPC6,NPC4,NURSX)=""
- Q
- F4 S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)),NURSX=0 I NURSORT F S NURSX=$O(^TMP($J,"L1",NURSORT,NPC5,NPC6,NPC7,NURSX)) Q:NURSX'>0 S ^TMP("NURA",$J,NURFAC,NURPROG,NPC7,NPC5,NURSX)=""
- Q
- F5 S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)),NURSX=0 I NURSORT F S NURSX=$O(^TMP($J,"L1",NURSORT,NPC5,NPC6,NPC7,NURSX)) Q:NURSX'>0 S ^TMP("NURA",$J,NURFAC,NURPROG,NPC7,NURSX,NURSORT)=""
- Q
- F6 S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)),NURSX=0 I NURSORT F S NURSX=$O(^TMP($J,"L1",NURSORT,NPC5,NPC6,NPC7,NPC8,NURSX)) Q:NURSX'>0 S ^TMP("NURA",$J,NURFAC,NURPROG,NPC8,NURSX,NURSORT)=""
- Q
- F7 S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)),NURSX=0 I NURSORT F S NURSX=$O(^TMP($J,"L1",NURSORT,NPC5,NURSX)) Q:NURSX'>0 S ^TMP("NURA",$J,NURFAC,NURPROG,NPC5,NURSX,NURSORT)=""
- Q
- F8 S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)),NURSX=0 I NURSORT F S NURSX=$O(^TMP($J,"L1",NURSORT,NPC5,NPC6,NURSX)) Q:NURSX'>0 S ^TMP("NURA",$J,NURFAC,NURPROG,NPC6,NURSX,NURSORT)=""
- Q
- F9 S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)),NURSX=0 I NURSORT F S NURSX=$O(^TMP($J,"L1",NURSORT,NPC5,NURSX)) Q:NURSX'>0 S ^TMP("NURA",$J,NURFAC,NURPROG,NPC5,NPC3,NURSX)=""
- Q
- F10 S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)),NURSX=0 I NURSORT F S NURSX=$O(^TMP($J,"L1",NURSORT,NPC5,NPC6,NURSX)) Q:NURSX'>0 S ^TMP("NURA",$J,NURFAC,NURPROG,NPC6,NPC4,NURSX)=""
- Q
- F11 S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)),NURSX=0 I NURSORT F S NURSX=$O(^TMP($J,"L1",NURSORT,NPC5,NPC6,NPC7,NURSX)) Q:NURSX'>0 S ^TMP("NURA",$J,NURFAC,NURPROG,NPC7,NURSX,NURSORT)=""
- Q
- NURA ;SET ^TMP("NURA",$J) FOR PERSON AND ASSIGNMENT COUNT
- K ^TMP("NURA",$J) S (NURSORT,NURSORT(1))=0
- F S NURSORT=$O(^TMP($J,"L1",NURSORT)) Q:NURSORT'>0 S N="" F S N=$O(^TMP($J,"L1",NURSORT,N)) Q:N="" S N(1)="" F S N(1)=$O(^TMP($J,"L1",NURSORT,N,N(1))) Q:N(1)="" S N(2)="" F S N(2)=$O(^TMP($J,"L1",NURSORT,N,N(1),N(2))) Q:N(2)="" D
- .I NURSORT(2)>2 S N(3)="" F S N(3)=$O(^TMP($J,"L1",NURSORT,N,N(1),N(2),N(3))) Q:N(3)="" D
- ..I NURSORT(2)=3 D GLOB
- ..S N(4)="" F S N(4)=$O(^TMP($J,"L1",NURSORT,N,N(1),N(2),N(3),N(4))) Q:N(4)="" D
- ...I NURSORT(2)=4 D GLOB
- ...E S N(5)="" F S N(5)=$O(^TMP($J,"L1",NURSORT,N,N(1),N(2),N(3),N(4),N(5))) Q:N(5)="" D GLOB
- .I NURSORT(2)=2 D GLOB
- K N Q
- GLOB ;S ^TMP("NURA",$J) FOR ASSIGNMENT AND PERSON COUNTS
- I NURROU=7!(NURROU=18) S ^TMP("NURA",$J,@NURSORT(3),N(3)_"-"_N(4))="" Q
- I NURROU=8 S ^TMP("NURA",$J,@NURSORT(3),N(4)_"-"_N(5))="" Q
- I NURROU=17 S ^TMP("NURA",$J,@NURSORT(3),N(2)_"-"_N(3))="" Q
- S NURSORT(1)=NURSORT(1)+1,^TMP("NURA",$J," BLANK"," BLANK",@NURSORT(3),NURSORT(1),NURSORT)=""
- Q
- GENDER ;TOTAL COUNTS FOR GENDER REPORTS
- K ^TMP("NURA",$J) S NURFAC="" F S NURFAC=$O(^TMP($J,"L",NURFAC)) Q:NURFAC="" S NURPROG="" F S NURPROG=$O(^TMP($J,"L",NURFAC,NURPROG)) Q:NURPROG="" S NL="" F S NL=$O(^TMP($J,"L",NURFAC,NURPROG,NL)) Q:NL="" D
- . S NL(1)="" F S NL(1)=$O(^TMP($J,"L",NURFAC,NURPROG,NL,NL(1))) Q:NL(1)="" S NL(2)="" F S NL(2)=$O(^TMP($J,"L",NURFAC,NURPROG,NL,NL(1),NL(2))) Q:NL(2)="" S NURSORT=^TMP($J,"L",NURFAC,NURPROG,NL,NL(1),NL(2)) D:NURSORT L1
- Q
- L1 S NL1="" F S NL1=$O(^TMP($J,"L1",NURSORT,NL1)) Q:NL1="" S NL1(1)="" F S NL1(1)=$O(^TMP($J,"L1",NURSORT,NL1,NL1(1))) Q:NL1(1)="" S NL1(2)="" F S NL1(2)=$O(^TMP($J,"L1",NURSORT,NL1,NL1(1),NL1(2))) Q:NL1(2)="" D
- .I NURSORT(2)=3 S NL1(3)="" F S NL1(3)=$O(^TMP($J,"L1",NURSORT,NL1,NL1(1),NL1(2),NL1(3))) Q:NL1(3)="" D GLOB1
- .E D GLOB1
- Q
- GLOB1 S NURSORT(1)=NURSORT(1)+1,^TMP("NURA",$J,@NURSORT(3),@NURSORT(4),NURSORT(1))=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAGEN2 4403 printed Jan 18, 2025@03:20:34 Page 2
- NURAGEN2 ;HIRMFO/JH/MD-GENERIC REPORT GENERATOR FOR ADMIN. part 2 ;MAR 95
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- +2 ;This is a continuation of routine NURAGEN1.
- +3 ;
- F1 SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4))
- SET NURSX=0
- IF NURSORT
- FOR
- SET NURSX=$ORDER(^TMP($JOB,"L1",NURSORT,NPC5,NPC6,NURSX))
- if NURSX'>0
- QUIT
- SET ^TMP("NURA",$JOB,NURFAC,NURPROG,NPC6,NURSX,NURSORT)=""
- +1 QUIT
- F2 SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4))
- SET NURSX=0
- IF NURSORT
- FOR
- SET NURSX=$ORDER(^TMP($JOB,"L1",NURSORT,NPC5,NPC6,NPC7,NURSX))
- if NURSX'>0
- QUIT
- SET ^TMP("NURA",$JOB,NURFAC,NURPROG,NPC7,NURSX,NURSORT)=""
- +1 QUIT
- F3 SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4))
- SET NURSX=0
- IF NURSORT
- FOR
- SET NURSX=$ORDER(^TMP($JOB,"L1",NURSORT,NPC5,NPC6,NURSX))
- if NURSX'>0
- QUIT
- SET ^TMP("NURA",$JOB,NURFAC,NURPROG,NPC6,NPC4,NURSX)=""
- +1 QUIT
- F4 SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4))
- SET NURSX=0
- IF NURSORT
- FOR
- SET NURSX=$ORDER(^TMP($JOB,"L1",NURSORT,NPC5,NPC6,NPC7,NURSX))
- if NURSX'>0
- QUIT
- SET ^TMP("NURA",$JOB,NURFAC,NURPROG,NPC7,NPC5,NURSX)=""
- +1 QUIT
- F5 SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4))
- SET NURSX=0
- IF NURSORT
- FOR
- SET NURSX=$ORDER(^TMP($JOB,"L1",NURSORT,NPC5,NPC6,NPC7,NURSX))
- if NURSX'>0
- QUIT
- SET ^TMP("NURA",$JOB,NURFAC,NURPROG,NPC7,NURSX,NURSORT)=""
- +1 QUIT
- F6 SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4))
- SET NURSX=0
- IF NURSORT
- FOR
- SET NURSX=$ORDER(^TMP($JOB,"L1",NURSORT,NPC5,NPC6,NPC7,NPC8,NURSX))
- if NURSX'>0
- QUIT
- SET ^TMP("NURA",$JOB,NURFAC,NURPROG,NPC8,NURSX,NURSORT)=""
- +1 QUIT
- F7 SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4))
- SET NURSX=0
- IF NURSORT
- FOR
- SET NURSX=$ORDER(^TMP($JOB,"L1",NURSORT,NPC5,NURSX))
- if NURSX'>0
- QUIT
- SET ^TMP("NURA",$JOB,NURFAC,NURPROG,NPC5,NURSX,NURSORT)=""
- +1 QUIT
- F8 SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4))
- SET NURSX=0
- IF NURSORT
- FOR
- SET NURSX=$ORDER(^TMP($JOB,"L1",NURSORT,NPC5,NPC6,NURSX))
- if NURSX'>0
- QUIT
- SET ^TMP("NURA",$JOB,NURFAC,NURPROG,NPC6,NURSX,NURSORT)=""
- +1 QUIT
- F9 SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4))
- SET NURSX=0
- IF NURSORT
- FOR
- SET NURSX=$ORDER(^TMP($JOB,"L1",NURSORT,NPC5,NURSX))
- if NURSX'>0
- QUIT
- SET ^TMP("NURA",$JOB,NURFAC,NURPROG,NPC5,NPC3,NURSX)=""
- +1 QUIT
- F10 SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4))
- SET NURSX=0
- IF NURSORT
- FOR
- SET NURSX=$ORDER(^TMP($JOB,"L1",NURSORT,NPC5,NPC6,NURSX))
- if NURSX'>0
- QUIT
- SET ^TMP("NURA",$JOB,NURFAC,NURPROG,NPC6,NPC4,NURSX)=""
- +1 QUIT
- F11 SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4))
- SET NURSX=0
- IF NURSORT
- FOR
- SET NURSX=$ORDER(^TMP($JOB,"L1",NURSORT,NPC5,NPC6,NPC7,NURSX))
- if NURSX'>0
- QUIT
- SET ^TMP("NURA",$JOB,NURFAC,NURPROG,NPC7,NURSX,NURSORT)=""
- +1 QUIT
- NURA ;SET ^TMP("NURA",$J) FOR PERSON AND ASSIGNMENT COUNT
- +1 KILL ^TMP("NURA",$JOB)
- SET (NURSORT,NURSORT(1))=0
- +2 FOR
- SET NURSORT=$ORDER(^TMP($JOB,"L1",NURSORT))
- if NURSORT'>0
- QUIT
- SET N=""
- FOR
- SET N=$ORDER(^TMP($JOB,"L1",NURSORT,N))
- if N=""
- QUIT
- SET N(1)=""
- FOR
- SET N(1)=$ORDER(^TMP($JOB,"L1",NURSORT,N,N(1)))
- if N(1)=""
- QUIT
- SET N(2)=""
- FOR
- SET N(2)=$ORDER(^TMP($JOB,"L1",NURSORT,N,N(1),N(2)))
- if N(2)=""
- QUIT
- Begin DoDot:1
- +3 IF NURSORT(2)>2
- SET N(3)=""
- FOR
- SET N(3)=$ORDER(^TMP($JOB,"L1",NURSORT,N,N(1),N(2),N(3)))
- if N(3)=""
- QUIT
- Begin DoDot:2
- +4 IF NURSORT(2)=3
- DO GLOB
- +5 SET N(4)=""
- FOR
- SET N(4)=$ORDER(^TMP($JOB,"L1",NURSORT,N,N(1),N(2),N(3),N(4)))
- if N(4)=""
- QUIT
- Begin DoDot:3
- +6 IF NURSORT(2)=4
- DO GLOB
- +7 IF '$TEST
- SET N(5)=""
- FOR
- SET N(5)=$ORDER(^TMP($JOB,"L1",NURSORT,N,N(1),N(2),N(3),N(4),N(5)))
- if N(5)=""
- QUIT
- DO GLOB
- End DoDot:3
- End DoDot:2
- +8 IF NURSORT(2)=2
- DO GLOB
- End DoDot:1
- +9 KILL N
- QUIT
- GLOB ;S ^TMP("NURA",$J) FOR ASSIGNMENT AND PERSON COUNTS
- +1 IF NURROU=7!(NURROU=18)
- SET ^TMP("NURA",$JOB,@NURSORT(3),N(3)_"-"_N(4))=""
- QUIT
- +2 IF NURROU=8
- SET ^TMP("NURA",$JOB,@NURSORT(3),N(4)_"-"_N(5))=""
- QUIT
- +3 IF NURROU=17
- SET ^TMP("NURA",$JOB,@NURSORT(3),N(2)_"-"_N(3))=""
- QUIT
- +4 SET NURSORT(1)=NURSORT(1)+1
- SET ^TMP("NURA",$JOB," BLANK"," BLANK",@NURSORT(3),NURSORT(1),NURSORT)=""
- +5 QUIT
- GENDER ;TOTAL COUNTS FOR GENDER REPORTS
- +1 KILL ^TMP("NURA",$JOB)
- SET NURFAC=""
- FOR
- SET NURFAC=$ORDER(^TMP($JOB,"L",NURFAC))
- if NURFAC=""
- QUIT
- SET NURPROG=""
- FOR
- SET NURPROG=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG))
- if NURPROG=""
- QUIT
- SET NL=""
- FOR
- SET NL=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NL))
- if NL=""
- QUIT
- Begin DoDot:1
- +2 SET NL(1)=""
- FOR
- SET NL(1)=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NL,NL(1)))
- if NL(1)=""
- QUIT
- SET NL(2)=""
- FOR
- SET NL(2)=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NL,NL(1),NL(2)))
- if NL(2)=""
- QUIT
- SET NURSORT=^TMP($JOB,"L",NURFAC,NURPROG,NL,NL(1),NL(2))
- if NURSORT
- DO L1
- End DoDot:1
- +3 QUIT
- L1 SET NL1=""
- FOR
- SET NL1=$ORDER(^TMP($JOB,"L1",NURSORT,NL1))
- if NL1=""
- QUIT
- SET NL1(1)=""
- FOR
- SET NL1(1)=$ORDER(^TMP($JOB,"L1",NURSORT,NL1,NL1(1)))
- if NL1(1)=""
- QUIT
- SET NL1(2)=""
- FOR
- SET NL1(2)=$ORDER(^TMP($JOB,"L1",NURSORT,NL1,NL1(1),NL1(2)))
- if NL1(2)=""
- QUIT
- Begin DoDot:1
- +1 IF NURSORT(2)=3
- SET NL1(3)=""
- FOR
- SET NL1(3)=$ORDER(^TMP($JOB,"L1",NURSORT,NL1,NL1(1),NL1(2),NL1(3)))
- if NL1(3)=""
- QUIT
- DO GLOB1
- +2 IF '$TEST
- DO GLOB1
- End DoDot:1
- +3 QUIT
- GLOB1 SET NURSORT(1)=NURSORT(1)+1
- SET ^TMP("NURA",$JOB,@NURSORT(3),@NURSORT(4),NURSORT(1))=""
- +1 QUIT