77 lines
5.2 KiB
Mathematica
77 lines
5.2 KiB
Mathematica
NURAAGS0 ;HIRMFO/RM,JH,MD-MULTIDIVISIONAL GENERIC SORT ROUTINE FOR ADMIN REPORTS ;11/18/96
|
|
;;4.0;NURSING SERVICE;;Apr 25, 1997
|
|
EN1 ; SER.CAT-SPEC. SORT
|
|
S NURNEN=1 D ACSORT
|
|
G Q
|
|
EN2 ; PRIO.SQ.-SER.POS.-SPEC. SORT
|
|
I 'NURSER S NURNEN=2 D CSORT G Q
|
|
S NURNEN=2 D ACSORT
|
|
G Q
|
|
EN3 ; LOC-SER.CAT.-SPEC. SORT
|
|
S NURNEN=3
|
|
I 'NURHOSP D ESORT G Q
|
|
D ACSORT,EN4^NURSAUTL:NURSZAP=7
|
|
G Q
|
|
EN4 ; LOC.-PRIO.SQ.-SER.POS.-SPEC. SORT
|
|
S NURNEN=4
|
|
I 'NURHOSP D ESORT G Q
|
|
D ACSORT,EN4^NURSAUTL:NURSZAP=7
|
|
Q K D0,DA,NURNEN,NLOCN,NNM,NPRI,NURSCATY,NSPEC,NPODA,NSPOSN,NURSZORT,NPWARD,NURNODE4,NUREQWRD,NURCAT,NURFLAG,NURSCAT,NURSZ
|
|
Q
|
|
ACSORT ; SORT FROM NURSING "AC" & "C" XREF
|
|
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))
|
|
.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
|
|
.Q
|
|
Q
|
|
ESORT ; SORT FROM NURSING "B" XREF
|
|
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
|
|
.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)
|
|
..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
|
|
..Q
|
|
.Q
|
|
Q
|
|
CSORT ; SORT FROM NURSING "D" XREF
|
|
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
|
|
.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
|
|
.Q
|
|
Q
|
|
SETVAR ; SET SUBSCRIPTS FOR GLOBAL SET
|
|
S NURSZORT=1 I NRPT=10 S:NURSZAP&(NURSZDA'=DA)&(NURSZAP>7) NURSZORT=0
|
|
E D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP
|
|
Q:'NURSZORT
|
|
D SETCAT^NURAAGS1:NURNEN=1!(NURNEN=3),SETPOS^NURAAGS1:NURNEN=2!(NURNEN=4),SETFAC^NURAAGS1,SETPROG^NURAAGS1,SETLOC^NURAAGS1
|
|
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
|
|
I $G(NURMDSW),'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
|
|
I $G(NURPLSW),$G(NURPROG)=0,$G(NURPROG(1))'=$G(NURPROG(2)) Q
|
|
I $G(NURPLSW) S:NURPROG(2)="NURSING" NURPROG(2)=" NURSING"
|
|
I (NURNEN=3!(NURNEN=4)),'NURHOSP,'$D(NURSNLOC(NLOCN(1))) Q
|
|
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
|
|
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
|
|
Q:'$D(^VA(200,DA(1),0)) S NNM=$S($P(^VA(200,DA(1),0),U)'="":$P(^(0),U),1:"VA # "_DA(1))
|
|
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)
|
|
I NRPT=2 S D0=0 F S D0=$O(^NURSF(210,DA,12,D0)) Q:D0'>0 D SETCERT^NURAAGS1
|
|
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)
|
|
I NRPT=4 I $P($G(^VA(200,DA(1),1)),U,2)'="" S NSPEC=$P(^(1),U,2)
|
|
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)
|
|
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)
|
|
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
|
|
I NRPT=8 S D0=0 F S D0=$O(^NURSF(210,DA,4,D0)) Q:D0'>0 D
|
|
.I '$G(NSTAT),$G(NSTAT(1))'=+$G(^NURSF(210,DA,4,D0,0)) Q
|
|
.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)
|
|
.Q
|
|
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)
|
|
I NRPT=9 S D0=0 F S D0=$O(^NURSF(210,DA,10,D0)) Q:D0'>0 D SETMIL^NURAAGS1
|
|
I NRPT=10 S:$G(NURSORT)="" NURSORT=1 D Q
|
|
.I NURPLSW,NURPROG(2)'=" BLANK" S NURPROG(3)=+$O(^NURSF(212.7,"NURSING",0)),NURPROG(3)=$$GET1^DIQ(212.7,NURPROG(3),.01,"I")
|
|
.N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN))
|
|
.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
|
|
.S ^TMP($J,"L1",X,NNM,DA,NURNODE4)=""
|
|
.Q
|
|
Q:(NRPT=2)!(NRPT=8)!(NRPT=9)
|
|
I NRPT=6,$D(NURSCATY),NURSCATY'="R" Q
|
|
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
|
|
I '$D(NSPEC) S NSPEC=" BLANK"
|
|
Q:NRPT=1!(NRPT=7)&(NSPEC=" BLANK")
|
|
I NRPT'=7,'NSP,NSPC'=NSPEC Q
|
|
D SETUPTL^NURAAGS1 Q
|