XUPC991 ;BPO/CLT - UPDATE EFFECTIVE DATE FIELD ; 06 Oct 2016 8:49 AM
;;8.0;KERNEL;**671**;JUL 10, 1995;Build 16
;
; since the original field STATUS (#3)is part of the 8932.1 file screen check and
; has a built in trigger to set field 4 to the current date if the status is Inactive
; the update of the STATUS field must be synchronized with the standarized VUID status.
;
SET(XUDA,XUDA1) ;SET THE EFFECTIVE DATE FIELD INFO TO CURRENT STATUS and DATE
; XUDA - The IEN of vuid STATUS (#8932.199,.02)
; XUDA1 - The IEN of the PERSON CLASS (#8932.1) entry
; X1 - old change array before edit
; X2 - new change array after edit
; XUNM - external name value of vuid STATUS field
;
N ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDESC,XUN,XUO,XUNM
M XUO=X1,XUN=X2
S XUNM=$G(%)
S ZTDTH=$$NOW^XLFDT,ZTDESC="Save of Vuid Status to 8932.1 Status (#3) and update field 4 inactive date"
S ZTRTN="SETJ^XUPC991("_XUDA_","_XUDA1_")",ZTSAVE("XUDA")="",ZTSAVE("XUDA1")="",ZTSAVE("XUNM")=""
S ZTSAVE("XUO(")="",ZTSAVE("XUN(")=""
S ZTIO=""
;D ^%ZTLOAD
D SETJ(XUDA,XUDA1)
;
K ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDESC,XUN,XUO,XUNM
Q
;
SETJ(XUDA,XUDA1) ; save of vuid status to field 3 and 4
N DIE,DIQ,DR,XUSTAT,XUDT,DP,DI,DL,A,B,C,D,E,F,CS,CD,AR,DA,FDA
D GETS^DIQ(8932.1,XUDA1_",","3;4","IE","F")
M AR=F("8932.1",XUDA1_",")
S CS=AR(3,"I")
S A=+$G(XUN(1)),B=$G(XUNM)
I (+A=0!(B="INACTIVE"))&(CS'="i") D SETSD,SETS G SETQ
I +A=1&(CS'="a") D SETSA,SETS,SETD G SETQ
G SETQ
;
SETS ;save the status
;S DIE="^USC(8932.1,",DA=XUDA1
;S DR="3///"_XUSTAT D ^DIE
K FDA
S FDA(8932.1,XUDA1_",",3)=XUSTAT
D FILE^DIE("","FDA")
Q
SETD ; make sure field 4 is clear when status is 'a'
;S DIE="^USC(8932.1,",DA=XUDA1
;S XUDT="@",DR="4///"_XUDT D ^DIE
K FDA
S FDA(8932.1,XUDA1_",",4)="@"
D FILE^DIE("","FDA")
Q
;
SETQ ; quit
Q
;
SETSD ;set for inactive
S XUSTAT="i"
Q
SETSA ;set for active
S XUSTAT="a"
Q
;
KILL(XUDA,XUDA1) ;
Q ; do not change value of field #3 STATUS
;
; S $P(^USC(8932.1,XUDA1,0),U,4,5)="a^"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUPC991 2078 printed Sep 23, 2025@19:47:45 Page 2
XUPC991 ;BPO/CLT - UPDATE EFFECTIVE DATE FIELD ; 06 Oct 2016 8:49 AM
+1 ;;8.0;KERNEL;**671**;JUL 10, 1995;Build 16
+2 ;
+3 ; since the original field STATUS (#3)is part of the 8932.1 file screen check and
+4 ; has a built in trigger to set field 4 to the current date if the status is Inactive
+5 ; the update of the STATUS field must be synchronized with the standarized VUID status.
+6 ;
SET(XUDA,XUDA1) ;SET THE EFFECTIVE DATE FIELD INFO TO CURRENT STATUS and DATE
+1 ; XUDA - The IEN of vuid STATUS (#8932.199,.02)
+2 ; XUDA1 - The IEN of the PERSON CLASS (#8932.1) entry
+3 ; X1 - old change array before edit
+4 ; X2 - new change array after edit
+5 ; XUNM - external name value of vuid STATUS field
+6 ;
+7 NEW ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDESC,XUN,XUO,XUNM
+8 MERGE XUO=X1,XUN=X2
+9 SET XUNM=$GET(%)
+10 SET ZTDTH=$$NOW^XLFDT
SET ZTDESC="Save of Vuid Status to 8932.1 Status (#3) and update field 4 inactive date"
+11 SET ZTRTN="SETJ^XUPC991("_XUDA_","_XUDA1_")"
SET ZTSAVE("XUDA")=""
SET ZTSAVE("XUDA1")=""
SET ZTSAVE("XUNM")=""
+12 SET ZTSAVE("XUO(")=""
SET ZTSAVE("XUN(")=""
+13 SET ZTIO=""
+14 ;D ^%ZTLOAD
+15 DO SETJ(XUDA,XUDA1)
+16 ;
+17 KILL ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTSK,ZTDESC,XUN,XUO,XUNM
+18 QUIT
+19 ;
SETJ(XUDA,XUDA1) ; save of vuid status to field 3 and 4
+1 NEW DIE,DIQ,DR,XUSTAT,XUDT,DP,DI,DL,A,B,C,D,E,F,CS,CD,AR,DA,FDA
+2 DO GETS^DIQ(8932.1,XUDA1_",","3;4","IE","F")
+3 MERGE AR=F("8932.1",XUDA1_",")
+4 SET CS=AR(3,"I")
+5 SET A=+$GET(XUN(1))
SET B=$GET(XUNM)
+6 IF (+A=0!(B="INACTIVE"))&(CS'="i")
DO SETSD
DO SETS
GOTO SETQ
+7 IF +A=1&(CS'="a")
DO SETSA
DO SETS
DO SETD
GOTO SETQ
+8 GOTO SETQ
+9 ;
SETS ;save the status
+1 ;S DIE="^USC(8932.1,",DA=XUDA1
+2 ;S DR="3///"_XUSTAT D ^DIE
+3 KILL FDA
+4 SET FDA(8932.1,XUDA1_",",3)=XUSTAT
+5 DO FILE^DIE("","FDA")
+6 QUIT
SETD ; make sure field 4 is clear when status is 'a'
+1 ;S DIE="^USC(8932.1,",DA=XUDA1
+2 ;S XUDT="@",DR="4///"_XUDT D ^DIE
+3 KILL FDA
+4 SET FDA(8932.1,XUDA1_",",4)="@"
+5 DO FILE^DIE("","FDA")
+6 QUIT
+7 ;
SETQ ; quit
+1 QUIT
+2 ;
SETSD ;set for inactive
+1 SET XUSTAT="i"
+2 QUIT
SETSA ;set for active
+1 SET XUSTAT="a"
+2 QUIT
+3 ;
KILL(XUDA,XUDA1) ;
+1 ; do not change value of field #3 STATUS
QUIT
+2 ;
+3 ; S $P(^USC(8932.1,XUDA1,0),U,4,5)="a^"
+4 QUIT
