source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURSEPD0.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1NURSEPD0 ;HIRMFO/JH,RM-INDIVIDUAL M I DEFICIENCY BY EMPLOYEE NAME ;2/27/98 14:27
2 ;;4.0;NURSING SERVICE;**3,7,9,13,16**;Apr 25, 1997
3EN1 S X=$G(^PRSE(452.7,1,"OFF")) Q:X=""!(X=1)
4 S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
5 S (NUROUT,NURQUEUE,NURSW1)=0
6 S DATSEL="NS^N+" D DATSEL^NURSAGP2 G:$D(POUT) QUIT
7 D EN1^NURSAUTL G:NUROUT=1 QUIT D EN10^NURSUT3($G(DUZ))
8 S SSN=$P(^VA(200,DUZ,1),U,9),NDA=$O(^PRSPC("SSN",SSN,0))
9 I NDA'>0 D G EN1
10 . W !!?5,"No SSN found for this user or, no entry for"
11 . W !?5,"this person in the PAID EMPLOYEE File (#450)."
12 . Q
13 I $G(NURSZAP)>7 S DA=$O(^NURSF(210,"B",DUZ,0)) G A
14NAME S DIC("S")="I '$D(^NURSF(210,""AC"",""R"",+Y)),+$$EN6^NURSUT3($G(Y))"
15 D EN3^NURSAGP1 G:NUROUT!'(+Y>0) QUIT S NDA=$P(Y,U,2)
16 S SSN=$P($G(^VA(200,NDA,1)),U,9) S:SSN="" SSN=U
17 S NDA=$O(^PRSPC("SSN",SSN,0))
18 I NDA'>0 D G NAME
19 . W !!?5,"No SSN found for this person or, no entry for"
20 . W !?5,"this person is found in the PAID EMPLOYEE File (#450)."
21 . Q
22A S NAM=$P($G(^PRSPC(NDA,0)),U)
23 W ! S ZTRTN="START^NURSEPD0",ZTDESC="INDIVIDUAL M.I. DEFICIENCY by EMPLOYEE NAME" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
24START ;DEFINE FISCAL YEAR DATE AND HEADERS FOR OUTPUT DATA REPORT
25 K ^TMP("NURE",$J) U IO S (HOLD,COUNT)=0,NURS132=$S(IOM'<132:1,1:0)
26 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
27 .W:$E(IOST)="C" "."
28 .S DA=$O(^NURSF(210,"B",+VA200DA,0)) D EN3^NURSUT0 S NURNODE4=NOD1 I NURNODE4 D
29 ..S NPWARD=$S($D(^NURSF(211.8,+NURNODE4,0))&+$P(^(0),U):$P(^(0),U),1:"")
30 ..I '$D(NWRD)&('$D(NPWARD)) Q
31 ..D EN7^NURSAUTL S NL1=$S(NPWARD="":" BLANK",1:$E(NPWARD,1,9))
32 ..S NSCT=$S($P(^NURSF(211.8,NURNODE4,0),U,2)="":" BLANK",1:$P(^(0),U,2))
33 ..S NAM=$P($G(^VA(200,VA200DA,0)),U),NAM=$S(NAM'="":NAM,1:"VA # "_VA200DA) K DROPDEAD
34 ..S PRSPCD1=0 F S PRSPCD1=$O(^PRSPC(NDA,6,PRSPCD1)) Q:PRSPCD1'>0 D
35 ...S NURS=$G(^PRSPC(NDA,6,PRSPCD1,0)),CLASSIEN=+NURS Q:CLASSIEN'>0
36 ...Q:$S($P(NURS,U,3)'>0:1,$P(NURS,U,3)>YREND:1,$P(NURS,U,3)>DT:1,1:0)
37 ...S CLASS=$G(^PRSE(452.1,CLASSIEN,0)) Q:CLASS=""
38 ...I $P(CLASS,U,7)'="M" Q ; Only Mandatory Inservice
39 ...S CLASSTXT=$P(CLASS,U),FREQ=+$P(CLASS,U,6)
40 ...S CLASSTXT(0)=$S(NURS132:CLASSTXT,1:$E(CLASSTXT,1,25))
41 ...S:CLASSTXT(0)="" CLASSTXT(0)=" BLANK"
42 ...S DATE=+$O(^PRSE(452,"AA","M",VA200DA,CLASSTXT,0))
43 ...I FREQ=0,DATE Q ;ONE TIME ONLY CLASS
44 ...S LASTDATE=$S(DATE:9999999-DATE\1,1:0)
45 ...I $E(LASTDATE,6,7)="00" D
46 ....N MONTH,YEAR
47 ....S MONTH=+$E(LASTDATE,4,5),YEAR=1700+$E(LASTDATE,1,3)
48 ....S LASTDAY=$S(YEAR#400=0:1,YEAR#4=0&'(YEAR#100=0):1,1:0)
49 ....S LASTDAY=$P("31^"_(28+LASTDAY)_"^31^30^31^30^31^31^30^31^30^31",U,MONTH)
50 ....S LASTDATE=$E(LASTDATE,1,5)_LASTDAY
51 ....Q
52 ...S X1=LASTDATE,X2=FREQ*365.25 D C^%DTC
53 ...S DROPDEAD=X
54 ...I DROPDEAD>YREND Q
55 ...I DROPDEAD'<YRST,DROPDEAD'>YREND,DROPDEAD'<DT Q
56 ...S:$G(NURSORT)="" NURSORT=1
57 ...N X S X=$G(^TMP("NURE",$J,"L",NL1,CLASSTXT))
58 ...I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP("NURE",$J,"L",NL1,CLASSTXT)=X
59 ...S ^TMP("NURE",$J,"L1",X,NSCT,NAM,DA)=DROPDEAD
60 I $O(^TMP("NURE",$J,"L",""))="" D HDR^NURSEPD1 W !,NAM_" HAS NO DEFICIENCIES FOR THIS PERIOD" G QUIT
61 I $O(^PRSPC(NDA,6,0))="" D HDR^NURSEPD1 W !,NAM_" HAS NO GROUPS/CLASSES ASSIGNED" G QUIT
62 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
63 .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
64 ..D:($Y>(IOSL-4))!'(NURSW1) HDR^NURSEPD1 Q:NUROUT
65 ..S DROPDEAD=$G(^TMP("NURE",$J,"L1",NURSORT,NSCT,NAM,PRDA))
66 ..W ! W:HOLD=1 $S(NURS132:NAM,1:$E(NAM,1,30))
67 ..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)
68 ..W:NL1'=" BLANK"&HOLD=1 ?$S(NURS132:46,1:25),$E(NL1,1,$S(NURS132:22,1:14))
69 ..W:$G(DROPDEAD)>0 ?$S(NURS132:57,1:35),$$FMTE^XLFDT(DROPDEAD,2)
70 ..W:CLASSTXT'=" BLANK" ?$S(NURS132:79,1:47),$S(NURS132:CLASSTXT,1:$E(CLASSTXT,1,33))
71 ..S HOLD=0
72QUIT ; KILL ALL LOCAL VARIABLES
73 K ^TMP("NURE",$J) D CLOSE^NURSUT1,^NURSKILL
74 K NTODAY,NSTATUS Q
Note: See TracBrowser for help on using the repository browser.