source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURAAGS0.m@ 1397

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