96 lines
5.4 KiB
Mathematica
96 lines
5.4 KiB
Mathematica
|
NURSEPD2 ;HIRMFO/JH,RM-INCOMPLETE NURS M I REPORT (BY CLASS) PART 1 OF 2 ;3/19/98 13:28
|
||
|
;;4.0;NURSING SERVICE;**2,3,10,9**;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 (NONE,NUROUT,NURQUEUE,NURSW1)=0 D EN1^NURSAUTL G QUIT:$G(NUROUT)
|
||
|
I NURPLSW=1 D EN13^NURSAGSP G:$G(NUROUT) QUIT
|
||
|
I NURMDSW S DIC(0)="AEMQZ",NURPLSCR=1 D EN5^NURSAGSP K NURPLSCR G:$G(NUROUT) QUIT
|
||
|
I NURMDSW=0,NURPLSW=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
|
||
|
D EN10^NURSUT3($G(DUZ)) S DATSEL="NS^N+" D DATSEL^NURSAGP2 G:$G(NUROUT) QUIT
|
||
|
S NURSEL="M" D EN5^NURSAGP1 G:$G(NUROUT) QUIT
|
||
|
I NURPLSW=0!($G(NURSEL(1))=1)!($G(NURSEL(1))="") W ! D EN1^NURSAGSP G QUIT:$G(NUROUT)
|
||
|
I NURPLSW=1,$G(NURSEL(1))=2 W ! D EN3^NURSAGSP G QUIT:$G(NUROUT)
|
||
|
W ! S ZTRTN="START^NURSEPD2",ZTDESC="M.I. DEFICIENCY by SVC-CATEGORY/LOCATION-PROGRAM/CLASS" D EN7^NURSUT0 G QUIT:POP!($D(ZTSK))
|
||
|
START ;DEFINE OUTPUT DATE/HEADERS
|
||
|
S NURS132=$S(IOM'<132:1,1:0) K ^TMP("NURE",$J) U IO S (HOLD,HOLD1,HOLD2,COUNT)=0
|
||
|
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
|
||
|
D ^NURSEPD3
|
||
|
QUIT ;KILL LOCAL VARIABLES
|
||
|
K ^TMP("NURE",$J) D CLOSE^NURSUT1,^NURSKILL
|
||
|
K NURCLAS,NURD0,NURIEN Q
|
||
|
MAINLOOP ;
|
||
|
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
|
||
|
I $G(NURSEL(1))=1 D
|
||
|
.I $G(NURSPEC)="" S NONE=1 Q
|
||
|
.S NURDA=0 F S NURDA=$O(^NURSF(211.4,NURDA)) Q:NURDA'>0 I $G(^NURSF(211.4,+NURDA,"I"))="A" D
|
||
|
..S NPWARD=+$G(^NURSF(211.4,NURDA,0)) D EN7^NURSAUTL
|
||
|
..Q:NURSZAP>6&('$D(NURSZLO(NURDA)))
|
||
|
..I $G(NURHOSP)=0,'$D(NURSNLOC(NPWARD)) Q
|
||
|
..S NURSPEC=NPWARD D CHECK Q:NUROUT
|
||
|
..Q
|
||
|
.Q
|
||
|
Q
|
||
|
CHECK 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
|
||
|
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"
|
||
|
Q
|
||
|
SETMP S X(0)=$G(^PRSPC(PDA,0)),X(1)=$G(^(1)) Q:($P(X(1),U,33)="Y")
|
||
|
S PRSENAM=$P(X(0),U)
|
||
|
F NURNODE4=0:0 S NURNODE4=$O(^NURSF(211.8,"C",VA200DA,NURNODE4)) Q:NURNODE4'>0 D
|
||
|
.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
|
||
|
..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
|
||
|
Q
|
||
|
SORT ;
|
||
|
Q:NURSZAP>7&(NURSZDA'=DA) S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP Q:'NURSZORT
|
||
|
S NURNEN=$S($G(NURSEL(1))=2:1,1:3) D SETFAC^NURAAGS1,SETPROG^NURAAGS1,SETCAT^NURAAGS1,SETLOC^NURAAGS1
|
||
|
I NURMDSW,'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
|
||
|
I NURPLSW,'$G(NURPROG),$G(NURPROG(1))'=$G(NURPROG(2)) Q
|
||
|
S:NURPROG(2)="NURSING" NURPROG(2)=" "_NURPROG(2)
|
||
|
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
|
||
|
I $G(NURSEL(1))=1!($G(NURSEL(1))="") S NURSPEC=$S(NLOCN(1)="":" BLANK",1:NLOCN(1)),NURSPEC(1)=$$CAT^NURSUT2(NURSCATY)
|
||
|
I $G(NURSEL(1))=2 S NURSPEC=$$CAT^NURSUT2(NURSCATY),NURSPEC(1)=$S(NLOCN(1)="":" BLANK",1:NLOCN(1))
|
||
|
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
|
||
|
I $G(NURHOSP)=0,'$D(NURSNLOC(NURSPEC)) Q
|
||
|
S NAM=$S($P(^VA(200,VA200DA,0),U)'="":$P(^(0),U),1:" BLANK")
|
||
|
W:$E(IOST)="C" "."
|
||
|
F D1=0:0 S D1=$O(^PRSPC(PDA,6,D1)) Q:D1'>0 D
|
||
|
.K DROPDEAD
|
||
|
.S NURS=$G(^PRSPC(PDA,6,D1,0)),CLASSIEN=+$P(NURS,U) 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)
|
||
|
.I 'NSP,NSPC=CLASSTXT S ONELOC=1
|
||
|
.S CLASSTXT(0)=$S(NURS132:CLASSTXT,1:$E(CLASSTXT,1,39))
|
||
|
.S:CLASSTXT(0)="" CLASSTXT(0)=" BLANK"
|
||
|
.I 'NSP,NSPC'=CLASSTXT Q
|
||
|
.I NURSPEC]"",$G(^TMP("NURE",$J,"DA",DA))'>0 D
|
||
|
..S TMP=$G(^TMP("NURE",$J,"%",NURFAC(2),NURPROG(2),NURSPEC)) S:TMP="01" TMP=0 S $P(TMP,U)=$P(TMP,U)+1
|
||
|
..S ^TMP("NURE",$J,"%",NURFAC(2),NURPROG(2),NURSPEC)=TMP,^TMP("NURE",$J,"DA",DA)=1
|
||
|
..Q
|
||
|
.S DATE=$O(^PRSE(452,"AA","M",VA200DA,CLASSTXT,0))
|
||
|
.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 FREQ=0,DATE Q ; ONE TIME ONLY CLASS
|
||
|
.I DROPDEAD>YREND Q
|
||
|
.I DROPDEAD'<YRST,DROPDEAD'>YREND,DROPDEAD'<DT Q
|
||
|
.I $G(CLASSNUM)'>0 S CLASSNUM=1
|
||
|
.S CLASSNUM(0)=+$G(^TMP("NURE",$J,"SORT1",NURFAC(2),NURPROG(2),NURSPEC,NURSPEC(1)))
|
||
|
.I CLASSNUM(0)'>0 D
|
||
|
..S CLASSNUM(0)=CLASSNUM,CLASSNUM=CLASSNUM+1
|
||
|
..S ^TMP("NURE",$J,"SORT1",NURFAC(2),NURPROG(2),NURSPEC,NURSPEC(1))=CLASSNUM(0)
|
||
|
..Q
|
||
|
.S ^TMP("NURE",$J,"SORT2",CLASSNUM(0),PRSENAM,CLASSTXT(0))=DROPDEAD
|
||
|
.I NURSPEC]"",$G(^TMP("NURE",$J,"DA",DA))'>1 D
|
||
|
..S TMP=$G(^TMP("NURE",$J,"%",NURFAC(2),NURPROG(2),NURSPEC)),$P(TMP,U,2)=$P(TMP,U,2)+1
|
||
|
..S ^TMP("NURE",$J,"%",NURFAC(2),NURPROG(2),NURSPEC)=TMP,^TMP("NURE",$J,"DA",DA)=2
|
||
|
..Q
|
||
|
.Q
|
||
|
Q
|