source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFHA9.m@ 975

Last change on this file since 975 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1TIUFHA9 ; SLC/MAM - CLXREF(DA,OLDCLASS) ;9/10/98 11:13
2 ;;1.0;TEXT INTEGRATION UTILITIES;**64**;Jun 20, 1997
3 ;
4CLXREF(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 ;
14APTCL 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 ;
17ACLSB 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 ;
20ACLPT 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 ;
23ACLAU 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 ;
28ACLEC 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 ;
32INVDATE(DATE) ;
33 Q 9999999-DATE
34 ;
Note: See TracBrowser for help on using the repository browser.