NURSHIGH ;HIRMFO/JH-LIST STAFF HIGHEST DEGREES ;4/21/94
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 Q:'$D(^NURSF(210,0))!'$D(^NURSF(212.1,0))
W ! S ZTDESC="STAFF DESCRIPANCIES",ZTRTN="START^NURSHIGH" D QUEUE Q
START D NOW^%DTC S NDATE=%I(1)_"/"_%I(2)_"/"_$E(%I(3),2,3),NUROUT="",$P(NURASTR,"*",IOM-5)="" K ^TMP($J),^TMP("NURHIGH",$J),^TMP("NURERR",$J)
F DA(1)=0:0 S DA(1)=$O(^NURSF(210,"B",DA(1))) Q:DA(1)'>0 D:'$D(^VA(200,DA(1),0)) MSG1 Q:NUROUT D
. F DA=0:0 S DA=$O(^NURSF(210,"B",DA(1),DA)) Q:DA'>0 D
.. S II=0 F I=0:0 S II=$O(^NURSF(210,DA,6,II)) Q:II'>0 D
... S NURAH=^NURSF(212.1,$P(^NURSF(210,DA,6,II,0),U),0),NURASSN=$P($G(^VA(200,DA(1),1)),U,9),^TMP($J,$P(^VA(200,DA(1),0),U),$S(NURASSN'="":NURASSN,1:999999999),DA,II)=NURAH
... Q
.. S NURAHIGH=$G(^NURSF(210,DA,17)) Q:'$P(NURAHIGH,U)&('$P(NURAHIGH,U,2)) S (NURANUR,NURAACA)="" D
... I $P(NURAHIGH,U)'="" S NURANUR=$P($G(^NURSF(212.1,$P(NURAHIGH,U),0)),U)
... I $P(NURAHIGH,U,2)'="" S NURAACA=$P($G(^NURSF(212.1,$P(NURAHIGH,U,2),0)),U)
... S:$D(NURANUR)!($D(NURAACA)) ^TMP("NURHIGH",$J,DA)=NURANUR_U_NURAACA
... Q
.. Q
. Q
I $D(^TMP($J)) D
. W !?10,"***STAFF'S NURSING AND ACADERMIC DEGREES***",?67,NDATE,!!,"STAFF NAME",?26,"SSN",?38,"DEGREE,CODE,PRIORITY",!,"---------",?26,"---",?38,"--------------------",! D
.. S NURANAM="" F I=0:0 S NURANAM=$O(^TMP($J,NURANAM)) Q:NURANAM="" D
... S NURASSN=0 F I=0:0 S NURASSN=$O(^TMP($J,NURANAM,NURASSN)) Q:NURASSN'>0 W !,NURANAM,?26,NURASSN D
.... S DA=0 F I=0:0 S DA=$O(^TMP($J,NURANAM,NURASSN,DA)) Q:DA'>0 D
..... S II=0 F I=0:0 S II=$O(^TMP($J,NURANAM,NURASSN,DA,II)) Q:II'>0 D
...... W ?38,$P(^TMP($J,NURANAM,NURASSN,DA,II),U),?($X+2),$P(^(II),U,3),?($X+2),$P(^(II),U,4),!
...... Q
..... S NURANUR=$P($G(^TMP("NURHIGH",$J,DA)),U),NURAACA=$P($G(^(DA)),U,2)
..... W !,"--HIGHEST NURSING DEGREE--",?40,"--HIGHEST ACADERMIC DEGREE--"
..... W !,NURANUR,?40,NURAACA,!,NURASTR
..... Q
.... Q
... Q
.. Q
. Q
I $D(^TMP("NURERR",$J)) W ! F DA(1)=0:0 S DA(1)=$O(^TMP("NURERR",$J,DA(1))) Q:DA(1)'>0 D
. W !,^TMP("NURERR",$J,DA(1))
. Q
I $D(^TMP("NURERR",$J)) W !?19,"( NOTIFY YOUR IRM PERSONNEL. )"
K ^TMP($J),^TMP("NURHIGH",$J),^TMP("NURERR",$J) D CLOSE^NURSUT1,^NURSKILL
Q
MSG1 S ^TMP("NURERR",$J,DA(1))="*** STAFF WITH DUZ "_DA(1)_" FOUND IN NURSTAFF FILE IS NOT IN NEW PERSON FILE!" S NUROUT=1
Q
QUEUE S %ZIS="Q",%ZIS("B")="",IOP="Q" D ^%ZIS K %ZIS K:POP IO("Q") Q:POP
I $D(IO("Q")) K IO("Q"),IO("C") S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL D ^%ZTLOAD S:'$D(ZTSK) POP=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSHIGH 2587 printed Dec 13, 2024@02:22:14 Page 2
NURSHIGH ;HIRMFO/JH-LIST STAFF HIGHEST DEGREES ;4/21/94
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 if '$DATA(^NURSF(210,0))!'$DATA(^NURSF(212.1,0))
QUIT
+1 WRITE !
SET ZTDESC="STAFF DESCRIPANCIES"
SET ZTRTN="START^NURSHIGH"
DO QUEUE
QUIT
START DO NOW^%DTC
SET NDATE=%I(1)_"/"_%I(2)_"/"_$EXTRACT(%I(3),2,3)
SET NUROUT=""
SET $PIECE(NURASTR,"*",IOM-5)=""
KILL ^TMP($JOB),^TMP("NURHIGH",$JOB),^TMP("NURERR",$JOB)
+1 FOR DA(1)=0:0
SET DA(1)=$ORDER(^NURSF(210,"B",DA(1)))
if DA(1)'>0
QUIT
if '$DATA(^VA(200,DA(1),0))
DO MSG1
if NUROUT
QUIT
Begin DoDot:1
+2 FOR DA=0:0
SET DA=$ORDER(^NURSF(210,"B",DA(1),DA))
if DA'>0
QUIT
Begin DoDot:2
+3 SET II=0
FOR I=0:0
SET II=$ORDER(^NURSF(210,DA,6,II))
if II'>0
QUIT
Begin DoDot:3
+4 SET NURAH=^NURSF(212.1,$PIECE(^NURSF(210,DA,6,II,0),U),0)
SET NURASSN=$PIECE($GET(^VA(200,DA(1),1)),U,9)
SET ^TMP($JOB,$PIECE(^VA(200,DA(1),0),U),$SELECT(NURASSN'="":NURASSN,1:999999999),DA,II)=NURAH
+5 QUIT
End DoDot:3
+6 SET NURAHIGH=$GET(^NURSF(210,DA,17))
if '$PIECE(NURAHIGH,U)&('$PIECE(NURAHIGH,U,2))
QUIT
SET (NURANUR,NURAACA)=""
Begin DoDot:3
+7 IF $PIECE(NURAHIGH,U)'=""
SET NURANUR=$PIECE($GET(^NURSF(212.1,$PIECE(NURAHIGH,U),0)),U)
+8 IF $PIECE(NURAHIGH,U,2)'=""
SET NURAACA=$PIECE($GET(^NURSF(212.1,$PIECE(NURAHIGH,U,2),0)),U)
+9 if $DATA(NURANUR)!($DATA(NURAACA))
SET ^TMP("NURHIGH",$JOB,DA)=NURANUR_U_NURAACA
+10 QUIT
End DoDot:3
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 IF $DATA(^TMP($JOB))
Begin DoDot:1
+14 WRITE !?10,"***STAFF'S NURSING AND ACADERMIC DEGREES***",?67,NDATE,!!,"STAFF NAME",?26,"SSN",?38,"DEGREE,CODE,PRIORITY",!,"---------",?26,"---",?38,"--------------------",!
Begin DoDot:2
+15 SET NURANAM=""
FOR I=0:0
SET NURANAM=$ORDER(^TMP($JOB,NURANAM))
if NURANAM=""
QUIT
Begin DoDot:3
+16 SET NURASSN=0
FOR I=0:0
SET NURASSN=$ORDER(^TMP($JOB,NURANAM,NURASSN))
if NURASSN'>0
QUIT
WRITE !,NURANAM,?26,NURASSN
Begin DoDot:4
+17 SET DA=0
FOR I=0:0
SET DA=$ORDER(^TMP($JOB,NURANAM,NURASSN,DA))
if DA'>0
QUIT
Begin DoDot:5
+18 SET II=0
FOR I=0:0
SET II=$ORDER(^TMP($JOB,NURANAM,NURASSN,DA,II))
if II'>0
QUIT
Begin DoDot:6
+19 WRITE ?38,$PIECE(^TMP($JOB,NURANAM,NURASSN,DA,II),U),?($X+2),$PIECE(^(II),U,3),?($X+2),$PIECE(^(II),U,4),!
+20 QUIT
End DoDot:6
+21 SET NURANUR=$PIECE($GET(^TMP("NURHIGH",$JOB,DA)),U)
SET NURAACA=$PIECE($GET(^(DA)),U,2)
+22 WRITE !,"--HIGHEST NURSING DEGREE--",?40,"--HIGHEST ACADERMIC DEGREE--"
+23 WRITE !,NURANUR,?40,NURAACA,!,NURASTR
+24 QUIT
End DoDot:5
+25 QUIT
End DoDot:4
+26 QUIT
End DoDot:3
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 IF $DATA(^TMP("NURERR",$JOB))
WRITE !
FOR DA(1)=0:0
SET DA(1)=$ORDER(^TMP("NURERR",$JOB,DA(1)))
if DA(1)'>0
QUIT
Begin DoDot:1
+30 WRITE !,^TMP("NURERR",$JOB,DA(1))
+31 QUIT
End DoDot:1
+32 IF $DATA(^TMP("NURERR",$JOB))
WRITE !?19,"( NOTIFY YOUR IRM PERSONNEL. )"
+33 KILL ^TMP($JOB),^TMP("NURHIGH",$JOB),^TMP("NURERR",$JOB)
DO CLOSE^NURSUT1
DO ^NURSKILL
+34 QUIT
MSG1 SET ^TMP("NURERR",$JOB,DA(1))="*** STAFF WITH DUZ "_DA(1)_" FOUND IN NURSTAFF FILE IS NOT IN NEW PERSON FILE!"
SET NUROUT=1
+1 QUIT
QUEUE SET %ZIS="Q"
SET %ZIS("B")=""
SET IOP="Q"
DO ^%ZIS
KILL %ZIS
if POP
KILL IO("Q")
if POP
QUIT
+1 IF $DATA(IO("Q"))
KILL IO("Q"),IO("C")
SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
DO ^%ZTLOAD
if '$DATA(ZTSK)
SET POP=1
+2 QUIT
