- 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
- 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
