| [613] | 1 | TIUFHA9 ; SLC/MAM - CLXREF(DA,OLDCLASS) ;9/10/98 11:13
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**64**;Jun 20, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | CLXREF(DA,OLDCLASS) ; Reset 8925 cross-references ACLAU, ACLEC, ACLPT,
|
|---|
| 5 | ;ACLSB, APTCL, APTCL38 for DA. Necessary only if DA has changed its
|
|---|
| 6 | ;DDEF Class (from OLDCLASS) or if DA never had a DDEF Class.
|
|---|
| 7 | ; DA=docmt in 8925
|
|---|
| 8 | ; May be called with OLDCLASS=0 to SET the above xrefs without killing
|
|---|
| 9 | ;existing nodes in case DA never had a class.
|
|---|
| 10 | N TIUD0,TIUD13,TIUD12,DIK,TIUD15,ENTTRAN
|
|---|
| 11 | S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13)),TIUD12=$G(^(12)),TIUD15=$G(^(15))
|
|---|
| 12 | S DIK="^TIU(8925,"
|
|---|
| 13 | ;
|
|---|
| 14 | APTCL I +$P(TIUD0,U,2),+$P(TIUD13,U) K ^TIU(8925,"APTCL",+$P(TIUD0,U,2),OLDCLASS,$$INVDATE($P(TIUD13,U)),DA)
|
|---|
| 15 | S DIK(1)=".02^APTCL^APTCL38" D EN1^DIK
|
|---|
| 16 | ;
|
|---|
| 17 | ACLSB I +$P(TIUD0,U),+$P(TIUD13,U),+$P(TIUD15,U,2) K ^TIU(8925,"ACLSB",OLDCLASS,+$P(TIUD15,U,2),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
|
|---|
| 18 | S DIK(1)=".02^ACLSB" D EN1^DIK
|
|---|
| 19 | ;
|
|---|
| 20 | ACLPT I +$P(TIUD13,U),+$P(TIUD0,U,2) K ^TIU(8925,"ACLPT",OLDCLASS,+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
|
|---|
| 21 | S DIK(1)=".01^ACLPT01" D EN1^DIK
|
|---|
| 22 | ;
|
|---|
| 23 | ACLAU I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD13,U) D
|
|---|
| 24 | . I +$P(TIUD12,U,2) S ENTTRAN=+$P(TIUD12,U,2) K ^TIU(8925,"ACLAU",OLDCLASS,ENTTRAN,+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
|
|---|
| 25 | . I +$P(TIUD13,U,2) S ENTTRAN=+$P(TIUD13,U,2) K ^TIU(8925,"ACLAU",OLDCLASS,ENTTRAN,+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
|
|---|
| 26 | S DIK(1)=".02^ACLAU" D EN1^DIK
|
|---|
| 27 | ;
|
|---|
| 28 | ACLEC I +$P(TIUD0,U),+$P(TIUD13,U),+$P(TIUD12,U,8) K ^TIU(8925,"ACLEC",OLDCLASS,+$P(TIUD12,U,8),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
|
|---|
| 29 | S DIK(1)=".02^ACLEC" D EN1^DIK
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | INVDATE(DATE) ;
|
|---|
| 33 | Q 9999999-DATE
|
|---|
| 34 | ;
|
|---|
