112 lines
4.8 KiB
Mathematica
112 lines
4.8 KiB
Mathematica
XPDTA1 ;SFISC/RSD - Build Actions for Kernel Files Cont. ;05/05/2003 13:42
|
|
;;8.0;KERNEL;**44,68,85,131,302**;Jul 10, 1995
|
|
Q
|
|
;^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA) is the global root
|
|
;DA=ien in ^XTMP,XPDNM=package name, XPDA=package ien in ^XPD(9.6,
|
|
Q
|
|
HELP ;help frames #9.2
|
|
;remove Author (0;4), kill Editor (4;0) and under Object (10) kill "B" x-ref
|
|
S $P(^XTMP("XPDT",XPDA,"KRN",9.2,DA,0),U,4)="",%=0 K ^(4),^(10,"B")
|
|
;loop thru Objects (10) and resolve (10;1), kill if it doesn't resolve
|
|
F S %=$O(^XTMP("XPDT",XPDA,"KRN",9.2,DA,10,%)) Q:'% S %1=$G(^(%,0)) D
|
|
.S %2=$$PT^XPDTA("^MAG",+%1)
|
|
.I $L(%2) S $P(^XTMP("XPDT",XPDA,"KRN",9.2,DA,10,%,0),U)=%2 Q
|
|
.K ^XTMP("XPDT",XPDA,"KRN",9.2,DA,10,%)
|
|
;kill under Related Frame (2) "B" x-ref
|
|
K ^XTMP("XPDT",XPDA,"KRN",9.2,DA,2,"B") S %=0
|
|
;loop thru Related Frame (2) and resolve Related Frame (2;2)
|
|
;kill if it doesn't resolve
|
|
F S %=$O(^XTMP("XPDT",XPDA,"KRN",9.2,DA,2,%)) Q:'% S %1=$P($G(^(%,0)),U,2) D
|
|
.S %2=$$PT^XPDTA("^DIC(9.2)",%1)
|
|
.I $L(%2) S $P(^XTMP("XPDT",XPDA,"KRN",9.2,DA,2,%,0),U,2)=%2 Q
|
|
.K ^XTMP("XPDT",XPDA,"KRN",9.2,DA,2,%)
|
|
Q
|
|
BUL ;bulletines #3.6
|
|
;kill Mailgroups (2)
|
|
K ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,2)
|
|
Q
|
|
KEY ;security keys entry action #19
|
|
;Repoint SUBORDINATE (3) and MUTUALLY EXCLUSIVE KEYS (5).
|
|
N %,%1,%2 S %=0
|
|
F S %=$O(^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,3,%)) Q:%'>0 S %1=+$G(^(%,0)) D
|
|
. S %2=$$PT^XPDTA("^DIC("_XPDFILE_")",%1)
|
|
. I $L(%2) S $P(^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,3,%,0),U,1)=%2 Q
|
|
. K ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,3,%)
|
|
S %=0
|
|
F S %=$O(^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,5,%)) Q:%'>0 S %1=+$G(^(%,0)) D
|
|
. S %2=$$PT^XPDTA("^DIC("_XPDFILE_")",%1)
|
|
. I $L(%2) S $P(^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,5,%,0),U,1)=%2 Q
|
|
. K ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,5,%)
|
|
Q
|
|
MAILG ;MAIL GROUP #3.8
|
|
;remove REFERENCE COUNT (0;4), LAST REFERENCE (0;5), COORDINATOR (0;7)
|
|
S %=^XTMP("XPDT",XPDA,"KRN",3.8,DA,0),$P(%,U,4,5)="^",$P(%,U,7)="",^(0)=%
|
|
;remove ORGANIZER (3;1)
|
|
S %=$P($G(^XTMP("XPDT",XPDA,"KRN",3.8,DA,3)),U) S:% $P(^(3),U)=""
|
|
;kill MEMBER (1;0), AUTHORIZE SENDER (4;0), DISTRIBUTION LIST (7;0)
|
|
K ^XTMP("XPDT",XPDA,"KRN",3.8,DA,1),^(4),^(7)
|
|
;kill MEMBER GROUP "B" x-ref
|
|
K ^XTMP("XPDT",XPDA,"KRN",3.8,DA,5,"B") S %=0
|
|
;loop thru MEMBER GROUP and resolve (5;0)
|
|
F S %=$O(^XTMP("XPDT",XPDA,"KRN",3.8,DA,5,%)) Q:'% S %1=$P($G(^(%,0)),U) D
|
|
.S %2=$$PT^XPDTA("^XMB(3.8)",%1)
|
|
.I $L(%2) S $P(^XTMP("XPDT",XPDA,"KRN",3.8,DA,5,%,0),U)=%2 Q
|
|
.K ^XTMP("XPDT",XPDA,"KRN",3.8,DA,5,%)
|
|
Q
|
|
HLAP ;HL7 application parameter #771
|
|
S %=^XTMP("XPDT",XPDA,"KRN",771,DA,0)
|
|
;resolve MAIL GROUP (0;4)
|
|
S:$P(%,U,4) $P(%,U,4)=$$PT^XPDTA("^XMB(3.8)",$P(%,U,4))
|
|
;resolve COUNTRY CODE (0;7)
|
|
S:$P(%,U,7) $P(%,U,7)=$$PT^XPDTA("^HL(779.004)",$P(%,U,7))
|
|
S ^XTMP("XPDT",XPDA,"KRN",771,DA,0)=%
|
|
;resolve HL7 SEGMENT (SEG;0)
|
|
;kill "B"=name x-ref, it will be re-indexed when installed
|
|
I $D(^XTMP("XPDT",XPDA,"KRN",771,DA,"SEG")) K ^("SEG","B") D
|
|
.;loop thru SEGs and resolve (SEG;1)
|
|
.S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",771,DA,"SEG",%)) Q:'% S %1=$G(^(%,0)) D
|
|
..S %2=$$PT^XPDTA("^HL(771.3)",+%1)
|
|
..;if can't resolve then delete
|
|
..I %2="" K ^XTMP("XPDT",XPDA,"KRN",771,DA,"SEG",%) Q
|
|
..;save the SEG name
|
|
..S $P(^XTMP("XPDT",XPDA,"KRN",771,DA,"SEG",%,0),U)=%2
|
|
.Q
|
|
;resolve HL7 MESSAGE (MSG;0)
|
|
I $D(^XTMP("XPDT",XPDA,"KRN",771,DA,"MSG")) K ^("MSG","B") D
|
|
.;loop thru MSGs and resolve (MSG;1)
|
|
.S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",771,DA,"MSG",%)) Q:'% S %1=$G(^(%,0)) D
|
|
..S %2=$$PT^XPDTA("^HL(771.3)",+%1)
|
|
..;if can't resolve then delete
|
|
..I %2="" K ^XTMP("XPDT",XPDA,"KRN",771,DA,"MSG",%) Q
|
|
..;save the MSG name
|
|
..S $P(^XTMP("XPDT",XPDA,"KRN",771,DA,"MSG",%,0),U)=%2
|
|
.Q
|
|
Q
|
|
HLLLP ;HL7 lower level protocol #869.2
|
|
;patch HL*1.6*57 merged this file with 870
|
|
Q
|
|
HLLL ;HL7 logical link #870
|
|
S %=^XTMP("XPDT",XPDA,"KRN",870,DA,0)
|
|
;resolve INSTITUTION (0;2)
|
|
S:$P(%,U,2) $P(%,U,2)=$$PT^XPDTA("^DIC(4)",$P(%,U,2))
|
|
;resolve LLP TYPE (0;3)
|
|
S:$P(%,U,3) $P(%,U,3)=$$PT^XPDTA("^HLCS(869.1)",$P(%,U,3))
|
|
;resolve DOMAIN (0;7)
|
|
S:$P(%,U,7) $P(%,U,7)=$$PT^XPDTA("^DIC(4.2)",$P(%,U,7))
|
|
;remove all data except (0;1-3,7,21)
|
|
S %=$P(%,U,1,3)_"^^^^"_$P(%,U,7)_"^^^^^^^^^^^^^^"_$P(%,U,21)
|
|
S ^XTMP("XPDT",XPDA,"KRN",870,DA,0)=%
|
|
;resolve MAIL GROUP (100;1)
|
|
S %=$P($G(^XTMP("XPDT",XPDA,"KRN",870,DA,100)),U)
|
|
S:% %=$$PT^XPDTA("^XMB(3.8)",%),$P(^XTMP("XPDT",XPDA,"KRN",870,DA,100),U)=%
|
|
;remove HLLP DEVICE (200;1)
|
|
I $D(^XTMP("XPDT",XPDA,"KRN",870,DA,200)) S $P(^(200),U)=""
|
|
;remove X3.28 DEVICE (300;1)
|
|
I $D(^XTMP("XPDT",XPDA,"KRN",870,DA,300)) S $P(^(300),U)=""
|
|
;remove Startup Node (400;6)
|
|
I $D(^XTMP("XPDT",XPDA,"KRN",870,DA,400)) S $P(^(400),U,6)=""
|
|
;remove all queue multiples and pointers
|
|
K ^XTMP("XPDT",XPDA,"KRN",870,DA,1),^(2),^("IN QUEUE BACK POINTER"),^("IN QUEUE FRONT POINTER")
|
|
K ^XTMP("XPDT",XPDA,"KRN",870,DA,"OUT QUEUE BACK POINTER"),^("OUT QUEUE FRONT POINTER")
|
|
Q
|