NURAGEN1 ;HIRMFO/JH/MD-GENERIC REPORT GENERATOR FOR ADMIN. part 2 ;7/9/96
;;4.0;NURSING SERVICE;;Apr 25, 1997
;This is a continuation of routine NURAGEN.
;
ENT1 ; ROUTINE PROCESS SELECTOR
D F1^NURAGEN2:((NURROU=1)!(NURROU=5)!(NURROU=9)!(NURROU=17)!(NURROU=20)),F2^NURAGEN2:((NURROU=2)!(NURROU=6)!(NURROU=10))
D F3^NURAGEN2:NURROU=3,F4^NURAGEN2:NURROU=4,F5^NURAGEN2:NURROU=7,F6^NURAGEN2:NURROU=8,F7^NURAGEN2:((NURROU=11)!(NURROU=15)!(NURROU=19)),F8^NURAGEN2:((NURROU=12)!(NURROU=16)),F9^NURAGEN2:NURROU=13,F10^NURAGEN2:NURROU=14,F11^NURAGEN2:NURROU=18
S:NURROU=4!(NURROU=8) NPR2=$S(NPC2'=" BLANK":NPC2,1:"") S:NURROU=14!(NURROU=18) NPR2=$S(NPC3'=" BLANK":NPC3,1:"")
I NURROU=4!(NURROU=8)!(NURROU=14)!(NURROU=18) S NPR3=$S(NPC4'=" BLANK":NPC4,1:""),NPR4=$S(NPC5'=" BLANK":NPC5,1:""),NPR5=$S(NPC6'=" BLANK":NPC6,1:""),NPR6=$S(NPC7'=" BLANK":NPC7,1:"") D SET2 Q
S NPR2=$S(NPC2'=" BLANK":NPC2,1:""),NPR3=$S(NPC3'=" BLANK":NPC3,1:""),NPR4=$S(NPC4'=" BLANK":NPC4,1:""),NPR5=$S(NPC5'=" BLANK":NPC5,1:""),NPR6=$S(NPC6'=" BLANK":NPC6,1:"")
SET2 D S1:((NURROU=1)!(NURROU=11)),S2:((NURROU=5)!(NURROU=9)!(NURROU=13)!(NURROU=15)!(NURROU=19)),S3:NURROU=3,S4:((NURROU=7)!(NURROU=17)),S5:((NURROU=7)!(NURROU=8)!(NURROU=17)!(NURROU=18)),S6:((NURROU=3)!(NURROU=4)!(NURROU=13)!(NURROU=14))
Q
S1 I NURROU=1 S NPR3=$$CAT^NURSUT2(NPR3) Q
S NPR2=$$CAT^NURSUT2(NPR2),NPR3=$S(NPR3'=" BLANK":NPR3,1:"")
Q
S2 I NURROU=5!(NURROU=9) S NPR3=$$CAT^NURSUT2(NPR3) Q
S NPR2=$$CAT^NURSUT2(NPR2)
Q
S3 S NPR3=$$CAT^NURSUT2(NPR3)
Q
S4 I NURROU=7 S NPR3=$$CAT^NURSUT2(NPR3) Q
S NPR2=$$CAT^NURSUT2(NPR2)
Q
S5 I NURROU=7!(NURROU=8) S NPR4=$S(NPR4="A":"ACT RESERVE",NPR4="R":"RETIRED/DISC",NPR4="IRR":"IND READY RES",NPR4="IMA":"IND MOBIL AUG",1:"") Q
S NPR3=$S(NPR3="A":"ACT RESERVE",NPR3="R":"RETIRED/DISC",NPR3="IRR":"IND READY RES",NPR3="IMA":"IND MOBIL AUG",1:"")
Q
S6 I NURROU=3!(NURROU=4) S NPR4=$S(NPR4="M":"MALE",NPR4="F":"FEMALE",1:"") Q
S NPR3=$S(NPR3="M":"MALE",NPR3="F":"FEMALE",1:"")
Q
PSUBTL ; PRODUCT LINE SUB TOTALS
S PTOT=0,X="" F S X=$O(^TMP("NURA",$J,NURFAC,NURPROG,X)) Q:X="" S PTOT=PTOT+1
I NRPT=4 S (PTCT,X,Z)=0,Y="" F S X=$O(^TMP("NURA",$J,NURFAC,NURPROG,X)) Q:X'>0 F S Y=$O(^TMP("NURA",$J,NURFAC,NURPROG,X,Y)) Q:Y="" F S Z=$O(^TMP("NURA",$J,NURFAC,NURPROG,X,Y,Z)) Q:Z'>0 S PTCT=PTCT+1
E S (PTCT,X,Y,Z)=0 F S X=$O(^TMP("NURA",$J,NURFAC,NURPROG,X)) Q:X'>0 F S Y=$O(^TMP("NURA",$J,NURFAC,NURPROG,X,Y)) Q:Y'>0 F S Z=$O(^TMP("NURA",$J,NURFAC,NURPROG,X,Y,Z)) Q:Z'>0 S PTCT=PTCT+1
I $Y>(IOSL-6) D HEADER^NURAGEN
W !,?47,$$REPEAT^XLFSTR("-",33) W !!,$$PROD^NURSUT2(NURPROG)_" NUMBER OF ASSIGNMENTS ",?47,$J(PTCT,4,0),!!,$$PROD^NURSUT2(NURPROG)_" NUMBER OF PERSONNEL",?47,$J(PTOT,4,0)
Q
FSUBTL ; FACILITY SUB TOTALS
S FTOT=0,X="" F S X=$O(^TMP("NURA",$J,NURFAC,X)) Q:X="" S Y="" F S Y=$O(^TMP("NURA",$J,NURFAC,X,Y)) Q:Y="" S FTOT=FTOT+1
I NRPT=4 S FTCT=0,W="" D
. F S W=$O(^TMP("NURA",$J,NURFAC,W)) Q:W="" S X=0 F S X=$O(^TMP("NURA",$J,NURFAC,W,X)) Q:X'>0 D
. . S Y="" F Y=$O(^TMP("NURA",$J,NURFAC,W,X,Y)) Q:Y="" S:Y="M" NMCNT=NMCNT+1 S:Y="F" NFCNT=NFCNT+1 S Z=0 F S Z=$O(^TMP("NURA",$J,NURFAC,W,X,Y,Z)) Q:Z'>0 S FTCT=FTCT+1
. . Q
. Q
E S (FTCT,X,Y,Z)=0,W="" F S W=$O(^TMP("NURA",$J,NURFAC,W)) Q:W="" S X=0 F S X=$O(^TMP("NURA",$J,NURFAC,W,X)) Q:X'>0 F S Y=$O(^TMP("NURA",$J,NURFAC,W,X,Y)) Q:Y'>0 F S Z=$O(^TMP("NURA",$J,NURFAC,W,X,Y,Z)) Q:Z'>0 S FTCT=FTCT+1
I $Y>(IOSL-6) D HEADER^NURAGEN
W !,?47,$$REPEAT^XLFSTR("-",33) W !!,$$FACL^NURSUT2(NURFAC)_" NUMBER OF ASSIGNMENTS ",?47,$J(FTCT,4,0)
I NRPT=4 W !!,$$FACL^NURSUT2(NURFAC)_" NUMBER OF MALES ",?47,$J(NMCNT,4,0),!!,$$FACL^NURSUT2(NURFAC)_" NUMBER OF FEMALES ",?47,$J(NFCNT,4,0) S (NMCNT,NFCNT)=0
W !!,$$FACL^NURSUT2(NURFAC)_" NUMBER OF PERSONNEL",?47,$J(FTOT,4,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAGEN1 3830 printed Dec 13, 2024@02:19:23 Page 2
NURAGEN1 ;HIRMFO/JH/MD-GENERIC REPORT GENERATOR FOR ADMIN. part 2 ;7/9/96
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
+2 ;This is a continuation of routine NURAGEN.
+3 ;
ENT1 ; ROUTINE PROCESS SELECTOR
+1 if ((NURROU=1)!(NURROU=5)!(NURROU=9)!(NURROU=17)!(NURROU=20))
DO F1^NURAGEN2
if ((NURROU=2)!(NURROU=6)!(NURROU=10))
DO F2^NURAGEN2
+2 if NURROU=3
DO F3^NURAGEN2
if NURROU=4
DO F4^NURAGEN2
if NURROU=7
DO F5^NURAGEN2
if NURROU=8
DO F6^NURAGEN2
if ((NURROU=11)!(NURROU=15)!(NURROU=19))
DO F7^NURAGEN2
if ((NURROU=12)!(NURROU=16))
DO F8^NURAGEN2
if NURROU=13
DO F9^NURAGEN2
if NURROU=14
DO F10^NURAGEN2
if NURROU=18
DO F11^NURAGEN2
+3 if NURROU=4!(NURROU=8)
SET NPR2=$SELECT(NPC2'=" BLANK":NPC2,1:"")
if NURROU=14!(NURROU=18)
SET NPR2=$SELECT(NPC3'=" BLANK":NPC3,1:"")
+4 IF NURROU=4!(NURROU=8)!(NURROU=14)!(NURROU=18)
SET NPR3=$SELECT(NPC4'=" BLANK":NPC4,1:"")
SET NPR4=$SELECT(NPC5'=" BLANK":NPC5,1:"")
SET NPR5=$SELECT(NPC6'=" BLANK":NPC6,1:"")
SET NPR6=$SELECT(NPC7'=" BLANK":NPC7,1:"")
DO SET2
QUIT
+5 SET NPR2=$SELECT(NPC2'=" BLANK":NPC2,1:"")
SET NPR3=$SELECT(NPC3'=" BLANK":NPC3,1:"")
SET NPR4=$SELECT(NPC4'=" BLANK":NPC4,1:"")
SET NPR5=$SELECT(NPC5'=" BLANK":NPC5,1:"")
SET NPR6=$SELECT(NPC6'=" BLANK":NPC6,1:"")
SET2 if ((NURROU=1)!(NURROU=11))
DO S1
if ((NURROU=5)!(NURROU=9)!(NURROU=13)!(NURROU=15)!(NURROU=19))
DO S2
if NURROU=3
DO S3
if ((NURROU=7)!(NURROU=17))
DO S4
if ((NURROU=7)!(NURROU=8)!(NURROU=17)!(NURROU=18))
DO S5
if ((NURROU=3)!(NURROU=4)!(NURROU=13)!(NURROU=14))
DO S6
+1 QUIT
S1 IF NURROU=1
SET NPR3=$$CAT^NURSUT2(NPR3)
QUIT
+1 SET NPR2=$$CAT^NURSUT2(NPR2)
SET NPR3=$SELECT(NPR3'=" BLANK":NPR3,1:"")
+2 QUIT
S2 IF NURROU=5!(NURROU=9)
SET NPR3=$$CAT^NURSUT2(NPR3)
QUIT
+1 SET NPR2=$$CAT^NURSUT2(NPR2)
+2 QUIT
S3 SET NPR3=$$CAT^NURSUT2(NPR3)
+1 QUIT
S4 IF NURROU=7
SET NPR3=$$CAT^NURSUT2(NPR3)
QUIT
+1 SET NPR2=$$CAT^NURSUT2(NPR2)
+2 QUIT
S5 IF NURROU=7!(NURROU=8)
SET NPR4=$SELECT(NPR4="A":"ACT RESERVE",NPR4="R":"RETIRED/DISC",NPR4="IRR":"IND READY RES",NPR4="IMA":"IND MOBIL AUG",1:"")
QUIT
+1 SET NPR3=$SELECT(NPR3="A":"ACT RESERVE",NPR3="R":"RETIRED/DISC",NPR3="IRR":"IND READY RES",NPR3="IMA":"IND MOBIL AUG",1:"")
+2 QUIT
S6 IF NURROU=3!(NURROU=4)
SET NPR4=$SELECT(NPR4="M":"MALE",NPR4="F":"FEMALE",1:"")
QUIT
+1 SET NPR3=$SELECT(NPR3="M":"MALE",NPR3="F":"FEMALE",1:"")
+2 QUIT
PSUBTL ; PRODUCT LINE SUB TOTALS
+1 SET PTOT=0
SET X=""
FOR
SET X=$ORDER(^TMP("NURA",$JOB,NURFAC,NURPROG,X))
if X=""
QUIT
SET PTOT=PTOT+1
+2 IF NRPT=4
SET (PTCT,X,Z)=0
SET Y=""
FOR
SET X=$ORDER(^TMP("NURA",$JOB,NURFAC,NURPROG,X))
if X'>0
QUIT
FOR
SET Y=$ORDER(^TMP("NURA",$JOB,NURFAC,NURPROG,X,Y))
if Y=""
QUIT
FOR
SET Z=$ORDER(^TMP("NURA",$JOB,NURFAC,NURPROG,X,Y,Z))
if Z'>0
QUIT
SET PTCT=PTCT+1
+3 IF '$TEST
SET (PTCT,X,Y,Z)=0
FOR
SET X=$ORDER(^TMP("NURA",$JOB,NURFAC,NURPROG,X))
if X'>0
QUIT
FOR
SET Y=$ORDER(^TMP("NURA",$JOB,NURFAC,NURPROG,X,Y))
if Y'>0
QUIT
FOR
SET Z=$ORDER(^TMP("NURA",$JOB,NURFAC,NURPROG,X,Y,Z))
if Z'>0
QUIT
SET PTCT=PTCT+1
+4 IF $Y>(IOSL-6)
DO HEADER^NURAGEN
+5 WRITE !,?47,$$REPEAT^XLFSTR("-",33)
WRITE !!,$$PROD^NURSUT2(NURPROG)_" NUMBER OF ASSIGNMENTS ",?47,$JUSTIFY(PTCT,4,0),!!,$$PROD^NURSUT2(NURPROG)_" NUMBER OF PERSONNEL",?47,$JUSTIFY(PTOT,4,0)
+6 QUIT
FSUBTL ; FACILITY SUB TOTALS
+1 SET FTOT=0
SET X=""
FOR
SET X=$ORDER(^TMP("NURA",$JOB,NURFAC,X))
if X=""
QUIT
SET Y=""
FOR
SET Y=$ORDER(^TMP("NURA",$JOB,NURFAC,X,Y))
if Y=""
QUIT
SET FTOT=FTOT+1
+2 IF NRPT=4
SET FTCT=0
SET W=""
Begin DoDot:1
+3 FOR
SET W=$ORDER(^TMP("NURA",$JOB,NURFAC,W))
if W=""
QUIT
SET X=0
FOR
SET X=$ORDER(^TMP("NURA",$JOB,NURFAC,W,X))
if X'>0
QUIT
Begin DoDot:2
+4 SET Y=""
FOR Y=$ORDER(^TMP("NURA",$JOB,NURFAC,W,X,Y))
if Y=""
QUIT
if Y="M"
SET NMCNT=NMCNT+1
if Y="F"
SET NFCNT=NFCNT+1
SET Z=0
FOR
SET Z=$ORDER(^TMP("NURA",$JOB,NURFAC,W,X,Y,Z))
if Z'>0
QUIT
SET FTCT=FTCT+1
+5 QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 IF '$TEST
SET (FTCT,X,Y,Z)=0
SET W=""
FOR
SET W=$ORDER(^TMP("NURA",$JOB,NURFAC,W))
if W=""
QUIT
SET X=0
FOR
SET X=$ORDER(^TMP("NURA",$JOB,NURFAC,W,X))
if X'>0
QUIT
FOR
SET Y=$ORDER(^TMP("NURA",$JOB,NURFAC,W,X,Y))
if Y'>0
QUIT
FOR
SET Z=$ORDER(^TMP("NURA",$JOB,NURFAC,W,X,Y,Z))
if Z'>0
QUIT
SET FTCT=FTCT+1
+8 IF $Y>(IOSL-6)
DO HEADER^NURAGEN
+9 WRITE !,?47,$$REPEAT^XLFSTR("-",33)
WRITE !!,$$FACL^NURSUT2(NURFAC)_" NUMBER OF ASSIGNMENTS ",?47,$JUSTIFY(FTCT,4,0)
+10 IF NRPT=4
WRITE !!,$$FACL^NURSUT2(NURFAC)_" NUMBER OF MALES ",?47,$JUSTIFY(NMCNT,4,0),!!,$$FACL^NURSUT2(NURFAC)_" NUMBER OF FEMALES ",?47,$JUSTIFY(NFCNT,4,0)
SET (NMCNT,NFCNT)=0
+11 WRITE !!,$$FACL^NURSUT2(NURFAC)_" NUMBER OF PERSONNEL",?47,$JUSTIFY(FTOT,4,0)
+12 QUIT
