source: FOIAVistA/tag/r/NURSING_SERVICE-NUR/NURAGEN1.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1NURAGEN1 ;HIRMFO/JH/MD-GENERIC REPORT GENERATOR FOR ADMIN. part 2 ;7/9/96
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3 ;This is a continuation of routine NURAGEN.
4 ;
5ENT1 ; ROUTINE PROCESS SELECTOR
6 D F1^NURAGEN2:((NURROU=1)!(NURROU=5)!(NURROU=9)!(NURROU=17)!(NURROU=20)),F2^NURAGEN2:((NURROU=2)!(NURROU=6)!(NURROU=10))
7 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
8 S:NURROU=4!(NURROU=8) NPR2=$S(NPC2'=" BLANK":NPC2,1:"") S:NURROU=14!(NURROU=18) NPR2=$S(NPC3'=" BLANK":NPC3,1:"")
9 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
10 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:"")
11SET2 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))
12 Q
13S1 I NURROU=1 S NPR3=$$CAT^NURSUT2(NPR3) Q
14 S NPR2=$$CAT^NURSUT2(NPR2),NPR3=$S(NPR3'=" BLANK":NPR3,1:"")
15 Q
16S2 I NURROU=5!(NURROU=9) S NPR3=$$CAT^NURSUT2(NPR3) Q
17 S NPR2=$$CAT^NURSUT2(NPR2)
18 Q
19S3 S NPR3=$$CAT^NURSUT2(NPR3)
20 Q
21S4 I NURROU=7 S NPR3=$$CAT^NURSUT2(NPR3) Q
22 S NPR2=$$CAT^NURSUT2(NPR2)
23 Q
24S5 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
25 S NPR3=$S(NPR3="A":"ACT RESERVE",NPR3="R":"RETIRED/DISC",NPR3="IRR":"IND READY RES",NPR3="IMA":"IND MOBIL AUG",1:"")
26 Q
27S6 I NURROU=3!(NURROU=4) S NPR4=$S(NPR4="M":"MALE",NPR4="F":"FEMALE",1:"") Q
28 S NPR3=$S(NPR3="M":"MALE",NPR3="F":"FEMALE",1:"")
29 Q
30PSUBTL ; PRODUCT LINE SUB TOTALS
31 S PTOT=0,X="" F S X=$O(^TMP("NURA",$J,NURFAC,NURPROG,X)) Q:X="" S PTOT=PTOT+1
32 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
33 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
34 I $Y>(IOSL-6) D HEADER^NURAGEN
35 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)
36 Q
37FSUBTL ; FACILITY SUB TOTALS
38 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
39 I NRPT=4 S FTCT=0,W="" D
40 . 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
41 . . 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
42 . . Q
43 . Q
44 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
45 I $Y>(IOSL-6) D HEADER^NURAGEN
46 W !,?47,$$REPEAT^XLFSTR("-",33) W !!,$$FACL^NURSUT2(NURFAC)_" NUMBER OF ASSIGNMENTS ",?47,$J(FTCT,4,0)
47 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
48 W !!,$$FACL^NURSUT2(NURFAC)_" NUMBER OF PERSONNEL",?47,$J(FTOT,4,0)
49 Q
Note: See TracBrowser for help on using the repository browser.