NURAMU3.m

NURAMU3 ;HIRMFO/MD-EMPLOYEE ACT/SEP BATCH JOB 9/20/96 ; 4/29/03 11:23am

 ;;4.0;NURSING SERVICE;**9,39**;Apr 25, 1997

EN1 ;BATCH RUN TO UPDATE STAFF SEP/ACT DATA IN 213.5 FILE AND STATUS IF APPROPRIATE

 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

 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

 S:'$D(^DIC(213.9,1,"DATE")) ^("DATE")="" S $P(^("DATE"),U,9)=1

QUIT ;

 K NEXCDA,NURSDATE,NUR,NURSPO,NURLOC,NURSEMP,NUX,DA,NOD,NDA,NURSDATE,%DT,NURSEL,I,X,Y Q

NURSCK ;

 W:'$D(ZTQUEUED) "." S DA(1)=NOD,DA=NDA

 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

 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

 Q

NURSBYP ;

 I '$D(^NURSA(213.5,NEXCDA,2,0)) S ^(0)="^213.52P^^"

 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))

 S NURSPO(1)=$S($D(^VA(200,+NURSEMP,0)):+NURSEMP,1:""),NURSPO(2)=$S(NUX=1:"S",NUX=2:"A",1:"")

 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)

 S DA(1)=NEXCDA,Z=$P(^NURSA(213.5,DA(1),2,0),U,3,4)

 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

 Q

NURAMU3   ;HIRMFO/MD-EMPLOYEE ACT/SEP BATCH JOB 9/20/96 ; 4/29/03 11:23am

 +1       ;;4.0;NURSING SERVICE;**9,39**;Apr 25, 1997

EN1       ;BATCH RUN TO UPDATE STAFF SEP/ACT DATA IN 213.5 FILE AND STATUS IF APPROPRIATE

 +1        SET NURSDATE=RPTDATE

           SET U="^"

           IF '$DATA(^DIC(213.9,1,"DATE"))

               SET ^DIC(213.9,1,"DATE")=""

           SET $PIECE(^DIC(213.9,1,"DATE"),U,9)=0

 +2        FOR NUX=0:0

               SET NUX=$ORDER(^NURSF(211.8,"ASD",NUX))

               IF NUX'>0

                   QUIT 

               FOR NOD=0:0

                   SET NOD=$ORDER(^NURSF(211.8,"ASD",NUX,NOD))

                   IF NOD'>0

                       QUIT 

                   FOR NDA=0:0

                       SET NDA=$ORDER(^NURSF(211.8,"ASD",NUX,NOD,NDA))

                       IF NDA'>0

                           QUIT 

                       IF $DATA(^NURSF(211.8,NOD,1,NDA,0))

                           SET NURSEMP=+$PIECE(^(0),U,2)

                           DO NURSCK

 +3        IF '$DATA(^DIC(213.9,1,"DATE"))

               SET ^("DATE")=""

           SET $PIECE(^("DATE"),U,9)=1

QUIT      ;

 +1        KILL NEXCDA,NURSDATE,NUR,NURSPO,NURLOC,NURSEMP,NUX,DA,NOD,NDA,NURSDATE,%DT,NURSEL,I,X,Y

           QUIT 

NURSCK    ;

 +1        IF '$DATA(ZTQUEUED)

               WRITE "."

           SET DA(1)=NOD

           SET DA=NDA

 +2        IF +NUX=2

               IF +$PIECE(^NURSF(211.8,DA(1),1,DA,0),U)'>NURSDATE

                   DO NURSBYP

                   SET DA(1)=NOD

                   SET DA=NDA

                   SET X=+$PIECE(^NURSF(211.8,DA(1),1,DA,0),U)

                   SET NUR=".01^1"

                   DO EN1B^NURSUT1

 +3        IF +NUX=1

               IF +$PIECE(^NURSF(211.8,DA(1),1,DA,0),U,6)'>NURSDATE

                   DO NURSBYP

                   SET DA(1)=NOD

                   SET DA=NDA

                   SET X=+$PIECE(^NURSF(211.8,DA(1),1,DA,0),U,6)

                   SET NUR="3^1"

                   DO EN1B^NURSUT1

 +4        QUIT 

NURSBYP   ;

 +1        IF '$DATA(^NURSA(213.5,NEXCDA,2,0))

               SET ^(0)="^213.52P^^"

 +2        SET NURSPO=$GET(^NURSF(211.8,NOD,0))

           SET NURSPO(0)=$GET(^NURSF(211.8,NOD,1,NDA,0))

           SET NURLOC=$ORDER(^NURSF(211.4,"B",+NURSPO,0))

 +3        SET NURSPO(1)=$SELECT($DATA(^VA(200,+NURSEMP,0)):+NURSEMP,1:"")

           SET NURSPO(2)=$SELECT(NUX=1:"S",NUX=2:"A",1:"")

 +4        SET NURSPO(3)=$SELECT(NUX=1:$PIECE(NURSPO(0),U,6),1:$PIECE(NURSPO(0),U))

           SET NURSPO(4)=$SELECT($DATA(^NURSF(211.9,+$PIECE(NURSPO(0),U,8),0)):+$PIECE(NURSPO(0),U,8),1:"")

           SET NURSPO(5)=$SELECT($DATA(^NURSF(211.3,+$PIECE(NURSPO(0),U,3),0)):+$PIECE(NURSPO(0),U,3),1:"")

           SET NURSPO(6)=+$PIECE(NURSPO(0),U,4)

 +5        SET DA(1)=NEXCDA

           SET Z=$PIECE(^NURSA(213.5,DA(1),2,0),U,3,4)

 +6        SET DA=(+$PIECE(Z,U)+1)

           SET ^NURSA(213.5,DA(1),2,DA,0)=NURSPO(1)_U_NURSPO(2)_U_NURSPO(3)_U_$SELECT(NUX=2:"",1:NURSPO(4))_U_NURLOC_U_NURSPO(5)_U_NURSPO(6)

           SET Z=DA_U_(+$PIECE(Z,U,2)+1)

           SET $PIECE(^NURSA(213.5,DA(1),2,0),U,3,4)=Z

           SET DIK="^NURSA(213.5,DA(1),2,"

           DO IX1^DIK

 +7        QUIT