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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAMU3 1881 printed Apr 09, 2024@21:24:12 Page 2
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
