source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURSEPD2.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: 5.4 KB
Line 
1NURSEPD2 ;HIRMFO/JH,RM-INCOMPLETE NURS M I REPORT (BY CLASS) PART 1 OF 2 ;3/19/98 13:28
2 ;;4.0;NURSING SERVICE;**2,3,10,9**;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 (NONE,NUROUT,NURQUEUE,NURSW1)=0 D EN1^NURSAUTL G QUIT:$G(NUROUT)
6 I NURPLSW=1 D EN13^NURSAGSP G:$G(NUROUT) QUIT
7 I NURMDSW S DIC(0)="AEMQZ",NURPLSCR=1 D EN5^NURSAGSP K NURPLSCR G:$G(NUROUT) QUIT
8 I NURMDSW=0,NURPLSW=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
9 D EN10^NURSUT3($G(DUZ)) S DATSEL="NS^N+" D DATSEL^NURSAGP2 G:$G(NUROUT) QUIT
10 S NURSEL="M" D EN5^NURSAGP1 G:$G(NUROUT) QUIT
11 I NURPLSW=0!($G(NURSEL(1))=1)!($G(NURSEL(1))="") W ! D EN1^NURSAGSP G QUIT:$G(NUROUT)
12 I NURPLSW=1,$G(NURSEL(1))=2 W ! D EN3^NURSAGSP G QUIT:$G(NUROUT)
13 W ! S ZTRTN="START^NURSEPD2",ZTDESC="M.I. DEFICIENCY by SVC-CATEGORY/LOCATION-PROGRAM/CLASS" D EN7^NURSUT0 G QUIT:POP!($D(ZTSK))
14START ;DEFINE OUTPUT DATE/HEADERS
15 S NURS132=$S(IOM'<132:1,1:0) K ^TMP("NURE",$J) U IO S (HOLD,HOLD1,HOLD2,COUNT)=0
16 S DA=0 F S DA=$O(^NURSF(210,DA)) Q:DA'>0 I $P($G(^NURSF(210,DA,0)),U,2)'="R" D MAINLOOP
17 D ^NURSEPD3
18QUIT ;KILL LOCAL VARIABLES
19 K ^TMP("NURE",$J) D CLOSE^NURSUT1,^NURSKILL
20 K NURCLAS,NURD0,NURIEN Q
21MAINLOOP ;
22 S VA200DA=+$G(^NURSF(210,DA,0)),SSN=$P($G(^VA(200,VA200DA,1)),U,9) Q:$G(SSN)="" S PDA=$O(^PRSPC("SSN",SSN,0)) Q:$G(PDA)'>0 D SETMP
23 I $G(NURSEL(1))=1 D
24 .I $G(NURSPEC)="" S NONE=1 Q
25 .S NURDA=0 F S NURDA=$O(^NURSF(211.4,NURDA)) Q:NURDA'>0 I $G(^NURSF(211.4,+NURDA,"I"))="A" D
26 ..S NPWARD=+$G(^NURSF(211.4,NURDA,0)) D EN7^NURSAUTL
27 ..Q:NURSZAP>6&('$D(NURSZLO(NURDA)))
28 ..I $G(NURHOSP)=0,'$D(NURSNLOC(NPWARD)) Q
29 ..S NURSPEC=NPWARD D CHECK Q:NUROUT
30 ..Q
31 .Q
32 Q
33CHECK S NURFAC(2)=$$EN12^NURSUT3(NURDA),X=$P($G(^NURSF(211.4,+NURDA,1)),U,4),NURPROG(2)=$S($D(^NURSF(212.7,+X,0)):$P(^(0),U),1:" BLANK") S:NURPROG(2)="NURSING" NURPROG(2)=" NURSING" I NURFAC(2)=" BLANK"!(NURPROG(2))=" BLANK" S NUROUT=1 Q
34 I $G(NSP)!($G(NSP)'>0&(NURSPEC'="")),'$D(^TMP("NURE",$J,"SORT1",NURFAC(2),NURPROG(2),NURSPEC)) S ^(NURSPEC)="",^TMP("NURE",$J,"%",NURFAC(2),NURPROG(2),NURSPEC)="01"
35 Q
36SETMP S X(0)=$G(^PRSPC(PDA,0)),X(1)=$G(^(1)) Q:($P(X(1),U,33)="Y")
37 S PRSENAM=$P(X(0),U)
38 F NURNODE4=0:0 S NURNODE4=$O(^NURSF(211.8,"C",VA200DA,NURNODE4)) Q:NURNODE4'>0 D
39 .F NURNODE5=0:0 S NURNODE5=$O(^NURSF(211.8,"C",VA200DA,NURNODE4,NURNODE5)) Q:NURNODE5'>0 I $D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),$P(^(0),U)'>DT&(('$P(^(0),U,6))!($P(^(0),U,6)'<DT)) D
40 ..S DA=$O(^NURSF(210,"B",VA200DA,0)) I $P($G(^NURSF(210,+DA,0)),U,2)'="",$P($G(^(0)),U,2)'="R" W:$R(500)&($E(IOST)="C") "." D SORT
41 Q
42SORT ;
43 Q:NURSZAP>7&(NURSZDA'=DA) S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP Q:'NURSZORT
44 S NURNEN=$S($G(NURSEL(1))=2:1,1:3) D SETFAC^NURAAGS1,SETPROG^NURAAGS1,SETCAT^NURAAGS1,SETLOC^NURAAGS1
45 I NURMDSW,'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
46 I NURPLSW,'$G(NURPROG),$G(NURPROG(1))'=$G(NURPROG(2)) Q
47 S:NURPROG(2)="NURSING" NURPROG(2)=" "_NURPROG(2)
48 S NURNODE4(1)=$S($D(^NURSF(211.4,"B",+NLOCN)):$O(^NURSF(211.4,"B",+NLOCN,0)),1:0) I $D(^NURSF(211.4,NURNODE4(1),"I")),^("I")'="A" Q
49 I $G(NURSEL(1))=1!($G(NURSEL(1))="") S NURSPEC=$S(NLOCN(1)="":" BLANK",1:NLOCN(1)),NURSPEC(1)=$$CAT^NURSUT2(NURSCATY)
50 I $G(NURSEL(1))=2 S NURSPEC=$$CAT^NURSUT2(NURSCATY),NURSPEC(1)=$S(NLOCN(1)="":" BLANK",1:NLOCN(1))
51 I NURNEN=1,$S($E(NURSCATY)'="O":'$D(^TMP("NURSCAT",$J,NURSCATY)),$P($G(NURSCATY),"O ",2)'="":'$D(^TMP("NURSCAT",$J,$E(NURSCATY,3,99))),$P($G(NURSCATY),"O ",2)="":'$D(^TMP("NURSCAT",$J,NURSCATY)),1:0) Q
52 I $G(NURHOSP)=0,'$D(NURSNLOC(NURSPEC)) Q
53 S NAM=$S($P(^VA(200,VA200DA,0),U)'="":$P(^(0),U),1:" BLANK")
54 W:$E(IOST)="C" "."
55 F D1=0:0 S D1=$O(^PRSPC(PDA,6,D1)) Q:D1'>0 D
56 .K DROPDEAD
57 .S NURS=$G(^PRSPC(PDA,6,D1,0)),CLASSIEN=+$P(NURS,U) Q:CLASSIEN'>0
58 .Q:$S($P(NURS,U,3)'>0:1,$P(NURS,U,3)>YREND:1,$P(NURS,U,3)>DT:1,1:0)
59 .S CLASS=$G(^PRSE(452.1,CLASSIEN,0)) Q:CLASS=""
60 .I $P(CLASS,U,7)'="M" Q ; Only Mandatory Inservice
61 .S CLASSTXT=$P(CLASS,U),FREQ=$P(CLASS,U,6)
62 .I 'NSP,NSPC=CLASSTXT S ONELOC=1
63 .S CLASSTXT(0)=$S(NURS132:CLASSTXT,1:$E(CLASSTXT,1,39))
64 .S:CLASSTXT(0)="" CLASSTXT(0)=" BLANK"
65 .I 'NSP,NSPC'=CLASSTXT Q
66 .I NURSPEC]"",$G(^TMP("NURE",$J,"DA",DA))'>0 D
67 ..S TMP=$G(^TMP("NURE",$J,"%",NURFAC(2),NURPROG(2),NURSPEC)) S:TMP="01" TMP=0 S $P(TMP,U)=$P(TMP,U)+1
68 ..S ^TMP("NURE",$J,"%",NURFAC(2),NURPROG(2),NURSPEC)=TMP,^TMP("NURE",$J,"DA",DA)=1
69 ..Q
70 .S DATE=$O(^PRSE(452,"AA","M",VA200DA,CLASSTXT,0))
71 .S LASTDATE=$S(DATE:9999999-DATE\1,1:0)
72 .I $E(LASTDATE,6,7)="00" D
73 ..N MONTH,YEAR
74 ..S MONTH=+$E(LASTDATE,4,5),YEAR=1700+$E(LASTDATE,1,3)
75 ..S LASTDAY=$S(YEAR#400=0:1,YEAR#4=0&'(YEAR#100=0):1,1:0)
76 ..S LASTDAY=$P("31^"_(28+LASTDAY)_"^31^30^31^30^31^31^30^31^30^31",U,MONTH)
77 ..S LASTDATE=$E(LASTDATE,1,5)_LASTDAY
78 ..Q
79 .S X1=LASTDATE,X2=FREQ*365.25 D C^%DTC S DROPDEAD=X
80 .I FREQ=0,DATE Q ; ONE TIME ONLY CLASS
81 .I DROPDEAD>YREND Q
82 .I DROPDEAD'<YRST,DROPDEAD'>YREND,DROPDEAD'<DT Q
83 .I $G(CLASSNUM)'>0 S CLASSNUM=1
84 .S CLASSNUM(0)=+$G(^TMP("NURE",$J,"SORT1",NURFAC(2),NURPROG(2),NURSPEC,NURSPEC(1)))
85 .I CLASSNUM(0)'>0 D
86 ..S CLASSNUM(0)=CLASSNUM,CLASSNUM=CLASSNUM+1
87 ..S ^TMP("NURE",$J,"SORT1",NURFAC(2),NURPROG(2),NURSPEC,NURSPEC(1))=CLASSNUM(0)
88 ..Q
89 .S ^TMP("NURE",$J,"SORT2",CLASSNUM(0),PRSENAM,CLASSTXT(0))=DROPDEAD
90 .I NURSPEC]"",$G(^TMP("NURE",$J,"DA",DA))'>1 D
91 ..S TMP=$G(^TMP("NURE",$J,"%",NURFAC(2),NURPROG(2),NURSPEC)),$P(TMP,U,2)=$P(TMP,U,2)+1
92 ..S ^TMP("NURE",$J,"%",NURFAC(2),NURPROG(2),NURSPEC)=TMP,^TMP("NURE",$J,"DA",DA)=2
93 ..Q
94 .Q
95 Q
Note: See TracBrowser for help on using the repository browser.