Changeset 623 for WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDTA.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDTA.m
r613 r623 1 XPDTA ;SFISC/RSD - Build Actions for Kernel Files ;02/14/2006 2 ;;8.0;KERNEL;**15,44,58,131,229,393,498**;Jul 10, 1995;Build 13 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 Q 5 ;^XTMP("XPDT",XPDA,"KRN",FILE,DA) is the global root 6 ;DA=ien in ^XTMP,XPDNM=package name, XPDA=package ien in ^XPD(9.6, 7 OPT ;options 8 N %,%1,%2 9 ;if link, kill everything and just process the menu items 10 I XPDFL=2 D G OPTT 11 .S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",19,DA,%)) Q:'% K:%'=10 ^(%) 12 ;resolve Package (0;12), remove Creator (0;5) 13 S %=^XTMP("XPDT",XPDA,"KRN",19,DA,0),$P(%,U,12)=$$PT("^DIC(9.4)",$P(%,U,12)),$P(%,U,5)="" 14 ;resolve Help Frame (0;7), kill Permitted Devices (3.96;0) & queue node (200) 15 S $P(%,U,7)=$$PT("^DIC(9.2)",$P(%,U,7)),^XTMP("XPDT",XPDA,"KRN",19,DA,0)=% K ^(3.96),^(200) 16 ;resolve Server Bulletin (220;1), Server Mailgroup (220;3) 17 I $D(^XTMP("XPDT",XPDA,"KRN",19,DA,220)) S %=^(220),$P(%,U)=$$PT("^XMB(3.6)",+%),$P(%,U,3)=$$PT("^XMB(3.8)",$P(%,U,3)),^XTMP("XPDT",XPDA,"KRN",19,DA,220)=% 18 ;resolve RPC (RPC;0), must be type Broker 19 I $D(^XTMP("XPDT",XPDA,"KRN",19,DA,"RPC")) K:$P(^(0),U,4)'="B" ^("RPC") D 20 .;kill "B"=name x-ref, it will be re-indexed when installed 21 .K ^XTMP("XPDT",XPDA,"KRN",19,DA,"RPC","B") 22 .;loop thru RPCs and resolve (RPC;1) 23 .S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",19,DA,"RPC",%)) Q:'% S %1=$G(^(%,0)) D 24 ..S %2=$$PT("^XWB(8994)",+%1) 25 ..;if can't resolve then delete 26 ..I %2="" K ^XTMP("XPDT",XPDA,"KRN",19,DA,"RPC",%,0) Q 27 ..;save the RPC name 28 ..S $P(^XTMP("XPDT",XPDA,"KRN",19,DA,"RPC",%,0),U)=%2 29 .Q 30 OPTT ;Menus can only exist for options of type: menu,protocol,protocol menu, 31 ;extended action, limited, window suite 32 I "LMOQXZ"'[$P(^XTMP("XPDT",XPDA,"KRN",19,DA,0),U,4) K ^(10) Q 33 ;kill "B"=name, "C"=synonyms x-ref, it will be re-indexed when installed 34 K ^XTMP("XPDT",XPDA,"KRN",19,DA,10,"B"),^("C") 35 ;loop thru 10=Menus and resolve Menu (10;1), kill if it doesn't resolve 36 S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",19,DA,10,%)) Q:'% S %1=$G(^(%,0)) D 37 .S %2=$$PT("^DIC(19)",+%1) 38 .;items must be sent by themselves, check "B" x-ref 39 .I $L(%2),$D(^XPD(9.6,XPDA,"KRN",19,"NM","B",%2)) S ^XTMP("XPDT",XPDA,"KRN",19,DA,10,%,U)=%2 Q 40 .;if I couldn't resolve this option, then kill it 41 .K ^XTMP("XPDT",XPDA,"KRN",19,DA,10,%) 42 Q 43 ; 44 PRO ;protocols 45 N %,%1,%2 46 ;if link, kill everything and just process the menu items 47 I XPDFL=2 D G PROT 48 .S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",101,DA,%)) Q:'% K:%'=10 ^(%) 49 ;resolve Package (0;12), remove Creator (0;5) 50 S %=^XTMP("XPDT",XPDA,"KRN",101,DA,0),$P(%,U,12)=$$PT("^DIC(9.4)",$P(%,U,12)),$P(%,U,5)="" 51 ;kill under Menus (10), "B"=name, "C"=synonyms 52 S ^XTMP("XPDT",XPDA,"KRN",101,DA,0)=% 53 ;resolve File Link (5;1), its a variable pointer 54 S %=$P($G(^XTMP("XPDT",XPDA,"KRN",101,DA,5)),U),%1=$P(%,";",2) 55 I %,$D(@("^"_%1_+%_",0)")) S $P(^XTMP("XPDT",XPDA,"KRN",101,DA,5),U)=$P(^(0),U)_";"_%1 56 ;resolve HL7 fields, node 770 57 S %=$G(^XTMP("XPDT",XPDA,"KRN",101,DA,770)) I $L(%) D S ^XTMP("XPDT",XPDA,"KRN",101,DA,770)=% 58 .S $P(%,U)=$$PT("^HL(771)",$P(%,U)),$P(%,U,2)=$$PT("^HL(771)",$P(%,U,2)) 59 .S $P(%,U,3)=$$PT("^HL(771.2)",$P(%,U,3)),$P(%,U,11)=$$PT("^HL(771.2)",$P(%,U,11)) 60 .S $P(%,U,4)=$$PT("^HL(779.001)",$P(%,U,4)),$P(%,U,7)=$$PT("^HLCS(870)",$P(%,U,7)) 61 .S $P(%,U,8)=$$PT("^HL(779.003)",$P(%,U,8)),$P(%,U,9)=$$PT("^HL(779.003)",$P(%,U,9)) 62 .S $P(%,U,10)=$$PT("^HL(771.5)",$P(%,U,10)) 63 PROT ;loop thru 10=Menus and resolve Menu (10;1), kill if it doesn't resolve 64 ;kill under Menus (10), "B"=name, "C"=synonyms 65 I $D(^XTMP("XPDT",XPDA,"KRN",101,DA,10,0)) K ^("B"),^("C") 66 S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",101,DA,10,%)) Q:'% S %1=$G(^(%,0)) D 67 .;%2=.01 of Menu(protocol) 68 .S %2=$$PT("^ORD(101)",+%1) 69 .;Menu must also be sent by itself, check "B" x-ref 70 .I $L(%2),$D(^XPD(9.6,XPDA,"KRN",101,"NM","B",%2)) S ^XTMP("XPDT",XPDA,"KRN",101,DA,10,%,U)=%2,$P(^XTMP("XPDT",XPDA,"KRN",101,DA,10,%,0),U,4)=$$PT("^ORD(101)",$P(%1,U,4)) Q 71 .K ^XTMP("XPDT",XPDA,"KRN",101,DA,10,%) 72 ;If type is Event Driver and sending Subscribers (775) 73 I $P(^XTMP("XPDT",XPDA,"KRN",101,DA,0),U,4)="E" D 74 . ;kill Menu multiple and Subscriber x-ref "B"=name 75 . K ^XTMP("XPDT",XPDA,"KRN",101,DA,10),^(775,"B") 76 . ;loop thru 775=Subscribers and resolve pointer (775;1) 77 . S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",101,DA,775,%)) Q:'% S %1=$G(^(%,0)) D 78 .. ;%2=.01 of subscriber(protocol) 79 .. S %2=$$PT("^ORD(101)",+%1) 80 .. ;protocol must also be sent by itself, check "B" x-ref 81 .. I $L(%2),$D(^XPD(9.6,XPDA,"KRN",101,"NM","B",%2)) S ^XTMP("XPDT",XPDA,"KRN",101,DA,775,%,U)=%2 Q 82 .. K ^XTMP("XPDT",XPDA,"KRN",101,DA,775,%) 83 ;quit if no Access multiple 84 Q:'$D(^XTMP("XPDT",XPDA,"KRN",101,DA,3,0)) K ^("B") 85 ;loop thru Access and resolve (3;1), kill if it doesn't resolve 86 S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",101,DA,3,%)) Q:'% S %1=$G(^(%,0)) D 87 .;%2=.01 of Menu(protocol) 88 .S %2=$$PT("^DIC(19.1)",+%1) 89 .I $L(%2) S ^XTMP("XPDT",XPDA,"KRN",101,DA,3,%,0)=%2 Q 90 .K ^XTMP("XPDT",XPDA,"KRN",101,DA,3,%) 91 Q 92 ; 93 RTNE ;routine entry build action 94 N %,X,XPD 95 ;move routine to ^XTMP("XPDT",DPK1,"RTN",routine name 96 ;routines will have the checksum in XTMP("XPDT",XPDA,"RTN",X) & in 97 ;Build file 98 S X=$P(^XTMP("XPDT",XPDA,"KRN",9.8,DA,0),U),XPD=^(-1) 99 Q:X="" S %=$$LOAD(X,XPD),$P(^XPD(9.6,XPDA,"KRN",9.8,"NM",+$P(XPD,U,2),0),U,4)=% 100 K ^XTMP("XPDT",XPDA,"KRN",9.8,DA) 101 Q 102 ; 103 RTNF ;routine file build action 104 N X,Y,% S Y=0 105 ;the routines that are left in XTMP("XPDT",XPDA,"KRN",9.8) are to be 106 ;deleted at site, move name field to RTN node 107 F S Y=$O(^XTMP("XPDT",XPDA,"KRN",9.8,Y)) Q:'Y S %=^(Y,-1),X=^(0) D 108 .I +%=1 S ^XTMP("XPDT",XPDA,"RTN",X)=%,^("RTN")=$G(^XTMP("XPDT",XPDA,"RTN"))+1 109 ;kill everything 110 K ^XTMP("XPDT",XPDA,"KRN",9.8) 111 Q 112 ; 113 PT(GR,DA) ;GR=file global ref, DA=ien, return .01 value 114 Q:'DA "" 115 Q:GR="" "" 116 I $D(@GR@(+DA,0))#2 Q $P(^(0),U) 117 Q "" 118 ; 119 GR(FN) ;returns closed global root, FN=file number 120 N Y 121 Q:'$G(FN) "" 122 S Y=$G(^DIC(FN,0,"GL")) Q:Y="" "" 123 Q $E(Y,1,($L(Y)-1))_$S($L(Y,",")>1:")",1:"") 124 ; 125 LOAD(X,XPD) ;load routine X, XPD=action^ien in Build file 126 ;XPD = 0-load, 1-delete, 2-skip, returns checksum 127 ;quit if routine is already saved 128 Q:$D(^XTMP("XPDT",XPDA,"RTN",X)) $P(^(X),U,3) 129 N DIF,XCNP,%N,%A,FDA,IEN,LN2 130 S DIF="^XTMP(""XPDT"",XPDA,""RTN"",X,",XCNP=0 131 X ^%ZOSF("LOAD") 132 S $P(^XTMP("XPDT",XPDA,"RTN",X,2,0),";",7)="Build "_(+^XPD(9.6,XPDA,6.3)),LN2=^XTMP("XPDT",XPDA,"RTN",X,2,0) 133 S IEN=$$FIND1^DIC(9.8,"","X",X) 134 ;^XTMP("XPDT",XPDA,"RTN",X)=action^ien in Build^checksum 135 S %N="B"_$$SUMB^XPDRSUM($NA(^XTMP("XPDT",XPDA,"RTN",X))) 136 S $P(XPD,"^",3)=%N ;Make sure the Checksum is in the 3rd piece 137 S ^XTMP("XPDT",XPDA,"RTN",X)=XPD 138 ;update count node 139 S ^("RTN")=$G(^XTMP("XPDT",XPDA,"RTN"))+1 140 N XUA,XUB S (XUA,XUB)="" 141 ;Update Dev Patch field in Routine file 142 I IEN D 143 . S XUB=$P(XPDT(XPDT),U,2) S:XUB["*" $P(XUB,"*",2)=+$P(XUB,"*",2) 144 . S IEN="?+2,"_IEN_",",FDA(9.819,IEN,.01)=XUB 145 . S FDA(9.819,IEN,2)=%N,FDA(9.819,IEN,3)=$P(LN2,";",5) 146 . D UPDATE^DIE("","FDA","IEN") 147 Q %N 1 XPDTA ;SFISC/RSD - Build Actions for Kernel Files ;02/14/2006 2 ;;8.0;KERNEL;**15,44,58,131,229,393**;Jul 10, 1995;Build 12 3 Q 4 ;^XTMP("XPDT",XPDA,"KRN",FILE,DA) is the global root 5 ;DA=ien in ^XTMP,XPDNM=package name, XPDA=package ien in ^XPD(9.6, 6 OPT ;options 7 N %,%1,%2 8 ;if link, kill everything and just process the menu items 9 I XPDFL=2 D G OPTT 10 .S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",19,DA,%)) Q:'% K:%'=10 ^(%) 11 ;resolve Package (0;12), remove Creator (0;5) 12 S %=^XTMP("XPDT",XPDA,"KRN",19,DA,0),$P(%,U,12)=$$PT("^DIC(9.4)",$P(%,U,12)),$P(%,U,5)="" 13 ;resolve Help Frame (0;7), kill Permitted Devices (3.96;0) & queue node (200) 14 S $P(%,U,7)=$$PT("^DIC(9.2)",$P(%,U,7)),^XTMP("XPDT",XPDA,"KRN",19,DA,0)=% K ^(3.96),^(200) 15 ;resolve Server Bulletin (220;1), Server Mailgroup (220;3) 16 I $D(^XTMP("XPDT",XPDA,"KRN",19,DA,220)) S %=^(220),$P(%,U)=$$PT("^XMB(3.6)",+%),$P(%,U,3)=$$PT("^XMB(3.8)",$P(%,U,3)),^XTMP("XPDT",XPDA,"KRN",19,DA,220)=% 17 ;resolve RPC (RPC;0), must be type Broker 18 I $D(^XTMP("XPDT",XPDA,"KRN",19,DA,"RPC")) K:$P(^(0),U,4)'="B" ^("RPC") D 19 .;kill "B"=name x-ref, it will be re-indexed when installed 20 .K ^XTMP("XPDT",XPDA,"KRN",19,DA,"RPC","B") 21 .;loop thru RPCs and resolve (RPC;1) 22 .S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",19,DA,"RPC",%)) Q:'% S %1=$G(^(%,0)) D 23 ..S %2=$$PT("^XWB(8994)",+%1) 24 ..;if can't resolve then delete 25 ..I %2="" K ^XTMP("XPDT",XPDA,"KRN",19,DA,"RPC",%,0) Q 26 ..;save the RPC name 27 ..S $P(^XTMP("XPDT",XPDA,"KRN",19,DA,"RPC",%,0),U)=%2 28 .Q 29 OPTT ;Menus can only exist for options of type: menu,protocol,protocol menu, 30 ;extended action, limited, window suite 31 I "LMOQXZ"'[$P(^XTMP("XPDT",XPDA,"KRN",19,DA,0),U,4) K ^(10) Q 32 ;kill "B"=name, "C"=synonyms x-ref, it will be re-indexed when installed 33 K ^XTMP("XPDT",XPDA,"KRN",19,DA,10,"B"),^("C") 34 ;loop thru 10=Menus and resolve Menu (10;1), kill if it doesn't resolve 35 S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",19,DA,10,%)) Q:'% S %1=$G(^(%,0)) D 36 .S %2=$$PT("^DIC(19)",+%1) 37 .;items must be sent by themselves, check "B" x-ref 38 .I $L(%2),$D(^XPD(9.6,XPDA,"KRN",19,"NM","B",%2)) S ^XTMP("XPDT",XPDA,"KRN",19,DA,10,%,U)=%2 Q 39 .;if I couldn't resolve this option, then kill it 40 .K ^XTMP("XPDT",XPDA,"KRN",19,DA,10,%) 41 Q 42 PRO ;protocols 43 N %,%1,%2 44 ;if link, kill everything and just process the menu items 45 I XPDFL=2 D G PROT 46 .S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",101,DA,%)) Q:'% K:%'=10 ^(%) 47 ;resolve Package (0;12), remove Creator (0;5) 48 S %=^XTMP("XPDT",XPDA,"KRN",101,DA,0),$P(%,U,12)=$$PT("^DIC(9.4)",$P(%,U,12)),$P(%,U,5)="" 49 ;kill under Menus (10), "B"=name, "C"=synonyms 50 S ^XTMP("XPDT",XPDA,"KRN",101,DA,0)=% 51 ;resolve File Link (5;1), its a variable pointer 52 S %=$P($G(^XTMP("XPDT",XPDA,"KRN",101,DA,5)),U),%1=$P(%,";",2) 53 I %,$D(@("^"_%1_+%_",0)")) S $P(^XTMP("XPDT",XPDA,"KRN",101,DA,5),U)=$P(^(0),U)_";"_%1 54 ;resolve HL7 fields, node 770 55 S %=$G(^XTMP("XPDT",XPDA,"KRN",101,DA,770)) I $L(%) D S ^XTMP("XPDT",XPDA,"KRN",101,DA,770)=% 56 .S $P(%,U)=$$PT("^HL(771)",$P(%,U)),$P(%,U,2)=$$PT("^HL(771)",$P(%,U,2)) 57 .S $P(%,U,3)=$$PT("^HL(771.2)",$P(%,U,3)),$P(%,U,11)=$$PT("^HL(771.2)",$P(%,U,11)) 58 .S $P(%,U,4)=$$PT("^HL(779.001)",$P(%,U,4)),$P(%,U,7)=$$PT("^HLCS(870)",$P(%,U,7)) 59 .S $P(%,U,8)=$$PT("^HL(779.003)",$P(%,U,8)),$P(%,U,9)=$$PT("^HL(779.003)",$P(%,U,9)) 60 .S $P(%,U,10)=$$PT("^HL(771.5)",$P(%,U,10)) 61 PROT ;loop thru 10=Menus and resolve Menu (10;1), kill if it doesn't resolve 62 ;kill under Menus (10), "B"=name, "C"=synonyms 63 I $D(^XTMP("XPDT",XPDA,"KRN",101,DA,10,0)) K ^("B"),^("C") 64 S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",101,DA,10,%)) Q:'% S %1=$G(^(%,0)) D 65 .;%2=.01 of Menu(protocol) 66 .S %2=$$PT("^ORD(101)",+%1) 67 .;Menu must also be sent by itself, check "B" x-ref 68 .I $L(%2),$D(^XPD(9.6,XPDA,"KRN",101,"NM","B",%2)) S ^XTMP("XPDT",XPDA,"KRN",101,DA,10,%,U)=%2,$P(^XTMP("XPDT",XPDA,"KRN",101,DA,10,%,0),U,4)=$$PT("^ORD(101)",$P(%1,U,4)) Q 69 .K ^XTMP("XPDT",XPDA,"KRN",101,DA,10,%) 70 ;If type is Event Driver and sending Subscribers (775) 71 I $P(^XTMP("XPDT",XPDA,"KRN",101,DA,0),U,4)="E" D 72 . ;kill Menu multiple and Subscriber x-ref "B"=name 73 . K ^XTMP("XPDT",XPDA,"KRN",101,DA,10),^(775,"B") 74 . ;loop thru 775=Subscribers and resolve pointer (775;1) 75 . S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",101,DA,775,%)) Q:'% S %1=$G(^(%,0)) D 76 .. ;%2=.01 of subscriber(protocol) 77 .. S %2=$$PT("^ORD(101)",+%1) 78 .. ;protocol must also be sent by itself, check "B" x-ref 79 .. I $L(%2),$D(^XPD(9.6,XPDA,"KRN",101,"NM","B",%2)) S ^XTMP("XPDT",XPDA,"KRN",101,DA,775,%,U)=%2 Q 80 .. K ^XTMP("XPDT",XPDA,"KRN",101,DA,775,%) 81 ;quit if no Access multiple 82 Q:'$D(^XTMP("XPDT",XPDA,"KRN",101,DA,3,0)) K ^("B") 83 ;loop thru Access and resolve (3;1), kill if it doesn't resolve 84 S %=0 F S %=$O(^XTMP("XPDT",XPDA,"KRN",101,DA,3,%)) Q:'% S %1=$G(^(%,0)) D 85 .;%2=.01 of Menu(protocol) 86 .S %2=$$PT("^DIC(19.1)",+%1) 87 .I $L(%2) S ^XTMP("XPDT",XPDA,"KRN",101,DA,3,%,0)=%2 Q 88 .K ^XTMP("XPDT",XPDA,"KRN",101,DA,3,%) 89 Q 90 RTNE ;routine entry build action 91 N %,X,XPD 92 ;move routine to ^XTMP("XPDT",DPK1,"RTN",routine name 93 ;routines will have the checksum in XTMP("XPDT",XPDA,"RTN",X) & in 94 ;Build file 95 S X=$P(^XTMP("XPDT",XPDA,"KRN",9.8,DA,0),U),XPD=^(-1) 96 Q:X="" S %=$$LOAD(X,XPD),$P(^XPD(9.6,XPDA,"KRN",9.8,"NM",+$P(XPD,U,2),0),U,4)=% 97 K ^XTMP("XPDT",XPDA,"KRN",9.8,DA) 98 Q 99 RTNF ;routine file build action 100 N X,Y,% S Y=0 101 ;the routines that are left in XTMP("XPDT",XPDA,"KRN",9.8) are to be 102 ;deleted at site, move name field to RTN node 103 F S Y=$O(^XTMP("XPDT",XPDA,"KRN",9.8,Y)) Q:'Y S %=^(Y,-1),X=^(0) D 104 .I +%=1 S ^XTMP("XPDT",XPDA,"RTN",X)=%,^("RTN")=$G(^XTMP("XPDT",XPDA,"RTN"))+1 105 ;kill everything 106 K ^XTMP("XPDT",XPDA,"KRN",9.8) 107 Q 108 PT(GR,DA) ;GR=file global ref, DA=ien, return .01 value 109 Q:'DA "" 110 I $D(@GR@(+DA,0))#2 Q $P(^(0),U) 111 Q "" 112 ; 113 LOAD(X,XPD) ;load routine X, XPD=action^ien in Build file 114 ;XPD = 0-load, 1-delete, 2-skip, returns checksum 115 ;quit if routine is already saved 116 Q:$D(^XTMP("XPDT",XPDA,"RTN",X)) $P(^(X),U,3) 117 N DIF,XCNP,%N,%A,FDA,IEN,LN2 118 S DIF="^XTMP(""XPDT"",XPDA,""RTN"",X,",XCNP=0 119 X ^%ZOSF("LOAD") 120 S $P(^XTMP("XPDT",XPDA,"RTN",X,2,0),";",7)="Build "_(+^XPD(9.6,XPDA,6.3)),LN2=^XTMP("XPDT",XPDA,"RTN",X,2,0) 121 S IEN=$$FIND1^DIC(9.8,"","X",X) 122 ;^XTMP("XPDT",XPDA,"RTN",X)=action^ien in Build^checksum 123 S %N="B"_$$SUMB^XPDRSUM($NA(^XTMP("XPDT",XPDA,"RTN",X))) 124 S $P(XPD,"^",3)=%N ;Make sure the Checksum is in the 3rd piece 125 S ^XTMP("XPDT",XPDA,"RTN",X)=XPD 126 ;update count node 127 S ^("RTN")=$G(^XTMP("XPDT",XPDA,"RTN"))+1 128 N XUA,XUB S (XUA,XUB)="" 129 ;Update Dev Patch field in Routine file 130 I IEN D 131 . S XUB=$P(XPDT(XPDT),U,2) S:XUB["*" $P(XUB,"*",2)=+$P(XUB,"*",2) 132 . S IEN="?+2,"_IEN_",",FDA(9.819,IEN,.01)=XUB 133 . S FDA(9.819,IEN,2)=%N,FDA(9.819,IEN,3)=$P(LN2,";",5) 134 . D UPDATE^DIE("","FDA","IEN") 135 Q %N
Note:
See TracChangeset
for help on using the changeset viewer.
