| [896] | 1 | TMGSIPH5 ;TMG/kst/SIPHON PROGRAM, FOR TRANSFERRING VISTA INSTANCES ;11/27/09
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;11/27/09
|
|---|
| 3 | ;
|
|---|
| 4 | ;"TMG SIPHON PROGRAM, FOR TRANSFERRING VISTA INSTANCE
|
|---|
| 5 | ;"Utility functions for working with transfers on client
|
|---|
| 6 | ;"Kevin Toppenberg MD
|
|---|
| 7 | ;"GNU General Public License (GPL) applies
|
|---|
| 8 | ;"11/27/09
|
|---|
| 9 | ;
|
|---|
| 10 | ;"=======================================================================
|
|---|
| 11 | ;" API -- Public Functions.
|
|---|
| 12 | ;"=======================================================================
|
|---|
| 13 | ;"EXAMNEED(JNUM,INOUT) -- User selects records, and then this displays who needs records.
|
|---|
| 14 | ;"SHOWNEED(JNUM,GETARRAY) -- show selected records
|
|---|
| 15 | ;"CHCK1NEED(FILENUM,RPTR,INOUT) --show who is needing one requested record
|
|---|
| 16 | ;"GL2FILE(CREF,FNAME) -- Return filenumber based on global reference.
|
|---|
| 17 | ;"KILLNEED(JNUM,INOUT) --allow user to kill needed needed pointers.
|
|---|
| 18 | ;"PREVIEW(JNUM,INOUT) --allow user view server record before downloading and installing
|
|---|
| 19 | ;"DELREC -- Allow user to del record and remove record that it has been previously downloaded.
|
|---|
| 20 | ;"DEL1REC(FILENUM,LPTR) -- allow deletion of given record and that it has been downloaded.
|
|---|
| 21 | ;"
|
|---|
| 22 | ;"=======================================================================
|
|---|
| 23 | ;"Dependancies
|
|---|
| 24 | ;"=======================================================================
|
|---|
| 25 | ;
|
|---|
| 26 | ;"=======================================================================
|
|---|
| 27 | ;
|
|---|
| 28 | EXAMNEED(JNUM,INOUT) ;
|
|---|
| 29 | ;"Purpose:User selects records, and then this displays who needs records.
|
|---|
| 30 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 31 | ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
|
|---|
| 32 | ;"Results: None
|
|---|
| 33 | ;
|
|---|
| 34 | NEW GETARRAY
|
|---|
| 35 | SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
|
|---|
| 36 | NEW OPTIONS
|
|---|
| 37 | SET OPTIONS("HEADER")="Select File(s) to EXAMINE. Press <ESC><ESC> when Done."
|
|---|
| 38 | DO ASKNEEDED^TMGSIPH3(JNUM,.GETARRAY,INOUT,.OPTIONS)
|
|---|
| 39 | IF $DATA(GETARRAY)=0 GOTO WNDN
|
|---|
| 40 | IF $$SHOWNEED(JNUM,.GETARRAY) ;"Ignore aborts
|
|---|
| 41 | WNDN QUIT
|
|---|
| 42 | ;
|
|---|
| 43 | ;
|
|---|
| 44 | SHOWNEED(JNUM,GETARRAY)
|
|---|
| 45 | ;"Purpose: To show selected records
|
|---|
| 46 | ;"Input: JNUM
|
|---|
| 47 | ;" GETARRAY -- PASS BY REFERENCE. Array as created by ASKNEEDED^TMGSIPH4
|
|---|
| 48 | ;" GETARRAY(FileNum,RecordNum)=""
|
|---|
| 49 | ;"Results: 1 if OK, -1 if abort
|
|---|
| 50 | NEW RESULT SET RESULT=1
|
|---|
| 51 | NEW TMGABORT SET TMGABORT=0
|
|---|
| 52 | NEW FILENUM SET FILENUM=0
|
|---|
| 53 | NEW STIME SET STIME=$H
|
|---|
| 54 | NEW TALLY
|
|---|
| 55 | NEW TMGCT SET TMGCT=1
|
|---|
| 56 | NEW SHOWPROG SET SHOWPROG=0
|
|---|
| 57 | FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="")!(TMGABORT=1) DO
|
|---|
| 58 | . QUIT:($$DDOK^TMGSIPH1(JNUM,FILENUM)'=1)
|
|---|
| 59 | . QUIT:($$PREPXREF^TMGSIPH1(JNUM,FILENUM)'=1)
|
|---|
| 60 | . NEW TMGMAX SET TMGMAX=-1
|
|---|
| 61 | . NEW IEN SET IEN=""
|
|---|
| 62 | . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="")!(TMGABORT=1) DO
|
|---|
| 63 | . . IF TMGMAX=-1 SET TMGMAX=IEN
|
|---|
| 64 | . . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
|
|---|
| 65 | . . SET TMGCT=TMGCT+1
|
|---|
| 66 | . . IF $$CHCK1NEED(FILENUM,IEN,INOUT)=-1 DO QUIT
|
|---|
| 67 | . . . NEW % SET %=1
|
|---|
| 68 | . . . WRITE "ABORT" DO YN^DICN WRITE !
|
|---|
| 69 | . . . IF %'=2 SET TMGABORT=1
|
|---|
| 70 | . . IF (SHOWPROG=0),(($PIECE($H,",",2)-$PIECE(STIME,",",2))>15) SET SHOWPROG=1
|
|---|
| 71 | . . IF SHOWPROG,(TMGCT#10=0) DO
|
|---|
| 72 | . . . WRITE #
|
|---|
| 73 | . . . DO ProgressBar^TMGUSRIF(TMGCT,"Progress: "_TMGCT,0,TMGMAX,70,STIME)
|
|---|
| 74 | . . . IF $DATA(TALLY) WRITE ! ZWR TALLY
|
|---|
| 75 | DO PRESSTOCONT^TMGUSRIF
|
|---|
| 76 | IF ($GET(TMGPTCABORT)=1)!(TMGABORT) SET RESULT=-1
|
|---|
| 77 | QUIT RESULT
|
|---|
| 78 | ;
|
|---|
| 79 | ;
|
|---|
| 80 | CHCK1NEED(FILENUM,RPTR,INOUT) ;
|
|---|
| 81 | ;"Purpose: To show who is needing one requested record
|
|---|
| 82 | ;"Input: FILENUM -- The file number to compare.
|
|---|
| 83 | ;" RPTR -- The IEN of the record that was wanted from the server.
|
|---|
| 84 | ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
|
|---|
| 85 | ;"NOTE: Gobal ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT") used, with format as below:
|
|---|
| 86 | ;" ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RemotePointer,RefToNodeToBeCorrected,INFO)=""
|
|---|
| 87 | ;" INFO=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
|
|---|
| 88 | ;" As pointers are resolved, the entries will be KILLED from the above global
|
|---|
| 89 | ;"
|
|---|
| 90 | ;"Results: 1 for OK, -1 for abort
|
|---|
| 91 | ;"
|
|---|
| 92 | NEW RESULT SET RESULT=1
|
|---|
| 93 | SET FILENUM=+$GET(FILENUM) QUIT:(FILENUM'>0)
|
|---|
| 94 | NEW FNAME SET FNAME=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
|
|---|
| 95 | SET RPTR=+$GET(RPTR)
|
|---|
| 96 | SET LPTR=+$GET(LPTR)
|
|---|
| 97 | NEW REF SET REF=""
|
|---|
| 98 | FOR SET REF=$ORDER(^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RPTR,REF)) QUIT:(REF="")!(RESULT=-1) DO
|
|---|
| 99 | . NEW INFO SET INFO=""
|
|---|
| 100 | . FOR SET INFO=$ORDER(^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RPTR,REF,INFO)) QUIT:(INFO="")!(RESULT=-1) DO
|
|---|
| 101 | . . NEW PCE SET PCE=+INFO
|
|---|
| 102 | . . NEW IENDEPTH SET IENDEPTH=$PIECE(INFO,"^",4)
|
|---|
| 103 | . . NEW QNUM SET QNUM=$QLENGTH(REF)-(IENDEPTH*2) ;"e.g. ^TIU(8925,IEN,0), or e.g. ^PS(52.11,IEN,2,IEN2,0), ^PS(52.11,IEN,2,IEN2,0,IEN3,3)
|
|---|
| 104 | . . NEW GL SET GL=$$QSUBS^TMGSIPHU(REF,QNUM)
|
|---|
| 105 | . . NEW FRFNAME SET FRFNAME="??"
|
|---|
| 106 | . . NEW PFROMFIL SET PFROMFIL=$$GL2FILE(GL,.FRFNAME)
|
|---|
| 107 | . . NEW PFROMREC SET PFROMREC=$QSUBSCRIPT(REF,QNUM+1)
|
|---|
| 108 | . . NEW LOC SET LOC=$QSUBSCRIPT(REF,$QLENGTH(REF))
|
|---|
| 109 | . . NEW FLD SET FLD=$$GETFLD^TMGSIPHU(PFROMFIL,LOC,PCE)
|
|---|
| 110 | . . WRITE !,"Needed Record: FILE ",FILENUM," [",FNAME,"]; #",RPTR," [",$$GET01FLD^TMGSIPH3(JNUM,FILENUM,RPTR),"] ",!
|
|---|
| 111 | . . WRITE "Needed by: FILE: ",PFROMFIL," [",FRFNAME,"]; #",PFROMREC,"; FLD: ",+FLD," [",$PIECE(FLD,"^",2),"]",!
|
|---|
| 112 | . . NEW TOSHOW,FLD SET FLD=0
|
|---|
| 113 | . . FOR SET FLD=$ORDER(^DD(PFROMFIL,FLD)) QUIT:(+FLD'>0) DO
|
|---|
| 114 | . . . NEW INFO SET INFO=$PIECE($GET(^DD(PFROMFIL,FLD,0)),"^",2)
|
|---|
| 115 | . . . QUIT:(INFO'["P")
|
|---|
| 116 | . . . NEW AFILE SET AFILE=+$PIECE(INFO,"P",2) QUIT:(AFILE'=2) ;"2 = PATIENT file
|
|---|
| 117 | . . . SET TOSHOW(FLD)=""
|
|---|
| 118 | . . IF $DATA(TOSHOW) DO
|
|---|
| 119 | . . . WRITE "Name of patient in this record as follows:",!
|
|---|
| 120 | . . . DO DumpRec2^TMGDEBUG(PFROMFIL,PFROMREC,0,.TOSHOW)
|
|---|
| 121 | . . NEW % SET %=2
|
|---|
| 122 | . . WRITE "View current local record needing record" DO YN^DICN WRITE !
|
|---|
| 123 | . . IF %=-1 SET RESULT=-1 QUIT
|
|---|
| 124 | . . IF %=1 DO
|
|---|
| 125 | . . . DO DumpRec2^TMGDEBUG(PFROMFIL,PFROMREC)
|
|---|
| 126 | . . . WRITE !
|
|---|
| 127 | . . . DO PRESSTOCONT^TMGUSRIF
|
|---|
| 128 | . . . IF $GET(TMGPTCABORT)=1 SET RESULT=-1
|
|---|
| 129 | ;
|
|---|
| 130 | QUIT RESULT
|
|---|
| 131 | ;
|
|---|
| 132 | ;
|
|---|
| 133 | GL2FILE(CREF,FNAME) ;
|
|---|
| 134 | ;"Purpose: Return filenumber based on global reference.
|
|---|
| 135 | ;"Input: CREF -- closed reference of root of file.
|
|---|
| 136 | ;" FNAME -- OPTIONAL. PASS BY REFERENCE. Filled with filename, if found.
|
|---|
| 137 | ;"Results: Filenumber, or 0 if problem
|
|---|
| 138 | NEW RESULT SET RESULT=0
|
|---|
| 139 | NEW NODE0 SET NODE0=$GET(@CREF@(0)) GOTO:(NODE0="") G2FDN
|
|---|
| 140 | SET FNAME=$PIECE(NODE0,"^",1)
|
|---|
| 141 | SET RESULT=+$PIECE(NODE0,"^",2)
|
|---|
| 142 | G2FDN QUIT RESULT
|
|---|
| 143 | ;
|
|---|
| 144 | ;
|
|---|
| 145 | KILLNEED(JNUM,INOUT) ;
|
|---|
| 146 | ;"Purpose: To allow user to kill needed needed pointers.
|
|---|
| 147 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 148 | ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
|
|---|
| 149 | ;"Results: None
|
|---|
| 150 | ;
|
|---|
| 151 | NEW GETARRAY,FILENUM,IEN,STIME,TMGCT,SHOWPROG,TALLY,QUERY,ERROR
|
|---|
| 152 | SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
|
|---|
| 153 | NEW TMGABORT SET TMGABORT=0
|
|---|
| 154 | NEW OPTIONS
|
|---|
| 155 | SET OPTIONS("HEADER")="Select File(s) to REMOVE NEEDED FROM. Press <ESC><ESC> when Done."
|
|---|
| 156 | DO ASKNEEDED^TMGSIPH3(JNUM,.GETARRAY,INOUT,.OPTIONS)
|
|---|
| 157 | IF $DATA(GETARRAY)=0 GOTO WNDN
|
|---|
| 158 | WRITE !,"NOTE: If the selected records are removed from the needed list,",!
|
|---|
| 159 | WRITE "then all the records pointing to this needed record will be left",!
|
|---|
| 160 | WRITE "with NULL pointers. THIS CAN NOT BE UNDONE.",!
|
|---|
| 161 | WRITE "It is recommended that the individual records be EXAMINED",!
|
|---|
| 162 | WRITE "to better understand the linkages before deletion.",!
|
|---|
| 163 | WRITE "If you don't know what you are doing,then don't proceed.",!,!
|
|---|
| 164 | NEW % SET %=1
|
|---|
| 165 | WRITE "EXAMINE records first" DO YN^DICN WRITE !
|
|---|
| 166 | IF %=-1 GOTO KNDN
|
|---|
| 167 | IF %=1 IF $$SHOWNEED(JNUM,.GETARRAY)=-1 GOTO KNDN
|
|---|
| 168 | SET %=2
|
|---|
| 169 | WRITE "PROCEED WITH DELETION FROM NEEDED LIST" DO YN^DICN WRITE !
|
|---|
| 170 | IF %'=1 GOTO KNDN
|
|---|
| 171 | SET FILENUM=0
|
|---|
| 172 | SET STIME=$H
|
|---|
| 173 | SET TMGCT=1,SHOWPROG=0
|
|---|
| 174 | FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="")!(TMGABORT=1) DO
|
|---|
| 175 | . NEW TMGMAX SET TMGMAX=-1
|
|---|
| 176 | . NEW IEN SET IEN=""
|
|---|
| 177 | . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="")!(TMGABORT=1) DO
|
|---|
| 178 | . . IF TMGMAX=-1 SET TMGMAX=IEN
|
|---|
| 179 | . . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
|
|---|
| 180 | . . SET TMGCT=TMGCT+1
|
|---|
| 181 | . . DO UNNEEDPTR^TMGSIPHU(FILENUM,IEN,0,.TALLY)
|
|---|
| 182 | . . IF (SHOWPROG=0),(($PIECE($H,",",2)-$PIECE(STIME,",",2))>15) SET SHOWPROG=1
|
|---|
| 183 | . . IF SHOWPROG,(TMGCT#10=0) DO
|
|---|
| 184 | . . . WRITE #
|
|---|
| 185 | . . . DO ProgressBar^TMGUSRIF(TMGCT,"Progress: "_TMGCT,0,TMGMAX,70,STIME)
|
|---|
| 186 | . . . IF $DATA(TALLY) WRITE ! ZWR TALLY
|
|---|
| 187 | DO PRESSTOCONT^TMGUSRIF
|
|---|
| 188 | KNDN QUIT
|
|---|
| 189 | ;
|
|---|
| 190 | ;
|
|---|
| 191 | PREVIEW(JNUM,INOUT) ;
|
|---|
| 192 | ;"Purpose: To allow user view server record before downloading and installing
|
|---|
| 193 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 194 | ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
|
|---|
| 195 | ;"Results: None
|
|---|
| 196 | ;
|
|---|
| 197 | NEW GETARRAY,FILENUM,IEN,STIME,TMGCT,SHOWPROG,TALLY,QUERY,ERROR
|
|---|
| 198 | SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
|
|---|
| 199 | NEW TMGABORT SET TMGABORT=0
|
|---|
| 200 | NEW OPTIONS
|
|---|
| 201 | SET OPTIONS("HEADER")="Select File(s) to PREVIEW. Press <ESC><ESC> when Done."
|
|---|
| 202 | DO ASKNEEDED^TMGSIPH3(JNUM,.GETARRAY,INOUT,.OPTIONS)
|
|---|
| 203 | IF $DATA(GETARRAY)=0 GOTO PVDN
|
|---|
| 204 | NEW SHOWEMPTY
|
|---|
| 205 | NEW % SET %=2
|
|---|
| 206 | WRITE "Display Empty Fields" DO YN^DICN WRITE !
|
|---|
| 207 | IF %=-1 GOTO PVDN
|
|---|
| 208 | SET SHOWEMPTY=(%=1)
|
|---|
| 209 | SET FILENUM=0
|
|---|
| 210 | SET STIME=$H
|
|---|
| 211 | SET TMGCT=1,SHOWPROG=0
|
|---|
| 212 | FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="")!(TMGABORT=1) DO
|
|---|
| 213 | . NEW TMGMAX SET TMGMAX=-1
|
|---|
| 214 | . NEW IEN SET IEN=""
|
|---|
| 215 | . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="")!(TMGABORT=1) DO
|
|---|
| 216 | . . IF TMGMAX=-1 SET TMGMAX=IEN
|
|---|
| 217 | . . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
|
|---|
| 218 | . . SET TMGCT=TMGCT+1
|
|---|
| 219 | . . SET QUERY="DUMP REC|"_FILENUM_"^"_IEN_"^"_SHOWEMPTY
|
|---|
| 220 | . . DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
|
|---|
| 221 | . . IF $DATA(ERROR) DO QUIT
|
|---|
| 222 | . . . WRITE ERROR,!
|
|---|
| 223 | . . . SET TMGABORT=1
|
|---|
| 224 | . . NEW TMGI SET TMGI=""
|
|---|
| 225 | . . FOR SET TMGI=$ORDER(REPLY(TMGI)) QUIT:(TMGI="") DO
|
|---|
| 226 | . . . WRITE REPLY(TMGI),!
|
|---|
| 227 | . . IF (SHOWPROG=0),(($PIECE($H,",",2)-$PIECE(STIME,",",2))>15) SET SHOWPROG=1
|
|---|
| 228 | . . IF SHOWPROG,(TMGCT#10=0) DO
|
|---|
| 229 | . . . WRITE #
|
|---|
| 230 | . . . DO ProgressBar^TMGUSRIF(TMGCT,"Progress: "_TMGCT,0,TMGMAX,70,STIME)
|
|---|
| 231 | . . . IF $DATA(TALLY) WRITE ! ZWR TALLY
|
|---|
| 232 | DO PRESSTOCONT^TMGUSRIF
|
|---|
| 233 | PVDN QUIT
|
|---|
| 234 | ;
|
|---|
| 235 | ;
|
|---|
| 236 | CHKPTIN(JNUM) ;
|
|---|
| 237 | ;"Purpose: to check for pointers in to files/records already downloaded.
|
|---|
| 238 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 239 | ;"Results: None
|
|---|
| 240 | NEW TMGARRAY,TMGSEL
|
|---|
| 241 | NEW FILENUM SET FILENUM=0
|
|---|
| 242 | FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM)) QUIT:(FILENUM'>0) DO
|
|---|
| 243 | . NEW DISPSTR SET DISPSTR="Check for pointers IN to file #"_FILENUM_" ("
|
|---|
| 244 | . SET DISPSTR=DISPSTR_$PIECE($GET(^DIC(FILENUM,0)),"^",1)_")"
|
|---|
| 245 | . SET TMGARRAY(DISPSTR)=FILENUM
|
|---|
| 246 | NEW HEADER SET HEADER="Select File(s) to Check for POINTERS IN. Press <ESC><ESC> when Done."
|
|---|
| 247 | DO Selector^TMGUSRIF("TMGARRAY","TMGSEL",HEADER)
|
|---|
| 248 | ;
|
|---|
| 249 | NEW TMGABORT SET TMGABORT=0
|
|---|
| 250 | NEW IDX SET IDX=""
|
|---|
| 251 | FOR SET IDX=$ORDER(TMGSEL(IDX)) QUIT:(IDX="")!TMGABORT DO
|
|---|
| 252 | . SET FILENUM=$GET(TMGSEL(IDX)) QUIT:FILENUM=""
|
|---|
| 253 | . SET TMGABORT=($$CHK1PTIN(JNUM,FILENUM)'=1)
|
|---|
| 254 | ;
|
|---|
| 255 | WRITE !
|
|---|
| 256 | DO PRESSTOCONT^TMGUSRIF;
|
|---|
| 257 | QUIT
|
|---|
| 258 | ;
|
|---|
| 259 | ;
|
|---|
| 260 | CHK1PTIN(JNUM,FILENUM) ;
|
|---|
| 261 | ;"Purpose: To cycle through all local records that have been downloaded and manuall
|
|---|
| 262 | ;" check on server for pointers in, and que checks if needed.
|
|---|
| 263 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 264 | ;" FILENUM -- The file to process.
|
|---|
| 265 | ;"Results: 1 if OK -1 if error/abort
|
|---|
| 266 | NEW RESULT SET RESULT=1
|
|---|
| 267 | NEW TMGABORT SET TMGABORT=0
|
|---|
| 268 | NEW TMGCT SET TMGCT=999
|
|---|
| 269 | NEW STIME SET STIME=$H
|
|---|
| 270 | NEW TMGMIN SET TMGMIN=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM,0))
|
|---|
| 271 | NEW TMGMAX SET TMGMAX=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM,""),-1)
|
|---|
| 272 | NEW LPTR SET LPTR=0
|
|---|
| 273 | FOR SET LPTR=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR)) QUIT:(+LPTR'>0)!TMGABORT DO
|
|---|
| 274 | . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
|
|---|
| 275 | . NEW RPTR SET RPTR=+$GET(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR))
|
|---|
| 276 | . QUIT:(RPTR'>0)
|
|---|
| 277 | . DO GETPTIN^TMGSIPH4(JNUM,FILENUM,RPTR)
|
|---|
| 278 | . SET TMGCT=TMGCT+1
|
|---|
| 279 | . IF TMGCT>25 DO
|
|---|
| 280 | . . DO ProgressBar^TMGUSRIF(LPTR,"Checking pointers IN to file #"_FILENUM,TMGMIN,TMGMAX,70,STIME)
|
|---|
| 281 | . . SET TMGCT=0
|
|---|
| 282 | IF TMGABORT SET RESULT=-1
|
|---|
| 283 | QUIT RESULT
|
|---|
| 284 | ;
|
|---|
| 285 | ;
|
|---|
| 286 | DELREC;
|
|---|
| 287 | ;"Purpose: To allow a user to delete a record on the client, and remove record that it has
|
|---|
| 288 | ;" been previously downloaded. This will allow it to be downloaded again.
|
|---|
| 289 | WRITE !,"Select a downloaded record to delete from this client.",!
|
|---|
| 290 | WRITE "NOTE: All pointer to this record will be deleted.",!
|
|---|
| 291 | NEW X,Y,DIC,FILENUM,RESULT
|
|---|
| 292 | SET DIC=1,DIC(0)="MAEQ"
|
|---|
| 293 | DO ^DIC WRITE !
|
|---|
| 294 | IF +Y>0 DO
|
|---|
| 295 | . SET FILENUM=+Y
|
|---|
| 296 | . NEW % SET %=2
|
|---|
| 297 | . WRITE "DELETE *ALL* RECORDS IN FILE"
|
|---|
| 298 | . DO YN^DICN WRITE !
|
|---|
| 299 | . IF %=1 IF $$DELALL(FILENUM) QUIT
|
|---|
| 300 | . IF %=-1 QUIT
|
|---|
| 301 | . SET DIC=FILENUM
|
|---|
| 302 | . DO ^DIC WRITE !
|
|---|
| 303 | . IF +Y'>0 QUIT
|
|---|
| 304 | . SET RESULT=$$DEL1REC(FILENUM,+Y)
|
|---|
| 305 | . IF +RESULT=-1 DO
|
|---|
| 306 | . . WRITE $PIECE(RESULT,"^",2),!
|
|---|
| 307 | . ELSE DO
|
|---|
| 308 | . . WRITE "Record deleted, and all pointers to record have been removed.",!
|
|---|
| 309 | . DO PRESSTOCONT^TMGUSRIF
|
|---|
| 310 | QUIT
|
|---|
| 311 | ;
|
|---|
| 312 | ;
|
|---|
| 313 | DELALL(FILENUM)
|
|---|
| 314 | ;"Purpose: To allow deletion of all records in file on the client, and remove the
|
|---|
| 315 | ;" notation that it has been downloaded.
|
|---|
| 316 | ;"Input: FILENUM -- Filenumber to delete
|
|---|
| 317 | ;"Result: 1 = OK, -1^Message if error
|
|---|
| 318 | SET FILENUM=$GET(FILENUM)
|
|---|
| 319 | NEW RESULT SET RESULT=1
|
|---|
| 320 | NEW % SET %=2
|
|---|
| 321 | WRITE "Are you CERTAIN you want to delete ALL records in file ",FILENUM
|
|---|
| 322 | DO YN^DICN WRITE !
|
|---|
| 323 | IF %'=1 SET RESULT="-1^USER ABORTED" GOTO DADN
|
|---|
| 324 | NEW TMGCT SET TMGCT=0
|
|---|
| 325 | NEW TMGABORT SET TMGABORT=0
|
|---|
| 326 | NEW STIME SET STIME=$H
|
|---|
| 327 | NEW REF SET REF=$GET(^DIC(FILENUM,0,"GL"))
|
|---|
| 328 | IF REF="" DO GOTO DADN
|
|---|
| 329 | . SET RESULT="-1^INVALID FILENUM: "_FILENUM
|
|---|
| 330 | SET REF=$$CREF^DILF(REF)
|
|---|
| 331 | SET TMGMIN=$ORDER(@REF@(0))
|
|---|
| 332 | SET TMGMAX=$ORDER(@REF@("@"),-1)
|
|---|
| 333 | NEW TMGIEN SET TMGIEN=0
|
|---|
| 334 | FOR SET TMGIEN=$ORDER(@REF@(TMGIEN)) QUIT:(+TMGIEN'>0)!TMGABORT DO
|
|---|
| 335 | . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
|
|---|
| 336 | . IF TMGCT>100 DO
|
|---|
| 337 | . . DO ProgressBar^TMGUSRIF(TMGIEN,"Deleting local records in file "_FILENUM,TMGMIN,TMGMAX,70,STIME)
|
|---|
| 338 | . . SET TMGCT=0
|
|---|
| 339 | . SET TMGCT=TMGCT+1
|
|---|
| 340 | . SET RESULT=$$DEL1REC(FILENUM,TMGIEN,1)
|
|---|
| 341 | . IF +RESULT=-1 SET TMGABORT=1
|
|---|
| 342 | IF 'TMGABORT DO
|
|---|
| 343 | . KILL ^TMG("TMGSIPH","PT XLAT",FILENUM)
|
|---|
| 344 | . KILL ^TMG("TMGSIPH","RECORDS SYNC",FILENUM)
|
|---|
| 345 | DADN QUIT RESULT
|
|---|
| 346 | ;
|
|---|
| 347 | ;
|
|---|
| 348 | DEL1REC(FILENUM,LPTR,FORCE);
|
|---|
| 349 | ;"Purpose: To allow deletion of a record on the client, and record that it has been downloaded.
|
|---|
| 350 | ;"Input: FILENUM -- Filenumber to delete
|
|---|
| 351 | ;" LPTR -- Record number (IEN) on client to delete
|
|---|
| 352 | ;" FORCE -- OPTIONAL. If 1, then will delete even if not prev downloaded
|
|---|
| 353 | ;"Result: 1 = OK, -1^Message if error
|
|---|
| 354 | NEW RESULT SET RESULT=1
|
|---|
| 355 | IF $GET(FORCE)=1 GOTO D1L1
|
|---|
| 356 | NEW ISDNLOAD SET ISDNLOAD=($DATA(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR))'=0)
|
|---|
| 357 | IF 'ISDNLOAD DO GOTO D1RDONE
|
|---|
| 358 | . SET RESULT="-1^Record doesn't seem to have been downloaded. A local record was probably used instead."
|
|---|
| 359 | D1L1 NEW OPTION
|
|---|
| 360 | SET OPTION(FILENUM,LPTR)=0
|
|---|
| 361 | DO QTMVPTR^TMGFMUT(.OPTION)
|
|---|
| 362 | NEW DIE,DR,DA
|
|---|
| 363 | SET DIE=FILENUM
|
|---|
| 364 | SET DR=".01///@"
|
|---|
| 365 | SET DA=LPTR
|
|---|
| 366 | DO ^DIE
|
|---|
| 367 | NEW RPTR SET RPTR=+$GET(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR))
|
|---|
| 368 | KILL ^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR)
|
|---|
| 369 | KILL ^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)
|
|---|
| 370 | D1RDONE QUIT RESULT
|
|---|
| 371 | ;
|
|---|
| 372 | ; |
|---|
