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