| 1 | TMGXPDUT ;TMG/kst/Custom version of XPDUTL ;09/17/08
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;09/17/08
|
|---|
| 3 |
|
|---|
| 4 | ;"Original header....
|
|---|
| 5 | ;"XPDUTL ;SFISC/RSD - KIDS utilities ;03/25/2003 15:00
|
|---|
| 6 | ;";;8.0;KERNEL;**21,28,39,81,100,108,137,181,275**;Jul 10, 1995
|
|---|
| 7 | Q
|
|---|
| 8 |
|
|---|
| 9 | VERSION(X) ;"Get current version from Package file, X=package name or
|
|---|
| 10 | ;package namespace
|
|---|
| 11 | N I
|
|---|
| 12 | S I=$O(^DIC(9.4,"C",X,0)) S:I'>0 I=$O(^DIC(9.4,"B",X,0))
|
|---|
| 13 | Q $P($G(^DIC(9.4,+I,"VERSION")),"^")
|
|---|
| 14 | ;
|
|---|
| 15 | VER(X) ;"returns version number from Build file, X=build name
|
|---|
| 16 | Q:X["*" $P(X,"*",2)
|
|---|
| 17 | Q $P(X," ",$L(X," "))
|
|---|
| 18 | ;
|
|---|
| 19 | STATUS(IEN) ;"returns build status from Build File, IEN=Build File IEN
|
|---|
| 20 | I '$D(^XPD(9.7,IEN,0)) Q -1
|
|---|
| 21 | Q $P(^XPD(9.7,IEN,0),U,9)
|
|---|
| 22 | ;
|
|---|
| 23 | PKG(X) ;"returns package name from Build file, X=build name
|
|---|
| 24 | Q $S(X["*":$P(X,"*"),1:$P(X," ",1,$L(X," ")-1))
|
|---|
| 25 | ;
|
|---|
| 26 | LAST(PKG,VER) ;returns last patch applied for a Package, PATCH^DATE
|
|---|
| 27 | ; Patch includes Seq # if Released
|
|---|
| 28 | N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
|
|---|
| 29 | I $G(VER)="" S VER=$$VERSION(PKG) Q:'VER -1
|
|---|
| 30 | S PKGIEN=$O(^DIC(9.4,"B",PKG,"")) Q:'PKGIEN -1
|
|---|
| 31 | S VERIEN=$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN -1
|
|---|
| 32 | S LATEST=-1,PATCH=-1,SUBIEN=0
|
|---|
| 33 | F S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0 D
|
|---|
| 34 | . I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U)
|
|---|
| 35 | Q PATCH_U_LATEST
|
|---|
| 36 | ;
|
|---|
| 37 | PATCH(X) ;"return 1 if patch X was installed, X=aaaa*nn.nn*nnn
|
|---|
| 38 | Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.3N 0
|
|---|
| 39 | N %,I,J
|
|---|
| 40 | S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
|
|---|
| 41 | S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
|
|---|
| 42 | ;check if patch is just a number
|
|---|
| 43 | Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
|
|---|
| 44 | S %=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
|
|---|
| 45 | Q (X=+%)
|
|---|
| 46 | ;
|
|---|
| 47 | NEWCP(XPD,XPDC,XPDP) ;create new check point, returns 0=error or ien
|
|---|
| 48 | ;XPD=name, XPDC=call back, XPDP=parameters
|
|---|
| 49 | Q:$G(XPD)="" 0
|
|---|
| 50 | N %,XPDI,XPDJ,XPDF,XPDY
|
|---|
| 51 | ;XPDCP="INI"=Pre-init, "INIT"=Post-init
|
|---|
| 52 | S XPDI=$S(XPDCP="INIT":9.716,1:9.713)
|
|---|
| 53 | S %=$$FIND1^DIC(XPDI,","_XPDA_",","X",XPD) Q:% %
|
|---|
| 54 | S XPDF="+1,"_XPDA_",",XPDJ(XPDI,XPDF,.01)=XPD
|
|---|
| 55 | S:$D(XPDC) XPDJ(XPDI,XPDF,2)=XPDC
|
|---|
| 56 | S:$D(XPDP) XPDJ(XPDI,XPDF,3)=XPDP
|
|---|
| 57 | D UPDATE^DIE("","XPDJ","XPDY")
|
|---|
| 58 | Q $G(XPDY(1))
|
|---|
| 59 | ;
|
|---|
| 60 | UPCP(XPD,XPDP) ;update check point, returns 0=error or ien
|
|---|
| 61 | ;XPD=name, XPDP=parameters
|
|---|
| 62 | N XPDI,XPDJ,XPDF,XPDY
|
|---|
| 63 | ;XPDCP="INI"=Pre-init, "INIT"=Post-init
|
|---|
| 64 | S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD))
|
|---|
| 65 | Q:'XPDY 0
|
|---|
| 66 | S XPDF=XPDY_","_XPDA_","
|
|---|
| 67 | S:$D(XPDP) XPDJ(XPDI,XPDF,3)=XPDP
|
|---|
| 68 | D FILE^DIE("","XPDJ")
|
|---|
| 69 | Q XPDY
|
|---|
| 70 | ;
|
|---|
| 71 | COMCP(XPD) ;complete check point, returns 0=error or date/time
|
|---|
| 72 | ;XPD=name
|
|---|
| 73 | N XPDD,XPDI,XPDJ,XPDY
|
|---|
| 74 | S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD))
|
|---|
| 75 | Q:'XPDY 0
|
|---|
| 76 | S XPDD=$$NOW^XLFDT,XPDJ(XPDI,XPDY_","_XPDA_",",1)=XPDD
|
|---|
| 77 | D FILE^DIE("","XPDJ")
|
|---|
| 78 | Q XPDD
|
|---|
| 79 | ;
|
|---|
| 80 | VERCP(XPD) ;verify check point, returns 1=completed, 0=not
|
|---|
| 81 | ;-1=doesn't exist
|
|---|
| 82 | ;XPD=name
|
|---|
| 83 | N XPDI,XPDY
|
|---|
| 84 | S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD))
|
|---|
| 85 | Q:'XPDY -1
|
|---|
| 86 | Q ''$$GET1^DIQ(XPDI,XPDY_","_XPDA_",",1,"I")
|
|---|
| 87 | ;
|
|---|
| 88 | PARCP(XPD,XPDF) ;returns parameters of check point
|
|---|
| 89 | ;XPD=name, XPDF="PRE"
|
|---|
| 90 | N XPDI,XPDY
|
|---|
| 91 | I $G(XPDF)="PRE" N XPDCP S XPDCP="INI"
|
|---|
| 92 | S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD))
|
|---|
| 93 | Q:'XPDY 0
|
|---|
| 94 | Q $$GET1^DIQ(XPDI,XPDY_","_XPDA_",",3,"I")
|
|---|
| 95 | ;
|
|---|
| 96 | CURCP(XPDF) ;returns current check point
|
|---|
| 97 | ;XPDF flag - 0=externel, 1=internal
|
|---|
| 98 | Q $S($G(XPDF):XPDCHECK,1:XPDCHECK(0))
|
|---|
| 99 | ;
|
|---|
| 100 | WP(X) ;X=global ref
|
|---|
| 101 | N %
|
|---|
| 102 | Q:'$D(@X)
|
|---|
| 103 | F %=1:1 Q:'$D(@X@(%)) W !,@X@(%)
|
|---|
| 104 | Q:'$G(XPDA) D WP^DIE(9.7,XPDA_",",20,"A",X)
|
|---|
| 105 | Q
|
|---|
| 106 |
|
|---|
| 107 | MES(X,Msg)
|
|---|
| 108 | ;"Purpose: Record message, X=message or an array passed by reference
|
|---|
| 109 | ;"Input: X -- string of message
|
|---|
| 110 | ;" Msg -- PASS BY REFERENCE, an OUT PARAMETER.
|
|---|
| 111 | ;" Message are store in Msg(x)=Message
|
|---|
| 112 | ;" Msg=count of last message+1
|
|---|
| 113 |
|
|---|
| 114 | N %
|
|---|
| 115 | I $D(X)#2 do
|
|---|
| 116 | . S %=X
|
|---|
| 117 | . K X
|
|---|
| 118 | . S X(1)=%
|
|---|
| 119 | ;"write message
|
|---|
| 120 | set Msg=$get(Msg,1)
|
|---|
| 121 | F %=1:1 Q:'$D(X(%)) do
|
|---|
| 122 | . set Msg(Msg)=X(%),Msg=Msg+1
|
|---|
| 123 | Q:'$G(XPDA)
|
|---|
| 124 | D WP^DIE(9.7,XPDA_",",20,"A","X") ;"Store message in file 9.7
|
|---|
| 125 | Q
|
|---|
| 126 |
|
|---|
| 127 | BMES(X,Msg)
|
|---|
| 128 | ;"Purpose Add blank line before message
|
|---|
| 129 | ;"Input: Msg -- PASS BY REFERENCE, an OUT PARAMETER.
|
|---|
| 130 | ;" Message are store in Msg(x)=Message
|
|---|
| 131 | ;" Msg=count of last message+1
|
|---|
| 132 | N %
|
|---|
| 133 | I $D(X)#2 do
|
|---|
| 134 | . S %=X
|
|---|
| 135 | . K X
|
|---|
| 136 | . S X(1)=" ",X(2)=%
|
|---|
| 137 | D MES(.X,.Msg)
|
|---|
| 138 | Q
|
|---|
| 139 |
|
|---|
| 140 | RTNUP(X,Y) ;update routine action, X=routine, Y=action
|
|---|
| 141 | ;actions: 1=delete, 2=skip
|
|---|
| 142 | N %
|
|---|
| 143 | ;set action to Y
|
|---|
| 144 | Q:'$G(Y)!'$D(^XTMP("XPDI",$G(XPDA),"RTN",X)) 0 S $P(^(X),U)=+Y
|
|---|
| 145 | Q 1
|
|---|
| 146 | ;get Build ien
|
|---|
| 147 | S Y=$O(^XTMP("XPDI",XPDA,"BLD",0))
|
|---|
| 148 | ;remove checksum when updating action, since action can only be
|
|---|
| 149 | ;delete or skip, not sure if we want to do this
|
|---|
| 150 | S:$P(%,U,2) $P(^XTMP("XPDI",XPDA,"BLD",Y,"KRN",9.8,"NM",$P(%,U,2),0),U,4)=""
|
|---|
| 151 | Q 1
|
|---|
| 152 | ;
|
|---|
| 153 | RTNLOG(X) ;Enter/Update routine in the Routine File
|
|---|
| 154 | N Y,FDA,IEN
|
|---|
| 155 | S Y=$O(^DIC(9.8,"B",X,0))
|
|---|
| 156 | I Y'>0 S IEN="?+1,",FDA(9.8,IEN,1)="R"
|
|---|
| 157 | I Y>0 S IEN=(+Y)_","
|
|---|
| 158 | S FDA(9.8,IEN,.01)=X,FDA(9.8,IEN,7.4)=$$NOW^XLFDT
|
|---|
| 159 | D UPDATE^DIE("","FDA","IEN")
|
|---|
| 160 | Q
|
|---|
| 161 | ;
|
|---|
| 162 | DICCP(X) ;lookup check point, returns ien or 0
|
|---|
| 163 | Q:$G(X)="" 0
|
|---|
| 164 | ;if they pass ien, fail if can't find
|
|---|
| 165 | I X=+X S Y=X Q:'$D(^XPD(9.7,XPDA,XPDCP,Y,0)) 0
|
|---|
| 166 | E S Y=$$FIND1^DIC(XPDI,","_XPDA_",","X",X)
|
|---|
| 167 | Q Y
|
|---|
| 168 | ;
|
|---|
| 169 | PRODE(XPDN,XPD) ;enable/disable protocols, return 1 for success
|
|---|
| 170 | ;XPDN=protocol name, XPD=1-enable, 0-disable
|
|---|
| 171 | Q:$G(XPDN)="" 0
|
|---|
| 172 | S XPD=+$G(XPD)
|
|---|
| 173 | D KIDS^XQOO1($P(XPDSET,U,2),101,XPDN,.XPD)
|
|---|
| 174 | Q $S(XPD<0:0,1:1)
|
|---|
| 175 | ;
|
|---|
| 176 | OPTDE(XPDN,XPD) ;enable/disable options, return 1 for success
|
|---|
| 177 | ;XPDN=protocol name, XPD=1-enable, 0-disable
|
|---|
| 178 | Q:$G(XPDN)="" 0
|
|---|
| 179 | S XPD=+$G(XPD)
|
|---|
| 180 | D KIDS^XQOO1($P(XPDSET,U,2),19,XPDN,.XPD)
|
|---|
| 181 | Q $S(XPD<0:0,1:1)
|
|---|
| 182 | ;
|
|---|
| 183 | BUILD(XPDN,XPD) ;check if a build exists, return 1 for success
|
|---|
| 184 | ;XPDN=build name, XPD=1-exist, 0-been removed
|
|---|
| 185 | S XPD=$D(XPDT("NM",XPDN))
|
|---|
| 186 | Q XPD
|
|---|
| 187 | ;
|
|---|
| 188 | MAILGRP(X) ;Return mail group for package, X=package name or namespace
|
|---|
| 189 | N XD,DIC,DR,DA,DIQ
|
|---|
| 190 | S DA=$O(^DIC(9.4,"C",X,0)) S:DA'>0 DA=$O(^DIC(9.4,"B",X,0)) Q:'DA ""
|
|---|
| 191 | S DIC="^DIC(9.4,",DR=1938,DIQ="XD" D EN^DIQ1
|
|---|
| 192 | Q $S($G(XD(9.4,DA,1938))="":"",1:"G."_XD(9.4,DA,1938))
|
|---|
