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

NURADEG ;HIRMFO/JH,FT-LIST STAFFS' COMBINED NURSING AND ACADEMIC DEGREES ;11/20/96
 ;;4.0;NURSING SERVICE;**13**;Apr 25, 1997
EN1 Q:'$D(^DIC(213.9,1,"OFF"))  Q:$P(^DIC(213.9,1,"OFF"),U)=1  Q:'$D(^NURSF(210,0))!'$D(^NURSF(212.1,0))
 S NUROUT=0 D EN1^NURSAUTL G Q:$G(NUROUT)
DEG W !!,"By (1) Location (2) Service or (3) Individual:  " R DEG:DTIME I '$T!("^"[DEG) S NNOUT=1 Q
 I DEG'>0!(DEG>3) W !!,$C(7),"Select Sort Parameter by choosing '1','2' or '3'" G DEG
 I DEG'=3 D HSKEEP G Q:NUROUT
 I DEG=1 G Q:$G(NUROUT) W ! D EN1^NURSAGSP G Q:$G(NUROUT)
 I DEG=1!(DEG=2) D EN3^NURSAGSP G Q:$G(NUROUT)
 I DEG=3 S DIC("S")="I +$$EN6^NURSUT3($G(Y)) S DA=+Y D EN2^NURSUT0 I ""^R^L^""[(U_NPSPOS(1)_U)"
 I DEG=3 D EN3^NURSAGP1 G Q:$G(NUROUT)
 W ! S ZTDESC=$S(DEG=1:"STAFF DISCREPANCIES by LOCATION",DEG=2:"STAFF DISCREPANCIES by SERVICE",1:"INDIVIDUAL STAFF DISCREPTIANCIES"),ZTRTN="START^NURADEG" D EN7^NURSUT0 G:POP!($D(ZTSK)) Q
START ;
 D NOW^%DTC S NDATE=%I(1)_"/"_%I(2)_"/"_$E(%I(3),2,3),(NURPAGE,NURQUIT,NURSW)=0,(TYP,NL1)="",$P(LINE,"- -",27)="" K ^TMP($J),^TMP("NURLOC",$J)
 D ^NURADEG1:DEG=1,^NURADEG2:DEG=2,^NURADEG3:DEG=3 S TYPE=$S(DEG=1:"LOCATION",DEG=2:"SERVICE",1:"INDIVIDUAL"),TYPE(1)=$S(DEG=1:"""CAT""",1:"""POS""")
 S HEAD1="!,""COMBINED  EDUCATIONAL  REPORT  BY  "",TYPE,?61,NDATE,?72,""PAGE: "",NURPAGE"
 S HEAD2="!,""EMPLOYEE NAME"",?26,"_TYPE(1)_",?34,""SSN"",?44,""DEGREE, CODE, PRIORITY"",!,""--------------------"",?26,""---"",?34,""---"",?44,""------  ----  --------"",!?3,TYP,$S(DEG=1&($G(TYP)'=""""):$G(NL1),DEG=2:$G(NPSPOS(1)),1:""""),!"
 I $O(^TMP($J,"DEG",""))="",'$D(NURSNLOC) S NURPROG=$S($G(NURPROG)=0:$G(NURPROG(1)),1:""),NURFAC=$S($G(NURFAC)=0:$G(NURFAC(1)),1:"") D NHDR W ?26,$$CAT^NURSUT2($G(NURSCAT)),!!,?19,"NO DEGREE(S) FOUND !",!
 I $O(^TMP($J,"DEG",""))="",$D(NURSNLOC) S NURPROG=$S($G(NURPROG)=0:$G(NURPROG(1)),1:""),NURFAC=$S($G(NURFAC)=0:$G(NURFAC(1)),1:"") D NHDR W ?26,$$CAT^NURSUT2($G(NURSCAT)) S NL1="" F  S NL1=$O(NURSNLOC(NL1)) Q:NL1=""  D NODEGR
 I $O(^TMP($J,"LOC",""))'="",$D(NURSNLOC) D  I NURSW=1 D ENDPG^NURSUT1 S NURSW=0
 .  S (NURY,NURZ,NURX)="" F  S NURY=$O(^TMP($J,"LOC",NURY)) Q:NURY=""  F  S NURZ=$O(^TMP($J,"LOC",NURY,NURZ)) Q:NURZ=""  F  S NURX=$O(^TMP($J,"LOC",NURY,NURZ,NURX)) Q:NURX=""  S ^TMP("NURLOC",$J,NURX)=""
 .  S NL1="" F  S NL1=$O(NURSNLOC(NL1)) Q:NL1=""  I '$D(^TMP("NURLOC",$J,NL1)) D
 .  .  S NURPROG=$S($G(NURPROG)=0:$G(NURPROG(1)),1:""),NURFAC=$S($G(NURFAC)=0:$G(NURFAC(1)),1:"") D:NURSW=0 NHDR W:NURSW=0 ?26,$$CAT^NURSUT2($G(NURSCAT)) S NURSW=1 D NODEGR
 .   .  Q
 .   Q
 I $D(^TMP($J,"DEG")) D
 .I $D(^TMP($J,"LOC")) S TYP="Location: ",NURFAC="" F  S NURFAC=$O(^TMP($J,"LOC",NURFAC)) Q:NURFAC=""  S NURPROG="" F  S NURPROG=$O(^TMP($J,"LOC",NURFAC,NURPROG)) Q:NURPROG=""  D  Q:NURQUIT
 ..S NL1="" F  S NL1=$O(^TMP($J,"LOC",NURFAC,NURPROG,NL1)) Q:NL1=""!(NURQUIT)  D NHDR Q:NURQUIT  S NPSPOS="" F  S NPSPOS=$O(^TMP($J,"LOC",NURFAC,NURPROG,NL1,NPSPOS)) Q:NPSPOS=""  S NPSPOS(1)=$$CAT^NURSUT2(NPSPOS) D  Q:NURQUIT
 ...S DA=0 F  S DA=$O(^TMP($J,"LOC",NURFAC,NURPROG,NL1,NPSPOS,DA)) Q:DA'>0  D DEGREE Q:NURQUIT
 ...Q
 ..Q
 .I $D(^TMP($J,"SER")) S TYP="Service Category: ",NURFAC="" F  S NURFAC=$O(^TMP($J,"SER",NURFAC)) Q:NURFAC=""  S NURPROG="" F  S NURPROG=$O(^TMP($J,"SER",NURFAC,NURPROG)) Q:NURPROG=""  D  Q:NURQUIT
 ..S NL1="" F  S NL1=$O(^TMP($J,"SER",NURFAC,NURPROG,NL1)) Q:NL1=""  S NPSPOS(1)=$$CAT^NURSUT2(NL1) D NHDR Q:NURQUIT  S DA=0 F  S DA=$O(^TMP($J,"SER",NURFAC,NURPROG,NL1,DA)) Q:DA'>0  D DEGREE Q:NURQUIT
 ..Q
 .I DEG=3 S TYP="",NL1="" D NHDR Q:NURQUIT   D  Q:NURQUIT
 ..S DA=0 F I=0:0 S DA=$O(^TMP($J,"DEG",DA)) Q:DA'>0  D DEGREE Q:NURQUIT
 ..Q
 .Q
 I $D(^TMP($J,"ERR")) W ! F DA(1)=0:0 S DA(1)=$O(^TMP($J,"ERR",DA(1))) Q:DA(1)'>0  D
 .W !,^TMP($J,"ERR",DA(1))
 I $D(^TMP($J,"ERR")) W !?19,"( NOTIFY YOUR IRM PERSONNEL. )"
Q K ^TMP($J) D CLOSE^NURSUT1,^NURAKILL
 Q
MSG1 S ^TMP($J,"ERR",DA(1))="*** STAFF WITH DUZ "_DA(1)_" FOUND IN NURSTAFF FILE IS NOT IN NEW PERSON FILE!" S NUROUT=1
 Q
DEGREE S NURANAM="" F  S NURANAM=$O(^TMP($J,"DEG",DA,NURANAM)) Q:NURANAM=""  D
 .S NURASSN=0 F  S NURASSN=$O(^TMP($J,"DEG",DA,NURANAM,NURASSN)) Q:NURASSN'>0  D CHKLINE Q:NURQUIT  W !,NURANAM,?26,$S(DEG=1:NPSPOS(1),1:$E($P(^TMP($J,"HIGH",DA),U,4),1,6)),?34,NURASSN D
 ..S II=0 F  S II=$O(^TMP($J,"DEG",DA,NURANAM,NURASSN,II)) Q:II'>0  D
 ...W ?44,$P(^TMP($J,"DEG",DA,NURANAM,NURASSN,II),U),?($X+2),$P(^(II),U,3),?($X+2),$P(^(II),U,4),!
 ...Q
 ..S NURANUR=$P($G(^TMP($J,"HIGH",DA)),U),NURAACA=$P($G(^(DA)),U,2)
 ..W !,"--HIGHEST NURSING DEGREE--",?40,"--HIGHEST ACADEMIC DEGREE--"
 ..W !,NURANUR,?40,NURAACA,!!
 ..Q
 .Q
 Q
CHKLINE I '($Y>(IOSL-8)) Q
NHDR I 'NURQUIT,NURSW,$E(IOST)="C" D ENDPG^NURSUT1 S:$G(NUROUT) NURQUIT=+NUROUT Q:NURQUIT
 S NURPAGE=NURPAGE+1 W:$E(IOST)="C"!(NURPAGE>1) @IOF
 I $G(NURMDSW),$L($G(NURFAC))>1 W ?$$CNTR^NURSUT2($G(NURFAC)),$$FACL^NURSUT2($G(NURFAC))
 W !,@HEAD1,!,?26,"SVC",@HEAD2 S NURSW=1
PROD I $G(NURPLSW),$L($G(NURPROG))>1 N Z S Z=$$PROD^NURSUT2($G(NURPROG)) W:$G(Z)'="" ?$$CNTR^NURSUT2(NURPROG),$G(Z),!,?$$CNTR^NURSUT2(NURPROG),$$REPEAT^XLFSTR("-",$L(Z)+1),!
 Q
HSKEEP I NURMDSW S DIC(0)="AEQZ",NURPLSCR=0 D EN5^NURSAGSP Q:$G(NUROUT)
 I NURMDSW=0,NURPLSW=1 S NURPLSCR=0 D PRD^NURSAGSP K NURPLSCR
 Q
NODEGR ; NO DEGREE MESSAGE
 W !!?19,"NO DEGREE(S) FOUND FOR "_NL1_"!"
 Q