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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURADEG 5348 printed Dec 13, 2024@02:19:06 Page 2
NURADEG ;HIRMFO/JH,FT-LIST STAFFS' COMBINED NURSING AND ACADEMIC DEGREES ;11/20/96
+1 ;;4.0;NURSING SERVICE;**13**;Apr 25, 1997
EN1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),U)=1
QUIT
if '$DATA(^NURSF(210,0))!'$DATA(^NURSF(212.1,0))
QUIT
+1 SET NUROUT=0
DO EN1^NURSAUTL
if $GET(NUROUT)
GOTO Q
DEG WRITE !!,"By (1) Location (2) Service or (3) Individual: "
READ DEG:DTIME
IF '$TEST!("^"[DEG)
SET NNOUT=1
QUIT
+1 IF DEG'>0!(DEG>3)
WRITE !!,$CHAR(7),"Select Sort Parameter by choosing '1','2' or '3'"
GOTO DEG
+2 IF DEG'=3
DO HSKEEP
if NUROUT
GOTO Q
+3 IF DEG=1
if $GET(NUROUT)
GOTO Q
WRITE !
DO EN1^NURSAGSP
if $GET(NUROUT)
GOTO Q
+4 IF DEG=1!(DEG=2)
DO EN3^NURSAGSP
if $GET(NUROUT)
GOTO Q
+5 IF DEG=3
SET DIC("S")="I +$$EN6^NURSUT3($G(Y)) S DA=+Y D EN2^NURSUT0 I ""^R^L^""[(U_NPSPOS(1)_U)"
+6 IF DEG=3
DO EN3^NURSAGP1
if $GET(NUROUT)
GOTO Q
+7 WRITE !
SET ZTDESC=$SELECT(DEG=1:"STAFF DISCREPANCIES by LOCATION",DEG=2:"STAFF DISCREPANCIES by SERVICE",1:"INDIVIDUAL STAFF DISCREPTIANCIES")
SET ZTRTN="START^NURADEG"
DO EN7^NURSUT0
if POP!($DATA(ZTSK))
GOTO Q
START ;
+1 DO NOW^%DTC
SET NDATE=%I(1)_"/"_%I(2)_"/"_$EXTRACT(%I(3),2,3)
SET (NURPAGE,NURQUIT,NURSW)=0
SET (TYP,NL1)=""
SET $PIECE(LINE,"- -",27)=""
KILL ^TMP($JOB),^TMP("NURLOC",$JOB)
+2 if DEG=1
DO ^NURADEG1
if DEG=2
DO ^NURADEG2
if DEG=3
DO ^NURADEG3
SET TYPE=$SELECT(DEG=1:"LOCATION",DEG=2:"SERVICE",1:"INDIVIDUAL")
SET TYPE(1)=$SELECT(DEG=1:"""CAT""",1:"""POS""")
+3 SET HEAD1="!,""COMBINED EDUCATIONAL REPORT BY "",TYPE,?61,NDATE,?72,""PAGE: "",NURPAGE"
+4 SET 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:""""),!"
+5 IF $ORDER(^TMP($JOB,"DEG",""))=""
IF '$DATA(NURSNLOC)
SET NURPROG=$SELECT($GET(NURPROG)=0:$GET(NURPROG(1)),1:"")
SET NURFAC=$SELECT($GET(NURFAC)=0:$GET(NURFAC(1)),1:"")
DO NHDR
WRITE ?26,$$CAT^NURSUT2($GET(NURSCAT)),!!,?19,"NO DEGREE(S) FOUND !",!
+6 IF $ORDER(^TMP($JOB,"DEG",""))=""
IF $DATA(NURSNLOC)
SET NURPROG=$SELECT($GET(NURPROG)=0:$GET(NURPROG(1)),1:"")
SET NURFAC=$SELECT($GET(NURFAC)=0:$GET(NURFAC(1)),1:"")
DO NHDR
WRITE ?26,$$CAT^NURSUT2($GET(NURSCAT))
SET NL1=""
FOR
SET NL1=$ORDER(NURSNLOC(NL1))
if NL1=""
QUIT
DO NODEGR
+7 IF $ORDER(^TMP($JOB,"LOC",""))'=""
IF $DATA(NURSNLOC)
Begin DoDot:1
+8 SET (NURY,NURZ,NURX)=""
FOR
SET NURY=$ORDER(^TMP($JOB,"LOC",NURY))
if NURY=""
QUIT
FOR
SET NURZ=$ORDER(^TMP($JOB,"LOC",NURY,NURZ))
if NURZ=""
QUIT
FOR
SET NURX=$ORDER(^TMP($JOB,"LOC",NURY,NURZ,NURX))
if NURX=""
QUIT
SET ^TMP("NURLOC",$JOB,NURX)=""
+9 SET NL1=""
FOR
SET NL1=$ORDER(NURSNLOC(NL1))
if NL1=""
QUIT
IF '$DATA(^TMP("NURLOC",$JOB,NL1))
Begin DoDot:2
+10 SET NURPROG=$SELECT($GET(NURPROG)=0:$GET(NURPROG(1)),1:"")
SET NURFAC=$SELECT($GET(NURFAC)=0:$GET(NURFAC(1)),1:"")
if NURSW=0
DO NHDR
if NURSW=0
WRITE ?26,$$CAT^NURSUT2($GET(NURSCAT))
SET NURSW=1
DO NODEGR
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
IF NURSW=1
DO ENDPG^NURSUT1
SET NURSW=0
+13 IF $DATA(^TMP($JOB,"DEG"))
Begin DoDot:1
+14 IF $DATA(^TMP($JOB,"LOC"))
SET TYP="Location: "
SET NURFAC=""
FOR
SET NURFAC=$ORDER(^TMP($JOB,"LOC",NURFAC))
if NURFAC=""
QUIT
SET NURPROG=""
FOR
SET NURPROG=$ORDER(^TMP($JOB,"LOC",NURFAC,NURPROG))
if NURPROG=""
QUIT
Begin DoDot:2
+15 SET NL1=""
FOR
SET NL1=$ORDER(^TMP($JOB,"LOC",NURFAC,NURPROG,NL1))
if NL1=""!(NURQUIT)
QUIT
DO NHDR
if NURQUIT
QUIT
SET NPSPOS=""
FOR
SET NPSPOS=$ORDER(^TMP($JOB,"LOC",NURFAC,NURPROG,NL1,NPSPOS))
if NPSPOS=""
QUIT
SET NPSPOS(1)=$$CAT^NURSUT2(NPSPOS)
Begin DoDot:3
+16 SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,"LOC",NURFAC,NURPROG,NL1,NPSPOS,DA))
if DA'>0
QUIT
DO DEGREE
if NURQUIT
QUIT
+17 QUIT
End DoDot:3
if NURQUIT
QUIT
+18 QUIT
End DoDot:2
if NURQUIT
QUIT
+19 IF $DATA(^TMP($JOB,"SER"))
SET TYP="Service Category: "
SET NURFAC=""
FOR
SET NURFAC=$ORDER(^TMP($JOB,"SER",NURFAC))
if NURFAC=""
QUIT
SET NURPROG=""
FOR
SET NURPROG=$ORDER(^TMP($JOB,"SER",NURFAC,NURPROG))
if NURPROG=""
QUIT
Begin DoDot:2
+20 SET NL1=""
FOR
SET NL1=$ORDER(^TMP($JOB,"SER",NURFAC,NURPROG,NL1))
if NL1=""
QUIT
SET NPSPOS(1)=$$CAT^NURSUT2(NL1)
DO NHDR
if NURQUIT
QUIT
SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,"SER",NURFAC,NURPROG,NL1,DA))
if DA'>0
QUIT
DO DEGREE
if NURQUIT
QUIT
+21 QUIT
End DoDot:2
if NURQUIT
QUIT
+22 IF DEG=3
SET TYP=""
SET NL1=""
DO NHDR
if NURQUIT
QUIT
Begin DoDot:2
+23 SET DA=0
FOR I=0:0
SET DA=$ORDER(^TMP($JOB,"DEG",DA))
if DA'>0
QUIT
DO DEGREE
if NURQUIT
QUIT
+24 QUIT
End DoDot:2
if NURQUIT
QUIT
+25 QUIT
End DoDot:1
+26 IF $DATA(^TMP($JOB,"ERR"))
WRITE !
FOR DA(1)=0:0
SET DA(1)=$ORDER(^TMP($JOB,"ERR",DA(1)))
if DA(1)'>0
QUIT
Begin DoDot:1
+27 WRITE !,^TMP($JOB,"ERR",DA(1))
End DoDot:1
+28 IF $DATA(^TMP($JOB,"ERR"))
WRITE !?19,"( NOTIFY YOUR IRM PERSONNEL. )"
Q KILL ^TMP($JOB)
DO CLOSE^NURSUT1
DO ^NURAKILL
+1 QUIT
MSG1 SET ^TMP($JOB,"ERR",DA(1))="*** STAFF WITH DUZ "_DA(1)_" FOUND IN NURSTAFF FILE IS NOT IN NEW PERSON FILE!"
SET NUROUT=1
+1 QUIT
DEGREE SET NURANAM=""
FOR
SET NURANAM=$ORDER(^TMP($JOB,"DEG",DA,NURANAM))
if NURANAM=""
QUIT
Begin DoDot:1
+1 SET NURASSN=0
FOR
SET NURASSN=$ORDER(^TMP($JOB,"DEG",DA,NURANAM,NURASSN))
if NURASSN'>0
QUIT
DO CHKLINE
if NURQUIT
QUIT
WRITE !,NURANAM,?26,$SELECT(DEG=1:NPSPOS(1),1:$EXTRACT($PIECE(^TMP($JOB,"HIGH",DA),U,4),1,6)),?34,NURASSN
Begin DoDot:2
+2 SET II=0
FOR
SET II=$ORDER(^TMP($JOB,"DEG",DA,NURANAM,NURASSN,II))
if II'>0
QUIT
Begin DoDot:3
+3 WRITE ?44,$PIECE(^TMP($JOB,"DEG",DA,NURANAM,NURASSN,II),U),?($X+2),$PIECE(^(II),U,3),?($X+2),$PIECE(^(II),U,4),!
+4 QUIT
End DoDot:3
+5 SET NURANUR=$PIECE($GET(^TMP($JOB,"HIGH",DA)),U)
SET NURAACA=$PIECE($GET(^(DA)),U,2)
+6 WRITE !,"--HIGHEST NURSING DEGREE--",?40,"--HIGHEST ACADEMIC DEGREE--"
+7 WRITE !,NURANUR,?40,NURAACA,!!
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 QUIT
CHKLINE IF '($Y>(IOSL-8))
QUIT
NHDR IF 'NURQUIT
IF NURSW
IF $EXTRACT(IOST)="C"
DO ENDPG^NURSUT1
if $GET(NUROUT)
SET NURQUIT=+NUROUT
if NURQUIT
QUIT
+1 SET NURPAGE=NURPAGE+1
if $EXTRACT(IOST)="C"!(NURPAGE>1)
WRITE @IOF
+2 IF $GET(NURMDSW)
IF $LENGTH($GET(NURFAC))>1
WRITE ?$$CNTR^NURSUT2($GET(NURFAC)),$$FACL^NURSUT2($GET(NURFAC))
+3 WRITE !,@HEAD1,!,?26,"SVC",@HEAD2
SET NURSW=1
PROD IF $GET(NURPLSW)
IF $LENGTH($GET(NURPROG))>1
NEW Z
SET Z=$$PROD^NURSUT2($GET(NURPROG))
if $GET(Z)'=""
WRITE ?$$CNTR^NURSUT2(NURPROG),$GET(Z),!,?$$CNTR^NURSUT2(NURPROG),$$REPEAT^XLFSTR("-",$LENGTH(Z)+1),!
+1 QUIT
HSKEEP IF NURMDSW
SET DIC(0)="AEQZ"
SET NURPLSCR=0
DO EN5^NURSAGSP
if $GET(NUROUT)
QUIT
+1 IF NURMDSW=0
IF NURPLSW=1
SET NURPLSCR=0
DO PRD^NURSAGSP
KILL NURPLSCR
+2 QUIT
NODEGR ; NO DEGREE MESSAGE
+1 WRITE !!?19,"NO DEGREE(S) FOUND FOR "_NL1_"!"
+2 QUIT
