- TIUFHA9 ; SLC/MAM - CLXREF(DA,OLDCLASS) ;9/10/98 11:13
- ;;1.0;TEXT INTEGRATION UTILITIES;**64**;Jun 20, 1997
- ;
- CLXREF(DA,OLDCLASS) ; Reset 8925 cross-references ACLAU, ACLEC, ACLPT,
- ;ACLSB, APTCL, APTCL38 for DA. Necessary only if DA has changed its
- ;DDEF Class (from OLDCLASS) or if DA never had a DDEF Class.
- ; DA=docmt in 8925
- ; May be called with OLDCLASS=0 to SET the above xrefs without killing
- ;existing nodes in case DA never had a class.
- N TIUD0,TIUD13,TIUD12,DIK,TIUD15,ENTTRAN
- S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13)),TIUD12=$G(^(12)),TIUD15=$G(^(15))
- S DIK="^TIU(8925,"
- ;
- APTCL I +$P(TIUD0,U,2),+$P(TIUD13,U) K ^TIU(8925,"APTCL",+$P(TIUD0,U,2),OLDCLASS,$$INVDATE($P(TIUD13,U)),DA)
- S DIK(1)=".02^APTCL^APTCL38" D EN1^DIK
- ;
- 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)
- S DIK(1)=".02^ACLSB" D EN1^DIK
- ;
- ACLPT I +$P(TIUD13,U),+$P(TIUD0,U,2) K ^TIU(8925,"ACLPT",OLDCLASS,+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
- S DIK(1)=".01^ACLPT01" D EN1^DIK
- ;
- ACLAU I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD13,U) D
- . 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)
- . 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)
- S DIK(1)=".02^ACLAU" D EN1^DIK
- ;
- 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)
- S DIK(1)=".02^ACLEC" D EN1^DIK
- Q
- ;
- INVDATE(DATE) ;
- Q 9999999-DATE
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFHA9 1660 printed Feb 19, 2025@00:07:20 Page 2
- TIUFHA9 ; SLC/MAM - CLXREF(DA,OLDCLASS) ;9/10/98 11:13
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**64**;Jun 20, 1997
- +2 ;
- CLXREF(DA,OLDCLASS) ; Reset 8925 cross-references ACLAU, ACLEC, ACLPT,
- +1 ;ACLSB, APTCL, APTCL38 for DA. Necessary only if DA has changed its
- +2 ;DDEF Class (from OLDCLASS) or if DA never had a DDEF Class.
- +3 ; DA=docmt in 8925
- +4 ; May be called with OLDCLASS=0 to SET the above xrefs without killing
- +5 ;existing nodes in case DA never had a class.
- +6 NEW TIUD0,TIUD13,TIUD12,DIK,TIUD15,ENTTRAN
- +7 SET TIUD0=$GET(^TIU(8925,+DA,0))
- SET TIUD13=$GET(^(13))
- SET TIUD12=$GET(^(12))
- SET TIUD15=$GET(^(15))
- +8 SET DIK="^TIU(8925,"
- +9 ;
- APTCL IF +$PIECE(TIUD0,U,2)
- IF +$PIECE(TIUD13,U)
- KILL ^TIU(8925,"APTCL",+$PIECE(TIUD0,U,2),OLDCLASS,$$INVDATE($PIECE(TIUD13,U)),DA)
- +1 SET DIK(1)=".02^APTCL^APTCL38"
- DO EN1^DIK
- +2 ;
- ACLSB IF +$PIECE(TIUD0,U)
- IF +$PIECE(TIUD13,U)
- IF +$PIECE(TIUD15,U,2)
- KILL ^TIU(8925,"ACLSB",OLDCLASS,+$PIECE(TIUD15,U,2),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
- +1 SET DIK(1)=".02^ACLSB"
- DO EN1^DIK
- +2 ;
- ACLPT IF +$PIECE(TIUD13,U)
- IF +$PIECE(TIUD0,U,2)
- KILL ^TIU(8925,"ACLPT",OLDCLASS,+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
- +1 SET DIK(1)=".01^ACLPT01"
- DO EN1^DIK
- +2 ;
- ACLAU IF +$PIECE(TIUD0,U)
- IF +$PIECE(TIUD0,U,2)
- IF +$PIECE(TIUD13,U)
- Begin DoDot:1
- +1 IF +$PIECE(TIUD12,U,2)
- SET ENTTRAN=+$PIECE(TIUD12,U,2)
- KILL ^TIU(8925,"ACLAU",OLDCLASS,ENTTRAN,+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
- +2 IF +$PIECE(TIUD13,U,2)
- SET ENTTRAN=+$PIECE(TIUD13,U,2)
- KILL ^TIU(8925,"ACLAU",OLDCLASS,ENTTRAN,+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
- End DoDot:1
- +3 SET DIK(1)=".02^ACLAU"
- DO EN1^DIK
- +4 ;
- ACLEC IF +$PIECE(TIUD0,U)
- IF +$PIECE(TIUD13,U)
- IF +$PIECE(TIUD12,U,8)
- KILL ^TIU(8925,"ACLEC",OLDCLASS,+$PIECE(TIUD12,U,8),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
- +1 SET DIK(1)=".02^ACLEC"
- DO EN1^DIK
- +2 QUIT
- +3 ;
- INVDATE(DATE) ;
- +1 QUIT 9999999-DATE
- +2 ;