XUPC991.m

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 ---XUPC991   2078     printed  Apr 09, 2024@21:18:44                                                                                                                                                                                                     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