- NURSEPD0 ;HIRMFO/JH,RM-INDIVIDUAL M I DEFICIENCY BY EMPLOYEE NAME ;2/27/98 14:27
- ;;4.0;NURSING SERVICE;**3,7,9,13,16**;Apr 25, 1997
- EN1 S X=$G(^PRSE(452.7,1,"OFF")) Q:X=""!(X=1)
- S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
- S (NUROUT,NURQUEUE,NURSW1)=0
- S DATSEL="NS^N+" D DATSEL^NURSAGP2 G:$D(POUT) QUIT
- D EN1^NURSAUTL G:NUROUT=1 QUIT D EN10^NURSUT3($G(DUZ))
- S SSN=$P(^VA(200,DUZ,1),U,9),NDA=$O(^PRSPC("SSN",SSN,0))
- I NDA'>0 D G EN1
- . W !!?5,"No SSN found for this user or, no entry for"
- . W !?5,"this person in the PAID EMPLOYEE File (#450)."
- . Q
- I $G(NURSZAP)>7 S DA=$O(^NURSF(210,"B",DUZ,0)) G A
- NAME S DIC("S")="I '$D(^NURSF(210,""AC"",""R"",+Y)),+$$EN6^NURSUT3($G(Y))"
- D EN3^NURSAGP1 G:NUROUT!'(+Y>0) QUIT S NDA=$P(Y,U,2)
- S SSN=$P($G(^VA(200,NDA,1)),U,9) S:SSN="" SSN=U
- S NDA=$O(^PRSPC("SSN",SSN,0))
- I NDA'>0 D G NAME
- . W !!?5,"No SSN found for this person or, no entry for"
- . W !?5,"this person is found in the PAID EMPLOYEE File (#450)."
- . Q
- A S NAM=$P($G(^PRSPC(NDA,0)),U)
- W ! S ZTRTN="START^NURSEPD0",ZTDESC="INDIVIDUAL M.I. DEFICIENCY by EMPLOYEE NAME" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;DEFINE FISCAL YEAR DATE AND HEADERS FOR OUTPUT DATA REPORT
- K ^TMP("NURE",$J) U IO S (HOLD,COUNT)=0,NURS132=$S(IOM'<132:1,1:0)
- I (+NDA>0),$G(^PRSPC(NDA,0))'="" S SSN=$P(^PRSPC(NDA,0),U,9) I SSN'="" S VA200DA=$O(^VA(200,"SSN",SSN,0)) I VA200DA>0 D
- .W:$E(IOST)="C" "."
- .S DA=$O(^NURSF(210,"B",+VA200DA,0)) D EN3^NURSUT0 S NURNODE4=NOD1 I NURNODE4 D
- ..S NPWARD=$S($D(^NURSF(211.8,+NURNODE4,0))&+$P(^(0),U):$P(^(0),U),1:"")
- ..I '$D(NWRD)&('$D(NPWARD)) Q
- ..D EN7^NURSAUTL S NL1=$S(NPWARD="":" BLANK",1:$E(NPWARD,1,9))
- ..S NSCT=$S($P(^NURSF(211.8,NURNODE4,0),U,2)="":" BLANK",1:$P(^(0),U,2))
- ..S NAM=$P($G(^VA(200,VA200DA,0)),U),NAM=$S(NAM'="":NAM,1:"VA # "_VA200DA) K DROPDEAD
- ..S PRSPCD1=0 F S PRSPCD1=$O(^PRSPC(NDA,6,PRSPCD1)) Q:PRSPCD1'>0 D
- ...S NURS=$G(^PRSPC(NDA,6,PRSPCD1,0)),CLASSIEN=+NURS Q:CLASSIEN'>0
- ...Q:$S($P(NURS,U,3)'>0:1,$P(NURS,U,3)>YREND:1,$P(NURS,U,3)>DT:1,1:0)
- ...S CLASS=$G(^PRSE(452.1,CLASSIEN,0)) Q:CLASS=""
- ...I $P(CLASS,U,7)'="M" Q ; Only Mandatory Inservice
- ...S CLASSTXT=$P(CLASS,U),FREQ=+$P(CLASS,U,6)
- ...S CLASSTXT(0)=$S(NURS132:CLASSTXT,1:$E(CLASSTXT,1,25))
- ...S:CLASSTXT(0)="" CLASSTXT(0)=" BLANK"
- ...S DATE=+$O(^PRSE(452,"AA","M",VA200DA,CLASSTXT,0))
- ...I FREQ=0,DATE Q ;ONE TIME ONLY CLASS
- ...S LASTDATE=$S(DATE:9999999-DATE\1,1:0)
- ...I $E(LASTDATE,6,7)="00" D
- ....N MONTH,YEAR
- ....S MONTH=+$E(LASTDATE,4,5),YEAR=1700+$E(LASTDATE,1,3)
- ....S LASTDAY=$S(YEAR#400=0:1,YEAR#4=0&'(YEAR#100=0):1,1:0)
- ....S LASTDAY=$P("31^"_(28+LASTDAY)_"^31^30^31^30^31^31^30^31^30^31",U,MONTH)
- ....S LASTDATE=$E(LASTDATE,1,5)_LASTDAY
- ....Q
- ...S X1=LASTDATE,X2=FREQ*365.25 D C^%DTC
- ...S DROPDEAD=X
- ...I DROPDEAD>YREND Q
- ...I DROPDEAD'<YRST,DROPDEAD'>YREND,DROPDEAD'<DT Q
- ...S:$G(NURSORT)="" NURSORT=1
- ...N X S X=$G(^TMP("NURE",$J,"L",NL1,CLASSTXT))
- ...I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP("NURE",$J,"L",NL1,CLASSTXT)=X
- ...S ^TMP("NURE",$J,"L1",X,NSCT,NAM,DA)=DROPDEAD
- I $O(^TMP("NURE",$J,"L",""))="" D HDR^NURSEPD1 W !,NAM_" HAS NO DEFICIENCIES FOR THIS PERIOD" G QUIT
- I $O(^PRSPC(NDA,6,0))="" D HDR^NURSEPD1 W !,NAM_" HAS NO GROUPS/CLASSES ASSIGNED" G QUIT
- S NL1="" F S NL1=$O(^TMP("NURE",$J,"L",NL1)) Q:NL1=""!(NUROUT) S HOLD=1,CLASSTXT="" F S CLASSTXT=$O(^TMP("NURE",$J,"L",NL1,CLASSTXT)) Q:CLASSTXT=""!(NUROUT) S NURSORT=$G(^TMP("NURE",$J,"L",NL1,CLASSTXT)) I NURSORT D
- .S NSCT="" F NSCT=$O(^TMP("NURE",$J,"L1",NURSORT,NSCT)) Q:NSCT=""!NUROUT S NAM="" F S NAM=$O(^TMP("NURE",$J,"L1",NURSORT,NSCT,NAM)) Q:NAM=""!(NUROUT) S PRDA=0 F S PRDA=$O(^TMP("NURE",$J,"L1",NURSORT,NSCT,NAM,PRDA)) Q:PRDA'>0!(NUROUT) D
- ..D:($Y>(IOSL-4))!'(NURSW1) HDR^NURSEPD1 Q:NUROUT
- ..S DROPDEAD=$G(^TMP("NURE",$J,"L1",NURSORT,NSCT,NAM,PRDA))
- ..W ! W:HOLD=1 $S(NURS132:NAM,1:$E(NAM,1,30))
- ..S NSCT(1)=$S(NSCT="C":"CK",NSCT="L":"LPN",NSCT="R":"RN",NSCT="O":"OT",NSCT="S":"SE",NSCT="A":"AO",NSCT="N":"NA",1:" ") W:HOLD=1 " "_NSCT(1)
- ..W:NL1'=" BLANK"&HOLD=1 ?$S(NURS132:46,1:25),$E(NL1,1,$S(NURS132:22,1:14))
- ..W:$G(DROPDEAD)>0 ?$S(NURS132:57,1:35),$$FMTE^XLFDT(DROPDEAD,2)
- ..W:CLASSTXT'=" BLANK" ?$S(NURS132:79,1:47),$S(NURS132:CLASSTXT,1:$E(CLASSTXT,1,33))
- ..S HOLD=0
- QUIT ; KILL ALL LOCAL VARIABLES
- K ^TMP("NURE",$J) D CLOSE^NURSUT1,^NURSKILL
- K NTODAY,NSTATUS Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSEPD0 4419 printed Feb 18, 2025@23:48:30 Page 2
- NURSEPD0 ;HIRMFO/JH,RM-INDIVIDUAL M I DEFICIENCY BY EMPLOYEE NAME ;2/27/98 14:27
- +1 ;;4.0;NURSING SERVICE;**3,7,9,13,16**;Apr 25, 1997
- EN1 SET X=$GET(^PRSE(452.7,1,"OFF"))
- if X=""!(X=1)
- QUIT
- +1 SET X=$GET(^DIC(213.9,1,"OFF"))
- if X=""!(X=1)
- QUIT
- +2 SET (NUROUT,NURQUEUE,NURSW1)=0
- +3 SET DATSEL="NS^N+"
- DO DATSEL^NURSAGP2
- if $DATA(POUT)
- GOTO QUIT
- +4 DO EN1^NURSAUTL
- if NUROUT=1
- GOTO QUIT
- DO EN10^NURSUT3($GET(DUZ))
- +5 SET SSN=$PIECE(^VA(200,DUZ,1),U,9)
- SET NDA=$ORDER(^PRSPC("SSN",SSN,0))
- +6 IF NDA'>0
- Begin DoDot:1
- +7 WRITE !!?5,"No SSN found for this user or, no entry for"
- +8 WRITE !?5,"this person in the PAID EMPLOYEE File (#450)."
- +9 QUIT
- End DoDot:1
- GOTO EN1
- +10 IF $GET(NURSZAP)>7
- SET DA=$ORDER(^NURSF(210,"B",DUZ,0))
- GOTO A
- NAME SET DIC("S")="I '$D(^NURSF(210,""AC"",""R"",+Y)),+$$EN6^NURSUT3($G(Y))"
- +1 DO EN3^NURSAGP1
- if NUROUT!'(+Y>0)
- GOTO QUIT
- SET NDA=$PIECE(Y,U,2)
- +2 SET SSN=$PIECE($GET(^VA(200,NDA,1)),U,9)
- if SSN=""
- SET SSN=U
- +3 SET NDA=$ORDER(^PRSPC("SSN",SSN,0))
- +4 IF NDA'>0
- Begin DoDot:1
- +5 WRITE !!?5,"No SSN found for this person or, no entry for"
- +6 WRITE !?5,"this person is found in the PAID EMPLOYEE File (#450)."
- +7 QUIT
- End DoDot:1
- GOTO NAME
- A SET NAM=$PIECE($GET(^PRSPC(NDA,0)),U)
- +1 WRITE !
- SET ZTRTN="START^NURSEPD0"
- SET ZTDESC="INDIVIDUAL M.I. DEFICIENCY by EMPLOYEE NAME"
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QUIT
- START ;DEFINE FISCAL YEAR DATE AND HEADERS FOR OUTPUT DATA REPORT
- +1 KILL ^TMP("NURE",$JOB)
- USE IO
- SET (HOLD,COUNT)=0
- SET NURS132=$SELECT(IOM'<132:1,1:0)
- +2 IF (+NDA>0)
- IF $GET(^PRSPC(NDA,0))'=""
- SET SSN=$PIECE(^PRSPC(NDA,0),U,9)
- IF SSN'=""
- SET VA200DA=$ORDER(^VA(200,"SSN",SSN,0))
- IF VA200DA>0
- Begin DoDot:1
- +3 if $EXTRACT(IOST)="C"
- WRITE "."
- +4 SET DA=$ORDER(^NURSF(210,"B",+VA200DA,0))
- DO EN3^NURSUT0
- SET NURNODE4=NOD1
- IF NURNODE4
- Begin DoDot:2
- +5 SET NPWARD=$SELECT($DATA(^NURSF(211.8,+NURNODE4,0))&+$PIECE(^(0),U):$PIECE(^(0),U),1:"")
- +6 IF '$DATA(NWRD)&('$DATA(NPWARD))
- QUIT
- +7 DO EN7^NURSAUTL
- SET NL1=$SELECT(NPWARD="":" BLANK",1:$EXTRACT(NPWARD,1,9))
- +8 SET NSCT=$SELECT($PIECE(^NURSF(211.8,NURNODE4,0),U,2)="":" BLANK",1:$PIECE(^(0),U,2))
- +9 SET NAM=$PIECE($GET(^VA(200,VA200DA,0)),U)
- SET NAM=$SELECT(NAM'="":NAM,1:"VA # "_VA200DA)
- KILL DROPDEAD
- +10 SET PRSPCD1=0
- FOR
- SET PRSPCD1=$ORDER(^PRSPC(NDA,6,PRSPCD1))
- if PRSPCD1'>0
- QUIT
- Begin DoDot:3
- +11 SET NURS=$GET(^PRSPC(NDA,6,PRSPCD1,0))
- SET CLASSIEN=+NURS
- if CLASSIEN'>0
- QUIT
- +12 if $SELECT($PIECE(NURS,U,3)'>0
- QUIT
- +13 SET CLASS=$GET(^PRSE(452.1,CLASSIEN,0))
- if CLASS=""
- QUIT
- +14 ; Only Mandatory Inservice
- IF $PIECE(CLASS,U,7)'="M"
- QUIT
- +15 SET CLASSTXT=$PIECE(CLASS,U)
- SET FREQ=+$PIECE(CLASS,U,6)
- +16 SET CLASSTXT(0)=$SELECT(NURS132:CLASSTXT,1:$EXTRACT(CLASSTXT,1,25))
- +17 if CLASSTXT(0)=""
- SET CLASSTXT(0)=" BLANK"
- +18 SET DATE=+$ORDER(^PRSE(452,"AA","M",VA200DA,CLASSTXT,0))
- +19 ;ONE TIME ONLY CLASS
- IF FREQ=0
- IF DATE
- QUIT
- +20 SET LASTDATE=$SELECT(DATE:9999999-DATE\1,1:0)
- +21 IF $EXTRACT(LASTDATE,6,7)="00"
- Begin DoDot:4
- +22 NEW MONTH,YEAR
- +23 SET MONTH=+$EXTRACT(LASTDATE,4,5)
- SET YEAR=1700+$EXTRACT(LASTDATE,1,3)
- +24 SET LASTDAY=$SELECT(YEAR#400=0:1,YEAR#4=0&'(YEAR#100=0):1,1:0)
- +25 SET LASTDAY=$PIECE("31^"_(28+LASTDAY)_"^31^30^31^30^31^31^30^31^30^31",U,MONTH)
- +26 SET LASTDATE=$EXTRACT(LASTDATE,1,5)_LASTDAY
- +27 QUIT
- End DoDot:4
- +28 SET X1=LASTDATE
- SET X2=FREQ*365.25
- DO C^%DTC
- +29 SET DROPDEAD=X
- +30 IF DROPDEAD>YREND
- QUIT
- +31 IF DROPDEAD'<YRST
- IF DROPDEAD'>YREND
- IF DROPDEAD'<DT
- QUIT
- +32 if $GET(NURSORT)=""
- SET NURSORT=1
- +33 NEW X
- SET X=$GET(^TMP("NURE",$JOB,"L",NL1,CLASSTXT))
- +34 IF X=""
- SET X=NURSORT
- SET NURSORT=NURSORT+1
- SET ^TMP("NURE",$JOB,"L",NL1,CLASSTXT)=X
- +35 SET ^TMP("NURE",$JOB,"L1",X,NSCT,NAM,DA)=DROPDEAD
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +36 IF $ORDER(^TMP("NURE",$JOB,"L",""))=""
- DO HDR^NURSEPD1
- WRITE !,NAM_" HAS NO DEFICIENCIES FOR THIS PERIOD"
- GOTO QUIT
- +37 IF $ORDER(^PRSPC(NDA,6,0))=""
- DO HDR^NURSEPD1
- WRITE !,NAM_" HAS NO GROUPS/CLASSES ASSIGNED"
- GOTO QUIT
- +38 SET NL1=""
- FOR
- SET NL1=$ORDER(^TMP("NURE",$JOB,"L",NL1))
- if NL1=""!(NUROUT)
- QUIT
- SET HOLD=1
- SET CLASSTXT=""
- FOR
- SET CLASSTXT=$ORDER(^TMP("NURE",$JOB,"L",NL1,CLASSTXT))
- if CLASSTXT=""!(NUROUT)
- QUIT
- SET NURSORT=$GET(^TMP("NURE",$JOB,"L",NL1,CLASSTXT))
- IF NURSORT
- Begin DoDot:1
- +39 SET NSCT=""
- FOR NSCT=$ORDER(^TMP("NURE",$JOB,"L1",NURSORT,NSCT))
- if NSCT=""!NUROUT
- QUIT
- SET NAM=""
- FOR
- SET NAM=$ORDER(^TMP("NURE",$JOB,"L1",NURSORT,NSCT,NAM))
- if NAM=""!(NUROUT)
- QUIT
- SET PRDA=0
- FOR
- SET PRDA=$ORDER(^TMP("NURE",$JOB,"L1",NURSORT,NSCT,NAM,PRDA))
- if PRDA'>0!(NUROUT)
- QUIT
- Begin DoDot:2
- +40 if ($Y>(IOSL-4))!'(NURSW1)
- DO HDR^NURSEPD1
- if NUROUT
- QUIT
- +41 SET DROPDEAD=$GET(^TMP("NURE",$JOB,"L1",NURSORT,NSCT,NAM,PRDA))
- +42 WRITE !
- if HOLD=1
- WRITE $SELECT(NURS132:NAM,1:$EXTRACT(NAM,1,30))
- +43 SET NSCT(1)=$SELECT(NSCT="C":"CK",NSCT="L":"LPN",NSCT="R":"RN",NSCT="O":"OT",NSCT="S":"SE",NSCT="A":"AO",NSCT="N":"NA",1:" ")
- if HOLD=1
- WRITE " "_NSCT(1)
- +44 if NL1'=" BLANK"&HOLD=1
- WRITE ?$SELECT(NURS132:46,1:25),$EXTRACT(NL1,1,$SELECT(NURS132:22,1:14))
- +45 if $GET(DROPDEAD)>0
- WRITE ?$SELECT(NURS132:57,1:35),$$FMTE^XLFDT(DROPDEAD,2)
- +46 if CLASSTXT'=" BLANK"
- WRITE ?$SELECT(NURS132:79,1:47),$SELECT(NURS132:CLASSTXT,1:$EXTRACT(CLASSTXT,1,33))
- +47 SET HOLD=0
- End DoDot:2
- End DoDot:1
- QUIT ; KILL ALL LOCAL VARIABLES
- +1 KILL ^TMP("NURE",$JOB)
- DO CLOSE^NURSUT1
- DO ^NURSKILL
- +2 KILL NTODAY,NSTATUS
- QUIT
