VistA-WorldVistAEHR/r/NURSING_SERVICE-NUR/NURAGEN1.m

50 lines
3.7 KiB
Mathematica

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