source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURADEG.m@ 1427

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

initial load of WorldVistAEHR
File size: 5.2 KB
Line 
1NURADEG ;HIRMFO/JH,FT-LIST STAFFS' COMBINED NURSING AND ACADEMIC DEGREES ;11/20/96
2 ;;4.0;NURSING SERVICE;**13**;Apr 25, 1997
3EN1 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))
4 S NUROUT=0 D EN1^NURSAUTL G Q:$G(NUROUT)
5DEG W !!,"By (1) Location (2) Service or (3) Individual: " R DEG:DTIME I '$T!("^"[DEG) S NNOUT=1 Q
6 I DEG'>0!(DEG>3) W !!,$C(7),"Select Sort Parameter by choosing '1','2' or '3'" G DEG
7 I DEG'=3 D HSKEEP G Q:NUROUT
8 I DEG=1 G Q:$G(NUROUT) W ! D EN1^NURSAGSP G Q:$G(NUROUT)
9 I DEG=1!(DEG=2) D EN3^NURSAGSP G Q:$G(NUROUT)
10 I DEG=3 S DIC("S")="I +$$EN6^NURSUT3($G(Y)) S DA=+Y D EN2^NURSUT0 I ""^R^L^""[(U_NPSPOS(1)_U)"
11 I DEG=3 D EN3^NURSAGP1 G Q:$G(NUROUT)
12 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
13START ;
14 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)
15 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""")
16 S HEAD1="!,""COMBINED EDUCATIONAL REPORT BY "",TYPE,?61,NDATE,?72,""PAGE: "",NURPAGE"
17 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:""""),!"
18 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 !",!
19 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
20 I $O(^TMP($J,"LOC",""))'="",$D(NURSNLOC) D I NURSW=1 D ENDPG^NURSUT1 S NURSW=0
21 . 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)=""
22 . S NL1="" F S NL1=$O(NURSNLOC(NL1)) Q:NL1="" I '$D(^TMP("NURLOC",$J,NL1)) D
23 . . 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
24 . . Q
25 . Q
26 I $D(^TMP($J,"DEG")) D
27 .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
28 ..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
29 ...S DA=0 F S DA=$O(^TMP($J,"LOC",NURFAC,NURPROG,NL1,NPSPOS,DA)) Q:DA'>0 D DEGREE Q:NURQUIT
30 ...Q
31 ..Q
32 .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
33 ..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
34 ..Q
35 .I DEG=3 S TYP="",NL1="" D NHDR Q:NURQUIT D Q:NURQUIT
36 ..S DA=0 F I=0:0 S DA=$O(^TMP($J,"DEG",DA)) Q:DA'>0 D DEGREE Q:NURQUIT
37 ..Q
38 .Q
39 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
40 .W !,^TMP($J,"ERR",DA(1))
41 I $D(^TMP($J,"ERR")) W !?19,"( NOTIFY YOUR IRM PERSONNEL. )"
42Q K ^TMP($J) D CLOSE^NURSUT1,^NURAKILL
43 Q
44MSG1 S ^TMP($J,"ERR",DA(1))="*** STAFF WITH DUZ "_DA(1)_" FOUND IN NURSTAFF FILE IS NOT IN NEW PERSON FILE!" S NUROUT=1
45 Q
46DEGREE S NURANAM="" F S NURANAM=$O(^TMP($J,"DEG",DA,NURANAM)) Q:NURANAM="" D
47 .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
48 ..S II=0 F S II=$O(^TMP($J,"DEG",DA,NURANAM,NURASSN,II)) Q:II'>0 D
49 ...W ?44,$P(^TMP($J,"DEG",DA,NURANAM,NURASSN,II),U),?($X+2),$P(^(II),U,3),?($X+2),$P(^(II),U,4),!
50 ...Q
51 ..S NURANUR=$P($G(^TMP($J,"HIGH",DA)),U),NURAACA=$P($G(^(DA)),U,2)
52 ..W !,"--HIGHEST NURSING DEGREE--",?40,"--HIGHEST ACADEMIC DEGREE--"
53 ..W !,NURANUR,?40,NURAACA,!!
54 ..Q
55 .Q
56 Q
57CHKLINE I '($Y>(IOSL-8)) Q
58NHDR I 'NURQUIT,NURSW,$E(IOST)="C" D ENDPG^NURSUT1 S:$G(NUROUT) NURQUIT=+NUROUT Q:NURQUIT
59 S NURPAGE=NURPAGE+1 W:$E(IOST)="C"!(NURPAGE>1) @IOF
60 I $G(NURMDSW),$L($G(NURFAC))>1 W ?$$CNTR^NURSUT2($G(NURFAC)),$$FACL^NURSUT2($G(NURFAC))
61 W !,@HEAD1,!,?26,"SVC",@HEAD2 S NURSW=1
62PROD 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),!
63 Q
64HSKEEP I NURMDSW S DIC(0)="AEQZ",NURPLSCR=0 D EN5^NURSAGSP Q:$G(NUROUT)
65 I NURMDSW=0,NURPLSW=1 S NURPLSCR=0 D PRD^NURSAGSP K NURPLSCR
66 Q
67NODEGR ; NO DEGREE MESSAGE
68 W !!?19,"NO DEGREE(S) FOUND FOR "_NL1_"!"
69 Q
Note: See TracBrowser for help on using the repository browser.