source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURAMU3.m@ 862

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

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1NURAMU3 ;HIRMFO/MD-EMPLOYEE ACT/SEP BATCH JOB 9/20/96 ; 4/29/03 11:23am
2 ;;4.0;NURSING SERVICE;**9,39**;Apr 25, 1997
3EN1 ;BATCH RUN TO UPDATE STAFF SEP/ACT DATA IN 213.5 FILE AND STATUS IF APPROPRIATE
4 S NURSDATE=RPTDATE,U="^" S:'$D(^DIC(213.9,1,"DATE")) ^DIC(213.9,1,"DATE")="" S $P(^DIC(213.9,1,"DATE"),U,9)=0
5 F NUX=0:0 S NUX=$O(^NURSF(211.8,"ASD",NUX)) Q:NUX'>0 F NOD=0:0 S NOD=$O(^NURSF(211.8,"ASD",NUX,NOD)) Q:NOD'>0 F NDA=0:0 S NDA=$O(^NURSF(211.8,"ASD",NUX,NOD,NDA)) Q:NDA'>0 I $D(^NURSF(211.8,NOD,1,NDA,0)) S NURSEMP=+$P(^(0),U,2) D NURSCK
6 S:'$D(^DIC(213.9,1,"DATE")) ^("DATE")="" S $P(^("DATE"),U,9)=1
7QUIT ;
8 K NEXCDA,NURSDATE,NUR,NURSPO,NURLOC,NURSEMP,NUX,DA,NOD,NDA,NURSDATE,%DT,NURSEL,I,X,Y Q
9NURSCK ;
10 W:'$D(ZTQUEUED) "." S DA(1)=NOD,DA=NDA
11 I +NUX=2,+$P(^NURSF(211.8,DA(1),1,DA,0),U)'>NURSDATE D NURSBYP S DA(1)=NOD,DA=NDA,X=+$P(^NURSF(211.8,DA(1),1,DA,0),U),NUR=".01^1" D EN1B^NURSUT1
12 I +NUX=1,+$P(^NURSF(211.8,DA(1),1,DA,0),U,6)'>NURSDATE D NURSBYP S DA(1)=NOD,DA=NDA,X=+$P(^NURSF(211.8,DA(1),1,DA,0),U,6),NUR="3^1" D EN1B^NURSUT1
13 Q
14NURSBYP ;
15 I '$D(^NURSA(213.5,NEXCDA,2,0)) S ^(0)="^213.52P^^"
16 S NURSPO=$G(^NURSF(211.8,NOD,0)),NURSPO(0)=$G(^NURSF(211.8,NOD,1,NDA,0)),NURLOC=$O(^NURSF(211.4,"B",+NURSPO,0))
17 S NURSPO(1)=$S($D(^VA(200,+NURSEMP,0)):+NURSEMP,1:""),NURSPO(2)=$S(NUX=1:"S",NUX=2:"A",1:"")
18 S NURSPO(3)=$S(NUX=1:$P(NURSPO(0),U,6),1:$P(NURSPO(0),U)),NURSPO(4)=$S($D(^NURSF(211.9,+$P(NURSPO(0),U,8),0)):+$P(NURSPO(0),U,8),1:""),NURSPO(5)=$S($D(^NURSF(211.3,+$P(NURSPO(0),U,3),0)):+$P(NURSPO(0),U,3),1:""),NURSPO(6)=+$P(NURSPO(0),U,4)
19 S DA(1)=NEXCDA,Z=$P(^NURSA(213.5,DA(1),2,0),U,3,4)
20 S DA=(+$P(Z,U)+1),^NURSA(213.5,DA(1),2,DA,0)=NURSPO(1)_U_NURSPO(2)_U_NURSPO(3)_U_$S(NUX=2:"",1:NURSPO(4))_U_NURLOC_U_NURSPO(5)_U_NURSPO(6),Z=DA_U_(+$P(Z,U,2)+1),$P(^NURSA(213.5,DA(1),2,0),U,3,4)=Z,DIK="^NURSA(213.5,DA(1),2," D IX1^DIK
21 Q
Note: See TracBrowser for help on using the repository browser.