- 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
- 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
