source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURAGE.m@ 1166

Last change on this file since 1166 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.2 KB
Line 
1NURAGE ;HIRMFO/RM/MD,FT-PRINT MODULE FOR AGE PROFILE REPORT ;2/27/98 14:21
2 ;;4.0;NURSING SERVICE;**9,13**;Apr 25, 1997
3 S XAGE=$S(NURDOB'="BLANK":$E(DT,1,3)-$E(NURDOB,1,3)-($E(DT,4,7)<$E(NURDOB,4,7)),1:0)
4 I 'NURSW1!($Y>(IOSL-9)) D HDGING,HDGBYP Q:NURQUIT
5BGNCALC ;
6 I ((XAGE>17)&(XAGE<21)) S NURSI=1 D SUB S NHIT=38 G NURSBYP
7 I ((XAGE>20)&(XAGE<30)) S NURSI=2 D SUB S NHIT=44 G NURSBYP
8 I ((XAGE>29)&(XAGE<40)) S NURSI=3 D SUB S NHIT=50 G NURSBYP
9 I ((XAGE>39)&(XAGE<50)) S NURSI=4 D SUB S NHIT=56 G NURSBYP
10 I ((XAGE>49)&(XAGE<60)) S NURSI=5 D SUB S NHIT=62 G NURSBYP
11 I ((XAGE>59)&(XAGE<70)) S NURSI=6 D SUB S NHIT=68 G NURSBYP
12 I (XAGE>69) S NURSI=7 D SUB S NHIT=74 G NURSBYP
13 I '+XAGE S NURSI=8 D SUB S NHIT=32 G NURSBYP
14 Q
15SUB ;
16 S NURSOLD(NURSI)=NURSOLD(NURSI)+1
17 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
18 .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)=""
19 .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)=""
20 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)=""
21 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)=""
22 Q
23NURSBYP ;
24 Q:$G(NURSUMSW) I $Y>(IOSL-9) D HDGING Q:NURQUIT
25 W !,$E(NURN1,1,20),?NHIT,"X"
26 Q
27WRTCAT ;
28 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)
29 W:'$G(NURSUMSW) ?(69-$L(NURSOLD(6))),NURSOLD(6),?(75-$L(NURSOLD(7))),NURSOLD(7)
30 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
31 Q
32WRTWARD ;
33 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)
34 W:'$G(NURSUMSW) ?(69-$L(NURSWOLD(6))),NURSWOLD(6),?(75-$L(NURSWOLD(7))),NURSWOLD(7)
35 F I=1:1:8 S NURSFOLD(I)=NURSFOLD(I)+NURSWOLD(I),NURSWOLD(I)=0
36 Q
37PSUBTL ; PRODUCT LINE SUBTOTALS
38 S X=$E($$PROD^NURSUT2(NURSPROG),1,16) W !!,?(17-$L(X)),X,?18,"SUB-TOTAL:"
39 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)
40 W ?(69-$L(NURSPOLD(6))),NURSPOLD(6),?(75-$L(NURSPOLD(7))),NURSPOLD(7)
41 F I=1:1:8 S NURSPOLD(I)=0
42 Q
43FSUBTL ; FACILITY SUBTOTALS
44 W !!,?(17-$L(NURFAC)),$E($$FACL^NURSUT2(NURFAC),1,16),?18,"SUB-TOTAL:"
45 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)
46 W ?(69-$L(NURSMOLD(6))),NURSMOLD(6),?(75-$L(NURSMOLD(7))),NURSMOLD(7)
47 F I=1:1:8 S NURSMOLD(I)=0
48 Q
49HDGING ; HEADINGS
50 I 'NURQUEUE,NURSW1,$E(IOST)="C" D ENDPG Q:NURQUIT
51 S:'NURSW1 NURSW1=1
52 W:'($E(IOST)="P"&(NURPAGE=0)) @IOF S NURPAGE=NURPAGE+1
53 I NURMDSW,$L(NURFAC)>1,'$G(NURSUMSW),$G(NURFAC)'=" BLANK" W !?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
54 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
55 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+"
56 W !,$$REPEAT^XLFSTR("-",80) S NURSW1(1)=1
57 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)
58 I NSEL["W",$G(NURNL1)'="" W:$D(^TMP($J,"L",NURFAC,NURSPROG,$G(NURNL1))) !!,?16,"WARD LOCATION: ",NURNL1
59 Q
60HDGBYP ;
61 Q:$G(NURSUMSW) I ($Y>(IOSL-9)) D HDGING Q:NURQUIT
62 W !!,?20,"SERVICE " W:(NSEL["C") "CATEGORY: ",$$CAT^NURSUT2(NCATPOS) W:(NSEL["S") "POSITION: ",NCATPOS W ! S NURSCAT=NCATPOS
63 Q
64FINCAT ; SELECT SVC CATEGORY
65 W !!!,?4,"ASSIGNMENTS FINAL TOTAL:"
66 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
67 D PRTOT F X=1:1:8 S NURSFOLD(X)=NURSWOLD(X)
68 W !!,?6,"PERSONNEL FINAL TOTAL:" D PRTOT
69 I NURQUIT,$E(IOST)="C" S X="" W !!,"Enter RETURN to continue " R X:DTIME
70 Q
71PRTOT 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)
72 W ?(63-$L(NURSFOLD(5))),NURSFOLD(5),?(69-$L(NURSFOLD(6))),NURSFOLD(6),?(75-$L(NURSFOLD(7))),NURSFOLD(7)
73 Q
74ENDPG ; HANDLE EOP
75 I $E(IOST)'="C"!($G(NURQUIT)) Q
76 W $C(7),!!,"Press return to continue, or ""^"" to exit: " R NX:DTIME I '$T!(NX="^") S (NURQUIT,NUROUT)=1 Q
77 Q
Note: See TracBrowser for help on using the repository browser.