source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURAAGS0.m@ 862

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

initial load of WorldVistAEHR
File size: 5.2 KB
RevLine 
[613]1NURAAGS0 ;HIRMFO/RM,JH,MD-MULTIDIVISIONAL GENERIC SORT ROUTINE FOR ADMIN REPORTS ;11/18/96
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ; SER.CAT-SPEC. SORT
4 S NURNEN=1 D ACSORT
5 G Q
6EN2 ; PRIO.SQ.-SER.POS.-SPEC. SORT
7 I 'NURSER S NURNEN=2 D CSORT G Q
8 S NURNEN=2 D ACSORT
9 G Q
10EN3 ; LOC-SER.CAT.-SPEC. SORT
11 S NURNEN=3
12 I 'NURHOSP D ESORT G Q
13 D ACSORT,EN4^NURSAUTL:NURSZAP=7
14 G Q
15EN4 ; LOC.-PRIO.SQ.-SER.POS.-SPEC. SORT
16 S NURNEN=4
17 I 'NURHOSP D ESORT G Q
18 D ACSORT,EN4^NURSAUTL:NURSZAP=7
19Q K D0,DA,NURNEN,NLOCN,NNM,NPRI,NURSCATY,NSPEC,NPODA,NSPOSN,NURSZORT,NPWARD,NURNODE4,NUREQWRD,NURCAT,NURFLAG,NURSCAT,NURSZ
20 Q
21ACSORT ; SORT FROM NURSING "AC" & "C" XREF
22 S Z="" F S Z=$O(^NURSF(210,"AC",Z)) Q:Z="" I Z'="R" S DA=0 F S DA=$O(^NURSF(210,"AC",Z,DA)) Q:DA'>0 I +$G(^NURSF(210,DA,0)) S DA(1)=+^(0) D:$D(^VA(200,DA(1),0))
23 .S NURNODE4=0 F S NURNODE4=$O(^NURSF(211.8,"C",DA(1),NURNODE4)) Q:NURNODE4'>0 S NURNODE5=0 F S NURNODE5=$O(^NURSF(211.8,"C",DA(1),NURNODE4,NURNODE5)) Q:NURNODE5'>0 D CHKPOS^NURAAGS1 D:+NURNEN(1) SETVAR
24 .Q
25 Q
26ESORT ; SORT FROM NURSING "B" XREF
27 S NURSZ="" F S NURSZ=$O(NURSNLOC(NURSZ)) Q:NURSZ="" S NURSIEN=0 F S NURSIEN=$O(NURSNLOC(NURSZ,NURSIEN)) Q:NURSIEN'>0 S NUREQWRD=+$G(NURSNLOC(NURSZ,NURSIEN)) D:+NUREQWRD
28 .S NURNODE4=0 F S NURNODE4=$O(^NURSF(211.8,"B",NUREQWRD,NURNODE4)) Q:NURNODE4'>0 S NURNODE5=0 F S NURNODE5=$O(^NURSF(211.8,NURNODE4,1,NURNODE5)) Q:NURNODE5'>0 D CHKPOS^NURAAGS1 D:+NURNEN(1)
29 ..S DA(1)=$S($D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)):$P(^(0),U,2),1:""),DA=$O(^NURSF(210,"B",DA(1),0)) I (+DA>0),'$D(^NURSF(210,"AC","R",+DA)),$D(^VA(200,DA(1),0)) D SETVAR
30 ..Q
31 .Q
32 Q
33CSORT ; SORT FROM NURSING "D" XREF
34 S DA(1)=0 F S DA(1)=$O(^NURSF(211.8,"AD",DA(1))) Q:DA(1)'>0 S NURNODE4=0 F S NURNODE4=$O(^NURSF(211.8,"AD",DA(1),NPOS,NURNODE4)) Q:NURNODE4'>0 D
35 .S NURNODE5=0 F S NURNODE5=$O(^NURSF(211.8,"AD",DA(1),NPOS,NURNODE4,NURNODE5)) Q:NURNODE5'>0 S DA=$O(^NURSF(210,"B",DA(1),0)) I $P($G(^NURSF(210,+DA,0)),U,2)'="R",'$D(^NURSF(210,"AC","R",+DA)) D CHKPOS^NURAAGS1 D:NURNEN(1) SETVAR
36 .Q
37 Q
38SETVAR ; SET SUBSCRIPTS FOR GLOBAL SET
39 S NURSZORT=1 I NRPT=10 S:NURSZAP&(NURSZDA'=DA)&(NURSZAP>7) NURSZORT=0
40 E D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP
41 Q:'NURSZORT
42 D SETCAT^NURAAGS1:NURNEN=1!(NURNEN=3),SETPOS^NURAAGS1:NURNEN=2!(NURNEN=4),SETFAC^NURAAGS1,SETPROG^NURAAGS1,SETLOC^NURAAGS1
43 I $D(^NURSF(211.4,"B",+NLOCN)) S NLOCN(2)=$O(^NURSF(211.4,"B",+NLOCN,0)) I $D(^NURSF(211.4,NLOCN(2),"I")),$E($P(^("I"),U))="I" Q
44 I $G(NURMDSW),'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
45 I $G(NURPLSW),$G(NURPROG)=0,$G(NURPROG(1))'=$G(NURPROG(2)) Q
46 I $G(NURPLSW) S:NURPROG(2)="NURSING" NURPROG(2)=" NURSING"
47 I (NURNEN=3!(NURNEN=4)),'NURHOSP,'$D(NURSNLOC(NLOCN(1))) Q
48 I (NURNEN=1!(NURNEN=3)),$S($E(NURSCATY)'="O":'$D(^TMP("NURSCAT",$J,$E(NURSCATY))),$P($G(NURSCATY),"O ",2)="":'$D(^TMP("NURSCAT",$J,$E(NURSCATY))),$P($G(NURSCATY),"O ",2)'="":'$D(^TMP("NURSCAT",$J,$E(NURSCATY,3,99))),1:0) Q
49 I (NURNEN=2!(NURNEN=4)) S NPODA=$O(^NURSF(211.3,"B",NSPOSN,"")) Q:NPODA="" Q:'$D(^NURSF(211.3,NPODA,0)) I $S((NRPT=6!(NRPT=2))&NURSER&($P(^NURSF(211.3,NPODA,0),U,5)'="R"):1,NURSER:0,NPOS'=NPODA:1,1:0) Q
50 Q:'$D(^VA(200,DA(1),0)) S NNM=$S($P(^VA(200,DA(1),0),U)'="":$P(^(0),U),1:"VA # "_DA(1))
51 K NSPEC I NRPT=1 I $P($G(^NURSF(210,DA,17)),U,2)'="",$D(^NURSF(212.1,$P(^NURSF(210,DA,17),U,2),0)),$P(^(0),U,3)'="" S NSPEC=$P(^(0),U,3)
52 I NRPT=2 S D0=0 F S D0=$O(^NURSF(210,DA,12,D0)) Q:D0'>0 D SETCERT^NURAAGS1
53 I NRPT=3 Q:$S('$D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)):1,NURSZAP<7:0,$D(NURSZLO($O(^NURSF(211.4,"B",+$P(^NURSF(211.8,NURNODE4,0),U),"")))):0,1:1) I $P($G(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),U,4)'="" S NSPEC=$P(^(0),U,4)
54 I NRPT=4 I $P($G(^VA(200,DA(1),1)),U,2)'="" S NSPEC=$P(^(1),U,2)
55 I NRPT=5 I $P($G(^NURSF(210,DA,7)),U,1)'="",$P($G(^NURSF(211.1,$P(^NURSF(210,DA,7),U,1),0)),U,1)'="" S NSPEC=$P(^(0),U,1)
56 I NRPT=6 I $P($G(^NURSF(210,DA,17)),U,1),$P($G(^NURSF(212.1,$P(^NURSF(210,DA,17),U,1),0)),U,1)'="" S NSPEC=$P(^(0),U,3)
57 I NRPT=7 I $D(^VA(200,DA(1),1)) S NSPEC=$S(+$P(^(1),U,3):$P(^(1),U,3),1:"BLANK") I 'NSP,(+NSPEC<NSPC!(+NSPEC>NSPC(1))) Q
58 I NRPT=8 S D0=0 F S D0=$O(^NURSF(210,DA,4,D0)) Q:D0'>0 D
59 .I '$G(NSTAT),$G(NSTAT(1))'=+$G(^NURSF(210,DA,4,D0,0)) Q
60 .D:NURSCATY="R"!(NURSCATY="L")!($E(NURSCATY)="O") SETLIC^NURAAGS1,SETUPTL^NURAAGS1:$S(NSP:1,$E(NSPEC,1,7)'<NSPC&($E(NSPEC,1,7)'>NSPC(2)):1,1:0)
61 .Q
62 I NRPT=8,'$O(^NURSF(210,DA,4,0)),NURSCATY="R"!(NURSCATY="L")!($E(NURSCATY)="O") S NSPEC=" BLANK"_0 D SETUPTL^NURAAGS1:$S(NSP:1,$E(NSPEC,1,7)'<NSPC&($E(NSPEC,1,7)'>NSPC(2)):1,1:0)
63 I NRPT=9 S D0=0 F S D0=$O(^NURSF(210,DA,10,D0)) Q:D0'>0 D SETMIL^NURAAGS1
64 I NRPT=10 S:$G(NURSORT)="" NURSORT=1 D Q
65 .I NURPLSW,NURPROG(2)'=" BLANK" S NURPROG(3)=+$O(^NURSF(212.7,"NURSING",0)),NURPROG(3)=$$GET1^DIQ(212.7,NURPROG(3),.01,"I")
66 .N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN))
67 .W:$E(IOST)="C"&($R(100)) "." I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN)=X
68 .S ^TMP($J,"L1",X,NNM,DA,NURNODE4)=""
69 .Q
70 Q:(NRPT=2)!(NRPT=8)!(NRPT=9)
71 I NRPT=6,$D(NURSCATY),NURSCATY'="R" Q
72 I NRPT=6,$D(NSPOSN),1=$S($O(^NURSF(211.3,"B",NSPOSN,""))="":0,$P(^NURSF(211.3,$O(^NURSF(211.3,"B",NSPOSN,"")),0),U,5)'="R":1,1:0) Q
73 I '$D(NSPEC) S NSPEC=" BLANK"
74 Q:NRPT=1!(NRPT=7)&(NSPEC=" BLANK")
75 I NRPT'=7,'NSP,NSPC'=NSPEC Q
76 D SETUPTL^NURAAGS1 Q
Note: See TracBrowser for help on using the repository browser.