source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURAGE.m@ 1654

NURAGE ;HIRMFO/RM/MD,FT-PRINT MODULE FOR AGE PROFILE REPORT ;2/27/98  14:21
 ;;4.0;NURSING SERVICE;**9,13**;Apr 25, 1997
 S XAGE=$S(NURDOB'="BLANK":$E(DT,1,3)-$E(NURDOB,1,3)-($E(DT,4,7)<$E(NURDOB,4,7)),1:0)
 I 'NURSW1!($Y>(IOSL-9)) D HDGING,HDGBYP Q:NURQUIT
BGNCALC ;
 I ((XAGE>17)&(XAGE<21)) S NURSI=1 D SUB S NHIT=38 G NURSBYP
 I ((XAGE>20)&(XAGE<30)) S NURSI=2 D SUB S NHIT=44 G NURSBYP
 I ((XAGE>29)&(XAGE<40)) S NURSI=3 D SUB S NHIT=50 G NURSBYP
 I ((XAGE>39)&(XAGE<50)) S NURSI=4 D SUB S NHIT=56 G NURSBYP
 I ((XAGE>49)&(XAGE<60)) S NURSI=5 D SUB S NHIT=62 G NURSBYP
 I ((XAGE>59)&(XAGE<70)) S NURSI=6 D SUB S NHIT=68 G NURSBYP
 I (XAGE>69) S NURSI=7 D SUB S NHIT=74 G NURSBYP
 I '+XAGE S NURSI=8 D SUB S NHIT=32 G NURSBYP
 Q
SUB ;
 S NURSOLD(NURSI)=NURSOLD(NURSI)+1
 I AN<5 S NURSORT(1)=$G(@("^TMP($J,""L"",NURFAC,NURSPROG,"_$S(NSEL["W":"NURNL1,",1:"")_$S(NSEL["C":"NCATPOS,",1:"NPRI,NCATPOS)")_$S(NSEL["C":"NURDOB)",1:""))) I NURSORT(1) D
 .I NSEL["C" F X=0:0 S X=$O(^TMP($J,"L1",NURSORT(1),NURN1,DA,X)) Q:X'>0  S Y=0 F  S Y=$O(^TMP($J,"L1",NURSORT(1),NURN1,DA,X,Y)) Q:Y'>0  S ^TMP("NURA",$J,NURSI,DA,X_"-"_Y)=""
 .E  F X=0:0 S X=$O(^TMP($J,"L1",NURSORT(1),NURDOB,NURN1,DA,X)) Q:X'>0  S ^TMP("NURA",$J,NURSI,DA,X_"-"_NCATPOS)=""
 I AN=5 S NURSORT(1)=^TMP($J,"L",NURFAC,NURSPROG,NCATPOS,NURDOB,NURN1) I NURSORT(1) F X=0:0 S X=$O(^TMP($J,"L1",NURSORT(1),DA,X)) Q:X'>0  S Y=0 F  S Y=$O(^TMP($J,"L1",NURSORT(1),DA,X,Y)) Q:Y'>0  S ^TMP("NURA",$J,NURSI,DA,X_"-"_Y)=""
 I AN=6 S NURSORT(1)=^TMP($J,"L",NURFAC,NURSPROG,NPRI,NCATPOS,NURDOB) I NURSORT(1) F X=0:0 S X=$O(^TMP($J,"L1",NURSORT(1),NURN1,DA,X)) Q:X'>0  S ^TMP("NURA",$J,NURSI,DA,X_"-"_NCATPOS)=""
 Q
NURSBYP ;
 Q:$G(NURSUMSW)  I $Y>(IOSL-9) D HDGING Q:NURQUIT
 W !,$E(NURN1,1,20),?NHIT,"X"
 Q
WRTCAT ;
 W:'$G(NURSUMSW) !!,?18,"SUB-TOTAL:",?(33-$L(NURSOLD(8))),NURSOLD(8),?(39-$L(NURSOLD(1))),NURSOLD(1),?(45-$L(NURSOLD(2))),NURSOLD(2),?(51-$L(NURSOLD(3))),NURSOLD(3),?(57-$L(NURSOLD(4))),NURSOLD(4),?(63-$L(NURSOLD(5))),NURSOLD(5)
 W:'$G(NURSUMSW) ?(69-$L(NURSOLD(6))),NURSOLD(6),?(75-$L(NURSOLD(7))),NURSOLD(7)
 F I=1:1:8 S NURSWOLD(I)=NURSWOLD(I)+NURSOLD(I),NURSMOLD(I)=NURSMOLD(I)+NURSOLD(I),NURSPOLD(I)=NURSPOLD(I)+NURSOLD(I),NURSOLD(I)=0
 Q
WRTWARD ;
 W:'$G(NURSUMSW) !!,?13,"WARD SUB-TOTAL:",?(33-$L(NURSWOLD(8))),NURSWOLD(8),?(39-$L(NURSWOLD(1))),NURSWOLD(1),?(45-$L(NURSWOLD(2))),NURSWOLD(2),?(51-$L(NURSWOLD(3))),NURSWOLD(3),?(57-$L(NURSWOLD(4))),NURSWOLD(4),?(63-$L(NURSWOLD(5))),NURSWOLD(5)
 W:'$G(NURSUMSW) ?(69-$L(NURSWOLD(6))),NURSWOLD(6),?(75-$L(NURSWOLD(7))),NURSWOLD(7)
 F I=1:1:8 S NURSFOLD(I)=NURSFOLD(I)+NURSWOLD(I),NURSWOLD(I)=0
 Q
PSUBTL ; PRODUCT LINE SUBTOTALS
 S X=$E($$PROD^NURSUT2(NURSPROG),1,16) W !!,?(17-$L(X)),X,?18,"SUB-TOTAL:"
 W ?(33-$L(NURSPOLD(8))),NURSPOLD(8),?(39-$L(NURSPOLD(1))),NURSPOLD(1),?(45-$L(NURSPOLD(2))),NURSPOLD(2),?(51-$L(NURSPOLD(3))),NURSPOLD(3),?(57-$L(NURSPOLD(4))),NURSPOLD(4),?(63-$L(NURSPOLD(5))),NURSPOLD(5)
 W ?(69-$L(NURSPOLD(6))),NURSPOLD(6),?(75-$L(NURSPOLD(7))),NURSPOLD(7)
 F I=1:1:8 S NURSPOLD(I)=0
 Q
FSUBTL ; FACILITY SUBTOTALS
 W !!,?(17-$L(NURFAC)),$E($$FACL^NURSUT2(NURFAC),1,16),?18,"SUB-TOTAL:"
 W ?(33-$L(NURSMOLD(8))),NURSMOLD(8),?(39-$L(NURSMOLD(1))),NURSMOLD(1),?(45-$L(NURSMOLD(2))),NURSMOLD(2),?(51-$L(NURSMOLD(3))),NURSMOLD(3),?(57-$L(NURSMOLD(4))),NURSMOLD(4),?(63-$L(NURSMOLD(5))),NURSMOLD(5)
 W ?(69-$L(NURSMOLD(6))),NURSMOLD(6),?(75-$L(NURSMOLD(7))),NURSMOLD(7)
 F I=1:1:8 S NURSMOLD(I)=0
 Q
HDGING ; HEADINGS
 I 'NURQUEUE,NURSW1,$E(IOST)="C" D ENDPG Q:NURQUIT
 S:'NURSW1 NURSW1=1
 W:'($E(IOST)="P"&(NURPAGE=0)) @IOF S NURPAGE=NURPAGE+1
 I NURMDSW,$L(NURFAC)>1,'$G(NURSUMSW),$G(NURFAC)'=" BLANK" W !?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
 W !,"NURSING SERVICE AGE PROFILE BY " W $S(NSEL["W":"LOCATION/SVC ",1:"SERVICE "),$S(NSEL["C":"CATEGORY",NSEL["S":"POSITION",1:"") S Y=DT X ^DD("DD") W "    ",Y,"   PAGE: ",NURPAGE
 W !!,"NAME",?29,"NO DOB",?36,"18-20",?42,"21-29",?48,"30-39",?54,"40-49",?60,"50-59",?66,"60-69",?73,"70+"
 W !,$$REPEAT^XLFSTR("-",80) S NURSW1(1)=1
 I $G(NURPLSW),$L(NURSPROG)>1,'$G(NURSUMSW),$G(NURSPROG)'=" BLANK" N Z S Z=$$PROD^NURSUT2(NURSPROG) W !,?$$CNTR^NURSUT2(Z),$G(Z),!,?$$CNTR^NURSUT2(Z),$$REPEAT^XLFSTR("-",$L(Z)+1)
 I NSEL["W",$G(NURNL1)'="" W:$D(^TMP($J,"L",NURFAC,NURSPROG,$G(NURNL1))) !!,?16,"WARD LOCATION: ",NURNL1
 Q
HDGBYP ;
 Q:$G(NURSUMSW)  I ($Y>(IOSL-9)) D HDGING Q:NURQUIT
 W !!,?20,"SERVICE " W:(NSEL["C") "CATEGORY: ",$$CAT^NURSUT2(NCATPOS) W:(NSEL["S") "POSITION: ",NCATPOS W ! S NURSCAT=NCATPOS
 Q
FINCAT ; SELECT SVC CATEGORY
 W !!!,?4,"ASSIGNMENTS FINAL TOTAL:"
 F X=1:1:8 S (NURSFOLD(X),NURSWOLD(X))=0 F Y=0:0 S Y=$O(^TMP("NURA",$J,X,Y)) Q:Y'>0  S NURSWOLD(X)=NURSWOLD(X)+1 S Z="" F  S Z=$O(^TMP("NURA",$J,X,Y,Z)) Q:Z=""  S NURSFOLD(X)=NURSFOLD(X)+1
 D PRTOT F X=1:1:8 S NURSFOLD(X)=NURSWOLD(X)
 W !!,?6,"PERSONNEL FINAL TOTAL:" D PRTOT
 I NURQUIT,$E(IOST)="C" S X="" W !!,"Enter RETURN to continue "  R X:DTIME
 Q
PRTOT W ?(33-$L(NURSFOLD(8))),NURSFOLD(8),?(39-$L(NURSFOLD(1))),NURSFOLD(1),?(45-$L(NURSFOLD(2))),NURSFOLD(2),?(51-$L(NURSFOLD(3))),NURSFOLD(3),?(57-$L(NURSFOLD(4))),NURSFOLD(4)
 W ?(63-$L(NURSFOLD(5))),NURSFOLD(5),?(69-$L(NURSFOLD(6))),NURSFOLD(6),?(75-$L(NURSFOLD(7))),NURSFOLD(7)
 Q
ENDPG ; HANDLE EOP
 I $E(IOST)'="C"!($G(NURQUIT)) Q
 W $C(7),!!,"Press return to continue, or ""^"" to exit: " R NX:DTIME I '$T!(NX="^") S (NURQUIT,NUROUT)=1 Q
 Q