NURXP43 ;HIRMFO/FT-Nursing Service v4.0 Post-Initialization Routine ;8-16-2011
;;4.0;NURSING SERVICE;**43**;Apr 25, 1997;Build 19
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; This routine contains the post-initialization code for Nursing
; Service package v4.0. Patch 43
;
;Reindex Nurse primary location
N DIK,DA
S DIK="^NURSF(211.8,DA(1),1,"
S DIK(1)="6^D"
S DA(1)=0
F S DA(1)=$O(^NURSF(211.8,DA(1))) Q:DA(1)'?1.N D
.S DA=0
.F S DA=$O(^NURSF(211.8,DA(1),1,DA)) Q:DA'?1.N D
..D EN^DIK
;
N DA,X,PAIDDT,TEST,ACDT
S TEST='$$PROD^XUPROD
S PAIDDT=""
;GO BACK 5 PAYPERIODS JUST FOR TESTING PURPOSES
F I=1:1:14*5 S PAIDDT=$O(^PRST(458,"AD",PAIDDT),-1)
S DA=0
F S DA=$O(^NURSF(211.4,DA)) Q:DA'?1.N D
.S ACDT=$S(TEST:PAIDDT,1:DT),X=$G(^NURSF(211.4,DA,"I"))
.D SERVICE
Q
;
SERVICE ; set the Service date multiple (field 16) in file 211.4, whenever
; the inactive flag (1.5) is changed (called from index on field 1.5)
;
Q:$G(DA)'>0!($G(X)="")
N REC,RECEXIST,IENS,PRSFDA
S RECEXIST=0
S REC=$O(^NURSF(211.4,DA,7,0))
;IF THERE ARE 7 LEVEL DECENDANTS THEN THIS PROCESS HAS BEEN RUN BEFORE FOR THIS LOCATION
Q:REC
S IENS="+1,"_DA_","
S PRSFDA(211.416,IENS,.01)=ACDT
S PRSFDA(211.416,IENS,1)=X
D UPDATE^DIE("","PRSFDA","IENS")
D MSG^DIALOG()
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURXP43 1345 printed Dec 13, 2024@02:22:29 Page 2
NURXP43 ;HIRMFO/FT-Nursing Service v4.0 Post-Initialization Routine ;8-16-2011
+1 ;;4.0;NURSING SERVICE;**43**;Apr 25, 1997;Build 19
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; This routine contains the post-initialization code for Nursing
+5 ; Service package v4.0. Patch 43
+6 ;
+7 ;Reindex Nurse primary location
+8 NEW DIK,DA
+9 SET DIK="^NURSF(211.8,DA(1),1,"
+10 SET DIK(1)="6^D"
+11 SET DA(1)=0
+12 FOR
SET DA(1)=$ORDER(^NURSF(211.8,DA(1)))
if DA(1)'?1.N
QUIT
Begin DoDot:1
+13 SET DA=0
+14 FOR
SET DA=$ORDER(^NURSF(211.8,DA(1),1,DA))
if DA'?1.N
QUIT
Begin DoDot:2
+15 DO EN^DIK
End DoDot:2
End DoDot:1
+16 ;
+17 NEW DA,X,PAIDDT,TEST,ACDT
+18 SET TEST='$$PROD^XUPROD
+19 SET PAIDDT=""
+20 ;GO BACK 5 PAYPERIODS JUST FOR TESTING PURPOSES
+21 FOR I=1:1:14*5
SET PAIDDT=$ORDER(^PRST(458,"AD",PAIDDT),-1)
+22 SET DA=0
+23 FOR
SET DA=$ORDER(^NURSF(211.4,DA))
if DA'?1.N
QUIT
Begin DoDot:1
+24 SET ACDT=$SELECT(TEST:PAIDDT,1:DT)
SET X=$GET(^NURSF(211.4,DA,"I"))
+25 DO SERVICE
End DoDot:1
+26 QUIT
+27 ;
SERVICE ; set the Service date multiple (field 16) in file 211.4, whenever
+1 ; the inactive flag (1.5) is changed (called from index on field 1.5)
+2 ;
+3 if $GET(DA)'>0!($GET(X)="")
QUIT
+4 NEW REC,RECEXIST,IENS,PRSFDA
+5 SET RECEXIST=0
+6 SET REC=$ORDER(^NURSF(211.4,DA,7,0))
+7 ;IF THERE ARE 7 LEVEL DECENDANTS THEN THIS PROCESS HAS BEEN RUN BEFORE FOR THIS LOCATION
+8 if REC
QUIT
+9 SET IENS="+1,"_DA_","
+10 SET PRSFDA(211.416,IENS,.01)=ACDT
+11 SET PRSFDA(211.416,IENS,1)=X
+12 DO UPDATE^DIE("","PRSFDA","IENS")
+13 DO MSG^DIALOG()
+14 QUIT
