[796] | 1 |
|
---|
| 2 |
|
---|
| 3 |
|
---|
| 4 | ;"=====================================================================
|
---|
| 5 | ;"================================================================
|
---|
| 6 |
|
---|
| 7 | ENV ;Establish Routine Environment
|
---|
| 8 | N DDH,DIR,X,Y,ZTENV,ZTKEY,ZTNAME,ZTSK,XUTMUCI
|
---|
| 9 | D ENV^XUTMUTL Q:'$D(ZTENV)
|
---|
| 10 | ;
|
---|
| 11 | new DIC,X,Y
|
---|
| 12 | set DIC=.401
|
---|
| 13 | set DIC(0)="MAEQ"
|
---|
| 14 | do ^DIC write !
|
---|
| 15 | if +Y'>0 quit
|
---|
| 16 | new templIEN set tempLIEN=+Y
|
---|
| 17 | new IEN set IEN=""
|
---|
| 18 | for set IEN=$order(^DIBT(tempLIEN,1,IEN)) quit:IEN="" do
|
---|
| 19 | . do KILLTSK(IEN)
|
---|
| 20 |
|
---|
| 21 | quit
|
---|
| 22 |
|
---|
| 23 |
|
---|
| 24 | KILLTSK(ZTSK)
|
---|
| 25 | ;"W !
|
---|
| 26 | ;"S XUTMT(0)="AL"
|
---|
| 27 | ;"D ^XUTMT
|
---|
| 28 | I 'ZTSK K ^TMP($J,"XUTMT") Q
|
---|
| 29 | ;"I ZTSK["-"!(ZTSK[",") D ^XUTMD1 Q:$D(DTOUT) G SELECT
|
---|
| 30 | S XUTMT=ZTSK,XUTMT(0)="R3"
|
---|
| 31 | D ^XUTMT
|
---|
| 32 | ;
|
---|
| 33 | STATUS ;Report On Status Of Task And Whether User May Delete It
|
---|
| 34 | I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED",$O(ZTSK(.3))="" W !!?5,"That task is not defined.",$C(7) G SELECT
|
---|
| 35 | I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED",$O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" W !!?5,"That task is running and has no record." G SELECT
|
---|
| 36 | I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED" W !!?5,"That task is scheduled but has no record." G CONFIRM:ZTKEY G SELECT
|
---|
| 37 | ;
|
---|
| 38 | S5 I $D(ZTSK(.11))#2,$O(ZTSK(.3))="" W !!?5,"That task's record is incomplete." G CONFIRM:ZTKEY G SELECT
|
---|
| 39 | I $D(ZTSK(.11))#2,$O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" W !!?5,"That task is running and has an incomplete record." G SELECT
|
---|
| 40 | I $D(ZTSK(.11))#2 W !!?5,"That task is scheduled, but has an incomplete record." G CONFIRM:ZTKEY G SELECT
|
---|
| 41 | ;
|
---|
| 42 | S9 I $O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" W !!?5,"That task is running." G SELECT
|
---|
| 43 | I 'ZTKEY,$S($P(ZTSK(0),U,11)_","_$P(ZTSK(0),U,12)=XUTMUCI:DUZ'=$P(ZTSK(0),U,3),1:ZTNAME'=$P(ZTSK(0),U,10)) W !!?5,"You may only delete your own tasks." G SELECT
|
---|
| 44 | ;
|
---|
| 45 | CONFIRM ;Prompt User To Confirm Unscheduling
|
---|
| 46 | I $S($D(ZTSK(.11))[0:1,1:ZTSK(.11)'="UNDEFINED") W ! D EN^XUTMTP(ZTSK)
|
---|
| 47 | ;"W !
|
---|
| 48 | ;"K DIR
|
---|
| 49 | ;"S DIR(0)="Y"
|
---|
| 50 | ;"S DIR("A")="Are you sure you want to delete this task"
|
---|
| 51 | ;"S DIR("B")="NO"
|
---|
| 52 | ;"S DIR("?")=" Answer YES to delete the task."
|
---|
| 53 | ;"D ^DIR
|
---|
| 54 | ;"I 'Y W !!?5,"Tasks NOT deleted!"
|
---|
| 55 | ;"I $D(DTOUT) W $C(7) Q
|
---|
| 56 | ;"K DIR,DIRUT,DTOUT,DUOUT
|
---|
| 57 | ;"I 'Y G SELECT
|
---|
| 58 | ;
|
---|
| 59 | DELETE ;Delete Task
|
---|
| 60 | I $D(ZTSK(0))#2,ZTSK(0)["ZTSK^XQ1",$P(ZTSK(0),U,11)_","_$P(ZTSK(0),U,12)=XUTMUCI,$P(ZTSK(0),U,8)]"" D
|
---|
| 61 | . F DA=0:0 S DA=$O(^DIC(19.2,DA)) Q:DA'>0 I $G(^DIC(19.2,DA,1))=ZTSK D
|
---|
| 62 | . . N DIE S DIE="^DIC(19.2,",DR="2///@;12///@" D ^DIE Q
|
---|
| 63 | . Q
|
---|
| 64 | S XUTMT=ZTSK,XUTMT(0)="D"
|
---|
| 65 | D ^XUTMT
|
---|
| 66 | W !!?5,"Deleted!"
|
---|
| 67 | G SELECT
|
---|
| 68 | ;
|
---|
| 69 |
|
---|
| 70 | SELECT
|
---|
| 71 | quit
|
---|
| 72 |
|
---|
| 73 |
|
---|
| 74 |
|
---|
| 75 | FS1
|
---|
| 76 | NEW X,Y,DIC
|
---|
| 77 | SET DIC=1,DIC(0)="MAEQ"
|
---|
| 78 | DO ^DIC WRITE !
|
---|
| 79 | IF +Y'>0 QUIT
|
---|
| 80 | NEW I SET I=""
|
---|
| 81 | FOR SET I=$ORDER(^TMG("TMGSIPH","NEEDED RECORDS",+Y,I)) QUIT:(I'>0) DO
|
---|
| 82 | . NEW NODE SET NODE=""
|
---|
| 83 | . FOR SET NODE=$ORDER(^TMG("TMGSIPH","NEEDED RECORDS",+Y,I,NODE)) QUIT:(NODE="") DO
|
---|
| 84 | . . KILL ^TMG("TMGSIPH","NEEDED RECORDS",+Y,I,NODE)
|
---|
| 85 | . . SET ^TMG("TMGSIPH","NEEDED RECORDS",+Y,I,NODE,0)=""
|
---|
| 86 | QUIT
|
---|
| 87 |
|
---|
| 88 | KILLTMPL
|
---|
| 89 | new X,Y,DIC
|
---|
| 90 | set DIC=.401
|
---|
| 91 | set DIC(0)="MAEQ"
|
---|
| 92 | do ^DIC write !
|
---|
| 93 | if +Y'>0 write "goodbye.",! quit
|
---|
| 94 | NEW TMPL SET TMPL=+Y
|
---|
| 95 | new file set file=$piece($get(^DIBT(TMPL,0)),"^",4)
|
---|
| 96 | if file'=8925 do quit
|
---|
| 97 | . write "That file doesn't refer to file 8925. That is all this function can work with!",!
|
---|
| 98 | new % set %=2
|
---|
| 99 | write "Delete all the records referred to in this sort template?" do YN^DICN write !
|
---|
| 100 | if %'=1 write "goodbye.",! quit
|
---|
| 101 | new MIN,MAX
|
---|
| 102 | set MIN=$ORDER(^DIBT(TMPL,1,0))
|
---|
| 103 | set MAX=$ORDER(^DIBT(TMPL,1,""),-1)
|
---|
| 104 | new TMGCT set TMGCT=0
|
---|
| 105 | new STIME set STIME=$H
|
---|
| 106 | new TMGIEN set TMGIEN=0
|
---|
| 107 | for set TMGIEN=$ORDER(^DIBT(TMPL,1,TMGIEN)) quit:(+TMGIEN'>0) do
|
---|
| 108 | . ;"write TMGIEN,! quit
|
---|
| 109 | . new TMGFDA set TMGFDA(8925,TMGIEN_",",.01)="@"
|
---|
| 110 | . ;"new TMGFDA set TMGFDA(8925,TMGIEN_",",.05)="COMPLETED"
|
---|
| 111 | . new TMGMSG
|
---|
| 112 | . do FILE^DIE("E","TMGFDA","TMGMSG")
|
---|
| 113 | . NEW RPTR SET RPTR=+$GET(^TMG("TMGSIPH","DOWNLOADED",8925,TMGIEN))
|
---|
| 114 | . KILL ^TMG("TMGSIPH","DOWNLOADED",8925,TMGIEN)
|
---|
| 115 | . KILL ^TMG("TMGSIPH","PT XLAT",8925,RPTR)
|
---|
| 116 | . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
|
---|
| 117 | . set TMGCT=TMGCT+1
|
---|
| 118 | . if TMGCT>50 do
|
---|
| 119 | . . do ProgressBar^TMGUSRIF(TMGIEN,"Deleting records",MIN,MAX,70,STIME)
|
---|
| 120 | . . set TMGCT=0
|
---|
| 121 | write "goodbye.",!
|
---|
| 122 | quit
|
---|
| 123 |
|
---|
| 124 |
|
---|
| 125 | FIXXREF ;
|
---|
| 126 | NEW FILENUM SET FILENUM=0
|
---|
| 127 | FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","PT XLAT",FILENUM)) QUIT:(+FILENUM'>0) DO
|
---|
| 128 | . NEW RPTR SET RPTR=0
|
---|
| 129 | . FOR SET RPTR=$ORDER(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)) QUIT:(+RPTR'>0) DO
|
---|
| 130 | . . NEW LPTR SET LPTR=+$GET(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR))
|
---|
| 131 | . . IF LPTR'>0 WRITE "FILE ",FILENUM,", REMOTE IEN=",RPTR," --> ?? LOCAL PTR",! QUIT
|
---|
| 132 | . . IF $DATA(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR))=0 DO QUIT
|
---|
| 133 | . . . WRITE "FILE ",FILENUM,", LOCAL IEN=",LPTR," --> Not downloaded??",!
|
---|
| 134 | . . SET ^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR)=RPTR
|
---|
| 135 | . . WRITE "Set ",$NAME(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR)),"=",RPTR,!
|
---|
| 136 | quit
|
---|
| 137 |
|
---|
| 138 |
|
---|
| 139 | ;" ; Note: ENTRY=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
|
---|
| 140 | ;" ; ONEREF will have multiple IEN entries if IENDepth>1, e.g. '^SC(IEN,"S",IEN(2),1,IEN(3),"C")'
|
---|
| 141 | ;" ; with order of IEN, IEN(2), IEN(3), ... etc.
|
---|
| 142 | FIXSUBFILES ;
|
---|
| 143 | NEW FILENUM SET FILENUM=0
|
---|
| 144 | NEW ABORT SET ABORT=0
|
---|
| 145 | FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM)) QUIT:(+FILENUM'>0)!ABORT DO
|
---|
| 146 | . NEW TMP SET TMP=$$HASPTRSF^TMGFMUT2(FILENUM)
|
---|
| 147 | . IF TMP DO
|
---|
| 148 | . . WRITE "FILE ",FILENUM," has pointer subfiles.... probably needs fix.",!
|
---|
| 149 | . . ;"IF $$DDOK^TMGSIPH1(JNUM,FILENUM)
|
---|
| 150 | . . IF $$SETPTOUT^TMGSIPH1(FILENUM)
|
---|
| 151 | . . NEW ONEREF SET ONEREF=""
|
---|
| 152 | . . FOR SET ONEREF=$ORDER(^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",ONEREF)) QUIT:(ONEREF="")!ABORT DO
|
---|
| 153 | . . . ;"WRITE "ONEREF=",ONEREF,!
|
---|
| 154 | . . . NEW ENTRY SET ENTRY=""
|
---|
| 155 | . . . FOR SET ENTRY=$ORDER(^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",ONEREF,ENTRY)) QUIT:(ENTRY="")!ABORT DO
|
---|
| 156 | . . . . NEW IENDEPTH SET IENDEPTH=$PIECE(ENTRY,"^",4)
|
---|
| 157 | . . . . IF IENDEPTH=1 QUIT
|
---|
| 158 | . . . . NEW PCE SET PCE=+ENTRY
|
---|
| 159 | . . . . ;"WRITE " ENTRY=",ENTRY,!
|
---|
| 160 | . . . . NEW IEN SET IEN=0
|
---|
| 161 | . . . . NEW GREF SET GREF=^DIC(FILENUM,0,"GL") QUIT:(GREF="")
|
---|
| 162 | . . . . NEW CGREF SET CGREF=$$CREF^DILF(GREF)
|
---|
| 163 | . . . . FOR SET IEN=$ORDER(@CGREF@(IEN)) QUIT:(+IEN'>0)!ABORT DO
|
---|
| 164 | . . . . . FOR QUIT:($$IENCOMBO^TMGFMUT2(ONEREF,IENDEPTH,.IEN)'=1)!ABORT DO
|
---|
| 165 | . . . . . . SET ABORT=$$UserAborted^TMGUSRIF QUIT:ABORT
|
---|
| 166 | . . . . . . NEW TMPREF SET TMPREF=$NAME(@ONEREF) ;"Puts IEN's from IEN array into name.
|
---|
| 167 | . . . . . . NEW IENS SET IENS=$$GETIENS^TMGFMUT2(.IEN)
|
---|
| 168 | . . . . . . IF $GET(^TMG("TMGSIPH","FIX",FILENUM,TMPREF))'="" QUIT ;"Already fixed.
|
---|
| 169 | . . . . . . NEW FROMFILE SET FROMFILE=$PIECE(ENTRY,"^",6)
|
---|
| 170 | . . . . . . NEW PT SET PT=$PIECE($GET(@TMPREF),"^",PCE) ;"$$IENCOMBO sets up IEN(n).. needed for @REF
|
---|
| 171 | . . . . . . NEW ISVIRT SET ISVIRT=($PIECE(ENTRY,"^",5)="V")
|
---|
| 172 | . . . . . . NEW P2REF SET P2REF=$PIECE(ENTRY,"^",3)
|
---|
| 173 | . . . . . . IF ISVIRT,$PIECE(PT,";",2)'=P2REF QUIT ;"Loop to handle PTR with different ENTRY (V-Ptrs stored as IEN;OREF)
|
---|
| 174 | . . . . . . SET PT=+PT QUIT:(PT'>0)
|
---|
| 175 | . . . . . . NEW P2FILE SET P2FILE=$PIECE(ENTRY,"^",2)
|
---|
| 176 | . . . . . . NEW FROMFLD SET FROMFLD=$PIECE(ENTRY,"^",7)
|
---|
| 177 | . . . . . . NEW LPTR SET LPTR=$GET(^TMG("TMGSIPH","PT XLAT",P2FILE,PT),"??")
|
---|
| 178 | . . . . . . WRITE "FILENUM: ",FILENUM," IENS=",IENS," ",TMPREF," --> PTR=",PT," in file: ",P2FILE," LPTR=",LPTR,!
|
---|
| 179 | . . . . . . IF LPTR'="??" DO
|
---|
| 180 | . . . . . . . IF (PT'=LPTR) SET $PIECE(@TMPREF,"^",PCE)=LPTR
|
---|
| 181 | . . . . . . . SET ^TMG("TMGSIPH","FIX",FILENUM,TMPREF)=PT ;"Store old value just in case...
|
---|
| 182 | . . . . . . ELSE DO
|
---|
| 183 | . . . . . . . SET ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",P2FILE,PT,TMPREF,ENTRY)=""
|
---|
| 184 | . . . . . . . ;"IF $$NEEDPTIN^TMGSIPH3(FILENUM) DO
|
---|
| 185 | . . . . . . . ;". SET ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,)=""
|
---|
| 186 | . . . . . NEW TMPIEN SET TMPIEN=IEN KILL IEN SET IEN=TMPIEN ;"delete subnodes in array.
|
---|
| 187 | do PRESSTOCONT^TMGUSRIF
|
---|
| 188 | quit
|
---|
| 189 |
|
---|
| 190 |
|
---|
| 191 | ;" ; Note: ENTRY=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
|
---|
| 192 | ;" ; ONEREF will have multiple IEN entries if IENDepth>1, e.g. '^SC(IEN,"S",IEN(2),1,IEN(3),"C")'
|
---|
| 193 | ;" ; with order of IEN, IEN(2), IEN(3), ... etc.
|
---|
| 194 | FIXDDSUBFILES ;
|
---|
| 195 | NEW FILENUM SET FILENUM=0
|
---|
| 196 | NEW ABORT SET ABORT=0
|
---|
| 197 | FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM)) QUIT:(+FILENUM'>0)!ABORT DO
|
---|
| 198 | . ;"NEW TMP SET TMP=$$HASPTRSF^TMGFMUT2(FILENUM)
|
---|
| 199 | . ;"IF TMP DO
|
---|
| 200 | . WRITE "FILE ",FILENUM," has had DD reset.",!
|
---|
| 201 | . IF $$SETPTOUT^TMGSIPH1(FILENUM)
|
---|
| 202 | do PRESSTOCONT^TMGUSRIF
|
---|
| 203 | quit
|
---|
| 204 |
|
---|
| 205 |
|
---|
| 206 | FTIU
|
---|
| 207 | new IEN set IEN=0
|
---|
| 208 | for set IEN=$O(^TIU(8925,IEN)) q:(+IEN'>0) if $D(^TIU(8925,IEN,"TEMP")) do
|
---|
| 209 | . write IEN
|
---|
| 210 | . if $D(^TIU(8925,IEN,"TEXT"))=0 do quit
|
---|
| 211 | . . write "NO TEXT"
|
---|
| 212 | . . merge ^TIU(8925,IEN,"TEXT")=^TIU(8925,IEN,"TEMP")
|
---|
| 213 | . . kill ^TIU(8925,IEN,"TEMP")
|
---|
| 214 | . . write " -- FIXED",!
|
---|
| 215 | . new SAME set SAME=1
|
---|
| 216 | . new j set j=0
|
---|
| 217 | . for set j=$o(^TIU(8925,IEN,"TEMP",j)) quit:(+j'>0)!(SAME=0)
|
---|
| 218 | . . if $G(^TIU(8925,IEN,"TEMP",j,0))'=$G(^TIU(8925,IEN,"TEXT",j,0)) set SAME=0
|
---|
| 219 | . write " --> SAME=",SAME
|
---|
| 220 | . if SAME kill ^TIU(8925,IEN,"TEMP") write " FIXED."
|
---|
| 221 | . write !
|
---|
| 222 | quit
|
---|
| 223 |
|
---|
| 224 | CKREC
|
---|
| 225 | ;"^TMG("TMGSIPH","PT XLAT",FILENUM,RemoteIEN)=LocalIEN
|
---|
| 226 | NEW DIC,X,Y
|
---|
| 227 | SET DIC(0)="MAEQ"
|
---|
| 228 | SET DIC=1
|
---|
| 229 | DO ^DIC WRITE !
|
---|
| 230 | IF +Y'>0 QUIT
|
---|
| 231 | NEW ARRAY
|
---|
| 232 | NEW OVERLAP
|
---|
| 233 | SET OVERLAP=$$CKREC1F(+Y,.ARRAY)
|
---|
| 234 | IF OVERLAP DO
|
---|
| 235 | . WRITE "FILE #",+Y," has ",OVERLAP," overlapping records.",!
|
---|
| 236 | QUIT
|
---|
| 237 |
|
---|
| 238 |
|
---|
| 239 | CKALLREC
|
---|
| 240 | NEW FILENUM SET FILENUM=0
|
---|
| 241 | NEW ARRAY
|
---|
| 242 | FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM)) QUIT:(+FILENUM'>0) DO
|
---|
| 243 | . NEW OVERLAP
|
---|
| 244 | . write "Checking file #",FILENUM,"..."
|
---|
| 245 | . SET OVERLAP=$$CKREC1F(FILENUM,.ARRAY)
|
---|
| 246 | . WRITE "FILE #",FILENUM," has ",OVERLAP," overlapping records.",!
|
---|
| 247 | MERGE ^TMG("TMGSIPH","OVERLAP")=ARRAY
|
---|
| 248 | QUIT
|
---|
| 249 |
|
---|
| 250 |
|
---|
| 251 | CKREC1F(FILENUM,ARRAY)
|
---|
| 252 | NEW CT SET CT=0
|
---|
| 253 | NEW RPTR,LPTR
|
---|
| 254 | SET RPTR=0
|
---|
| 255 | FOR SET RPTR=$ORDER(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)) QUIT:(+RPTR'>0) DO
|
---|
| 256 | . SET LPTR=$GET(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)) QUIT:LPTR=""
|
---|
| 257 | . SET ARRAY(FILENUM,LPTR,RPTR)=""
|
---|
| 258 | . SET CT=CT+1
|
---|
| 259 | . IF CT#100=0 WRITE "." SET CT=0
|
---|
| 260 | ;"Now delete all entries that are not doubled up.
|
---|
| 261 | SET LPTR=0
|
---|
| 262 | FOR SET LPTR=$ORDER(ARRAY(FILENUM,LPTR)) QUIT:(LPTR="") DO
|
---|
| 263 | . NEW REF SET REF=$NAME(ARRAY(FILENUM,LPTR))
|
---|
| 264 | . SET CT=$$ListCt^TMGMISC(REF)
|
---|
| 265 | . IF CT=1 KILL @REF
|
---|
| 266 | write !
|
---|
| 267 | QUIT $$ListCt^TMGMISC($NAME(ARRAY(FILENUM)))
|
---|
| 268 |
|
---|
| 269 |
|
---|
| 270 | SUMM
|
---|
| 271 | NEW FILENUM SET FILENUM=0
|
---|
| 272 | FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","OVERLAP",FILENUM)) QUIT:FILENUM="" DO
|
---|
| 273 | . NEW FNAME SET FNAME=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
|
---|
| 274 | . NEW REF SET REF=$NAME(^TMG("TMGSIPH","OVERLAP",FILENUM))
|
---|
| 275 | . WRITE "FILE [",FNAME,"] has ",$$ListCt^TMGMISC(REF)," overlapping records",!
|
---|
| 276 | quit
|
---|
| 277 |
|
---|
| 278 |
|
---|
| 279 | COMPRPC
|
---|
| 280 | NEW DIC,X,Y
|
---|
| 281 | NEW OPTION1,OPTION2
|
---|
| 282 | SET DIC=19,DIC(0)="MAEQ"
|
---|
| 283 | WRITE "First pick the OLDER entry to compaire",!
|
---|
| 284 | DO ^DIC WRITE !
|
---|
| 285 | IF Y=-1 GOTO CPRDN
|
---|
| 286 | SET OPTION1=+Y
|
---|
| 287 | WRITE !,"Now, pick the NEWER entry to compare",!
|
---|
| 288 | DO ^DIC WRITE !
|
---|
| 289 | IF Y=-1 GOTO CPRDN
|
---|
| 290 | SET OPTION2=+Y
|
---|
| 291 | NEW ARRAY1,ARRAY2
|
---|
| 292 | NEW IEN
|
---|
| 293 | SET IEN=0
|
---|
| 294 | FOR SET IEN=$ORDER(^DIC(19,OPTION1,"RPC",IEN)) QUIT:(+IEN'>0) DO
|
---|
| 295 | . NEW PRPC
|
---|
| 296 | . SET PRPC=+$GET(^DIC(19,OPTION1,"RPC",IEN,0))
|
---|
| 297 | . NEW NAME SET NAME=$PIECE($GET(^XWB(8994,PRPC,0)),"^",1)
|
---|
| 298 | . IF NAME="" WRITE IEN," --> ??",!
|
---|
| 299 | . ELSE SET ARRAY1(NAME,IEN)=""
|
---|
| 300 |
|
---|
| 301 | SET IEN=0
|
---|
| 302 | FOR SET IEN=$ORDER(^DIC(19,OPTION2,"RPC",IEN)) QUIT:(+IEN'>0) DO
|
---|
| 303 | . NEW PRPC
|
---|
| 304 | . SET PRPC=+$GET(^DIC(19,OPTION2,"RPC",IEN,0))
|
---|
| 305 | . NEW NAME SET NAME=$PIECE($GET(^XWB(8994,PRPC,0)),"^",1)
|
---|
| 306 | . IF NAME="" WRITE IEN," --> ??",!
|
---|
| 307 | . ELSE SET ARRAY2(NAME,IEN)=""
|
---|
| 308 |
|
---|
| 309 | NEW NAME SET NAME=""
|
---|
| 310 | FOR SET NAME=$ORDER(ARRAY1(NAME)) QUIT:(NAME="") DO
|
---|
| 311 | . IF $DATA(ARRAY2(NAME)) DO
|
---|
| 312 | . . WRITE "Both have: ",NAME,!
|
---|
| 313 | . . KILL ARRAY1(NAME),ARRAY2(NAME)
|
---|
| 314 |
|
---|
| 315 | NEW TEMP
|
---|
| 316 | WRITE "OK. Here are the entries in the OLDER option, not present in the new one.",!
|
---|
| 317 | IF $DATA(ARRAY1) ZWR ARRAY1
|
---|
| 318 | else write "(none)",!
|
---|
| 319 |
|
---|
| 320 | DO PRESSTOCONT^TMGUSRIF
|
---|
| 321 |
|
---|
| 322 | WRITE "OK. Here are the entries in the NEWER option, not present in the old one.",!
|
---|
| 323 | IF $DATA(ARRAY2) ZWR ARRAY2
|
---|
| 324 | else write "(none)",!
|
---|
| 325 |
|
---|
| 326 | DO PRESSTOCONT^TMGUSRIF
|
---|
| 327 |
|
---|
| 328 | CPRDN WRITE "GOODBYE",!
|
---|
| 329 | QUIT
|
---|
| 330 |
|
---|
| 331 | IHS
|
---|
| 332 | new IEN set IEN=0
|
---|
| 333 | for set IEN=$order(^DPT(IEN)) quit:(+IEN'>0) do
|
---|
| 334 | . if $data(^AUPNPAT(IEN))'=0 write "." quit
|
---|
| 335 | . write "Missing data for IEN=",IEN,!
|
---|
| 336 | . set ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",9000001,IEN)=""
|
---|
| 337 | . kill ^TMG("TMGSIPH","PT XLAT",9000001,IEN)
|
---|
| 338 | quit
|
---|
| 339 |
|
---|
| 340 | IHS2
|
---|
| 341 | new IEN set IEN=0
|
---|
| 342 | new Ct set Ct=0
|
---|
| 343 | new DIK set DIK="^AUPNPAT("
|
---|
| 344 | new DA
|
---|
| 345 | new matched set matched=0
|
---|
| 346 | new ABORT set ABORT=0
|
---|
| 347 | for set IEN=$order(^AUPNPAT(IEN)) quit:(+IEN'>0)!ABORT do
|
---|
| 348 | . set ABORT=$$UserAborted^TMGUSRIF
|
---|
| 349 | . new P2 set P2=$P($G(^AUPNPAT(IEN,0)),"^",1)
|
---|
| 350 | . if $data(^DPT(IEN))=0 do quit
|
---|
| 351 | . . write "!"
|
---|
| 352 | . . set Ct=Ct+1
|
---|
| 353 | . . set DA=IEN
|
---|
| 354 | . . do ^DIK
|
---|
| 355 | . if IEN=P2 write "." set matched=matched+1 quit
|
---|
| 356 | . write !,IEN," ",P2,!
|
---|
| 357 | write !,Ct," extra records",!
|
---|
| 358 | write matched," matched records",!
|
---|
| 359 | quit
|
---|
| 360 |
|
---|
| 361 | IHS3
|
---|
| 362 | new IEN set IEN=0
|
---|
| 363 | for set IEN=$order(^TMG("TMGSIPH","PT XLAT",9000001,IEN)) QUIT:(IEN'>0) DO
|
---|
| 364 | . NEW PT SET PT=$GET(^TMG("TMGSIPH","PT XLAT",9000001,IEN))
|
---|
| 365 | . if PT=0 kill ^TMG("TMGSIPH","PT XLAT",9000001,IEN) quit
|
---|
| 366 | . if PT'=IEN write "MISMATCH IEN ",IEN,"=",PT,!
|
---|
| 367 | write "goodbye",!
|
---|
| 368 | quit
|
---|