[796] | 1 | TMGTRAN1 ;TMG/kst/TRANSCRIPTION REPORT FUNCTIONS -- UI ;03/25/06
|
---|
| 2 | ;;1.0;TMG-LIB;**1**;09/01/05
|
---|
| 3 |
|
---|
| 4 | ;" TRANSCRIPTION REPORT FUNCTIONS
|
---|
| 5 |
|
---|
| 6 | ;"=======================================================================
|
---|
| 7 | ;" API -- Public Functions.
|
---|
| 8 | ;"=======================================================================
|
---|
| 9 | ;"RPTCUR
|
---|
| 10 | ;"RPTASK
|
---|
| 11 | ;"RPTQUIET(OPTIONS)
|
---|
| 12 | ;"FREECUR
|
---|
| 13 | ;"FREEASK
|
---|
| 14 | ;"ScanSign(OPTIONS,SIGNED)
|
---|
| 15 | ;"PWDSNOOP(IEN)
|
---|
| 16 | ;"SHOWUNSIGNED
|
---|
| 17 | ;"SIGNDOC(DocIEN,OPTIONS)
|
---|
| 18 | ;"PRINT(DocArray) ; Prompt and print, or array
|
---|
| 19 |
|
---|
| 20 |
|
---|
| 21 |
|
---|
| 22 | ;"=======================================================================
|
---|
| 23 | ;" Private Functions.
|
---|
| 24 | ;"=======================================================================
|
---|
| 25 | ;"AskDatesRPT(Options)
|
---|
| 26 | ;"FreeDocs(AuthorIEN,ShowDetails)
|
---|
| 27 |
|
---|
| 28 | ;"=======================================================================
|
---|
| 29 | RPTCUR
|
---|
| 30 | ;"SCOPE: PUBLIC
|
---|
| 31 | ;"Purpose: To report transcription productivity for the current user (DUZ)
|
---|
| 32 | ;"Input: none. User will be asked for start and end dates
|
---|
| 33 | ;"Output: Produces a report to choses output channel.
|
---|
| 34 |
|
---|
| 35 | new Options
|
---|
| 36 |
|
---|
| 37 | write !,"-- TRANSCRIPTION PRODUCTIVITY CREDIT REPORT -- ",!!
|
---|
| 38 | write "Showing credit for: ",$piece($get(^VA(200,DUZ,0)),"^",1),!!
|
---|
| 39 |
|
---|
| 40 | set Options("TRANS")=DUZ
|
---|
| 41 | do AskDatesRPT(.Options)
|
---|
| 42 |
|
---|
| 43 | quit
|
---|
| 44 |
|
---|
| 45 | RPTASK
|
---|
| 46 | ;"SCOPE: PUBLIC
|
---|
| 47 | ;"Purpose: To report transcription productivity for a chosen user
|
---|
| 48 | ;"Input: none. User will be asked for the user to report on, and also
|
---|
| 49 | ;" start and end dates
|
---|
| 50 | ;"Output: Produces a report to choses output channel.
|
---|
| 51 |
|
---|
| 52 | new Options
|
---|
| 53 |
|
---|
| 54 | ;"set TMGDEBUG=1 ;"TEMP!!!
|
---|
| 55 |
|
---|
| 56 | write !,"-- TRANSCRIPTION PRODUCTIVITY CREDIT REPORT -- ",!!
|
---|
| 57 |
|
---|
| 58 | set DIC=200 ;"NEW PERSON file
|
---|
| 59 | set DIC(0)="MAQE"
|
---|
| 60 | set DIC("A")="Enter name of transcriptionist (^ to abort): "
|
---|
| 61 | do ^DIC
|
---|
| 62 | if +Y=-1 do goto RADone
|
---|
| 63 | . write !,"No transcriptionist selected. Aborting report.",!
|
---|
| 64 |
|
---|
| 65 | set Options("TRANS")=+Y
|
---|
| 66 |
|
---|
| 67 | do AskDatesRPT(.Options)
|
---|
| 68 | RADone
|
---|
| 69 | quit
|
---|
| 70 |
|
---|
| 71 | RPTCURA
|
---|
| 72 | ;"SCOPE: PUBLIC
|
---|
| 73 | ;"Purpose: To report current user's (DUZ) cost for all transcriptionists
|
---|
| 74 | ;"Input: none. User will be asked for start and end dates
|
---|
| 75 | ;"Output: Produces a report to choses output channel.
|
---|
| 76 |
|
---|
| 77 | new Options
|
---|
| 78 |
|
---|
| 79 | write !,"-- TRANSCRIPTION COST REPORT -- ",!!
|
---|
| 80 | write "Showing cost for: ",$piece($get(^VA(200,DUZ,0)),"^",1),!!
|
---|
| 81 |
|
---|
| 82 | set Options("AUTHOR")=DUZ
|
---|
| 83 | do AskDatesRPT(.Options)
|
---|
| 84 |
|
---|
| 85 | quit
|
---|
| 86 |
|
---|
| 87 | RPTASKA
|
---|
| 88 | ;"SCOPE: PUBLIC
|
---|
| 89 | ;"Purpose: To report transcription costs for a chosen user
|
---|
| 90 | ;"Input: none. User will be asked for the user to report on, and also
|
---|
| 91 | ;" start and end dates
|
---|
| 92 | ;"Output: Produces a report to choses output channel.
|
---|
| 93 |
|
---|
| 94 | new Options
|
---|
| 95 |
|
---|
| 96 | write !,"-- TRANSCRIPTION COST REPORT -- ",!!
|
---|
| 97 |
|
---|
| 98 | set DIC=200 ;"NEW PERSON file
|
---|
| 99 | set DIC(0)="MAQE"
|
---|
| 100 | set DIC("A")="Enter name of author (^ to abort): "
|
---|
| 101 | do ^DIC
|
---|
| 102 | if +Y=-1 do goto RAADone
|
---|
| 103 | . write !,"No author selected. Aborting report.",!
|
---|
| 104 |
|
---|
| 105 | set Options("AUTHOR")=+Y
|
---|
| 106 |
|
---|
| 107 | do AskDatesRPT(.Options)
|
---|
| 108 | RAADone
|
---|
| 109 | quit
|
---|
| 110 |
|
---|
| 111 |
|
---|
| 112 |
|
---|
| 113 | AskDatesRPT(Options)
|
---|
| 114 | ;"SCOPE: PUBLIC
|
---|
| 115 | ;"Purpose: to finish the interactive report process.
|
---|
| 116 | ;"Input: An array that should contain Options("TRANS")=IEN
|
---|
| 117 |
|
---|
| 118 | write !!!
|
---|
| 119 | write "NOTE: Enter date range for note ENTRY into system, not date of service.",!
|
---|
| 120 | new %DT
|
---|
| 121 | set %DT="AEP"
|
---|
| 122 | set %DT("A")="Enter starting date (^ to abort): "
|
---|
| 123 | do ^%DT
|
---|
| 124 | if Y=-1 do goto ADRDone
|
---|
| 125 | . write "Invalid date. Aborting report.",!
|
---|
| 126 | set Options("START")=Y
|
---|
| 127 |
|
---|
| 128 | set %DT("A")="Enter ending date (^ to abort): "
|
---|
| 129 | do ^%DT
|
---|
| 130 | if Y=-1 do goto ADRDone
|
---|
| 131 | . write "Invalid date. Aborting report.",!
|
---|
| 132 | set Options("END")=Y
|
---|
| 133 |
|
---|
| 134 | new YN
|
---|
| 135 | read !,"Show Details? YES// ",YN:$get(DTIME,3600)
|
---|
| 136 | if YN="" set YN="Y"
|
---|
| 137 | set Options("DETAILS")=($$UP^XLFSTR(YN)["Y")
|
---|
| 138 | if YN="^" write "Aborting.",! goto ADRDone
|
---|
| 139 |
|
---|
| 140 | set %ZIS("A")="Enter output printer or device (^ to abort): "
|
---|
| 141 | do ^%ZIS
|
---|
| 142 | if POP do goto ADRDone
|
---|
| 143 | . write !,"Error selecting output printer or device. Aborting report.",!
|
---|
| 144 |
|
---|
| 145 | use IO
|
---|
| 146 | do RPTQUIET(.Options)
|
---|
| 147 | use IO(0)
|
---|
| 148 |
|
---|
| 149 | do ^%ZISC
|
---|
| 150 |
|
---|
| 151 | ADRDone
|
---|
| 152 | quit
|
---|
| 153 |
|
---|
| 154 |
|
---|
| 155 | RPTQUIET(OPTIONS)
|
---|
| 156 | ;"SCOPE: PUBLIC
|
---|
| 157 | ;"Purpose: To create a report on transcription productivity based on
|
---|
| 158 | ;" options specified in OPTIONS.
|
---|
| 159 | ;"Input: The following elements in OPTIONS should be defined
|
---|
| 160 | ;" 0PTIONS("TRANS") ;"the IEN of the transcriptionst (IEN from file 200)
|
---|
| 161 | ;" This term is to limit the search. If all transcriptionsts are
|
---|
| 162 | ;" wanted, then don't define OPTIONS("TRANS")
|
---|
| 163 | ;" If multiple transcriptionists need to be specified, use this format:
|
---|
| 164 | ;" OPTIONS("TRANS")="*"
|
---|
| 165 | ;" OPTIONS("TRANS",1)=IEN#1
|
---|
| 166 | ;" OPTIONS("TRANS",2)=IEN#2
|
---|
| 167 | ;" OPTIONS("TRANS",3)=IEN#3
|
---|
| 168 | ;" 0PTIONS("AUTHOR") ;"the IEN of the author (IEN from file 200)
|
---|
| 169 | ;" This term is to limit the search. If all authors are
|
---|
| 170 | ;" wanted, then don't define OPTIONS("AUTHOR")
|
---|
| 171 | ;" If multiple authors need to be specified, use this format:
|
---|
| 172 | ;" OPTIONS("AUTHOR")="*"
|
---|
| 173 | ;" OPTIONS("AUTHOR",1)=IEN#1
|
---|
| 174 | ;" OPTIONS("AUTHOR",2)=IEN#2
|
---|
| 175 | ;" OPTIONS("AUTHOR",3)=IEN#3
|
---|
| 176 | ;" OPTIONS("START") ;"Earliest date of documents, in Fileman internal format
|
---|
| 177 | ;" OPTIONS("END") ;"Latest date of documents, in Fileman internal format
|
---|
| 178 | ;" OPTIONS("DETAILS") ;"if 1, then each document showed
|
---|
| 179 | ;"Note: This will create a report by writing to the current device
|
---|
| 180 | ;" If the user wants output to go to a DEVICE, then they should call
|
---|
| 181 | ;" ^%ZIS prior to calling this function, and call ^%ZISC aftewards to close
|
---|
| 182 |
|
---|
| 183 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"RPTQUIET^TMGTRANS1")
|
---|
| 184 |
|
---|
| 185 | new index
|
---|
| 186 | new TransIEN,AuthorIEN
|
---|
| 187 | new TransArrayP set TransArrayP="OPTIONS(""TRANS"")"
|
---|
| 188 | new AuthorArrayP set AuthorArrayP="OPTIONS(""AUTHOR"")"
|
---|
| 189 | new ChrCt set ChrCt=0
|
---|
| 190 | new LineCt set LineCt=0
|
---|
| 191 | new StartDT,EndDT
|
---|
| 192 | new CtAuthor ;"An array to subdivide lines to each doctor's account
|
---|
| 193 | new CtTrans ;"An array to track transcriptionists lines and income
|
---|
| 194 | new AuthorInitials,TransInitials
|
---|
| 195 | new ShowDetails set ShowDetails=+$get(OPTIONS("DETAILS"))
|
---|
| 196 |
|
---|
| 197 | set StartDT=+$get(OPTIONS("START"))
|
---|
| 198 | if (StartDT=0) do goto RQDone
|
---|
| 199 | . write "No start date specified. Aborting.",!
|
---|
| 200 | set EndDT=+$get(OPTIONS("END"))\1 ;" \1 removes time from date
|
---|
| 201 | if (EndDT=0) do goto RQDone
|
---|
| 202 | . write "No end date specified. Aborting.",!
|
---|
| 203 |
|
---|
| 204 | new CharsPerLine set CharsPerLine=+$piece($get(^TIU(8925.99,1,0)),"^",3)
|
---|
| 205 | if CharsPerLine=0 set CharsPerLine=65
|
---|
| 206 |
|
---|
| 207 | write !!," Visit;"
|
---|
| 208 | write $$RJ^XLFSTR("Entry Date;",15)
|
---|
| 209 | write $$RJ^XLFSTR("Lines@Rate=$Cost",23),"; "
|
---|
| 210 | write "Trn; Ath; Sgn; Patient",!
|
---|
| 211 | write "------------------------------------------------------------------------------",!
|
---|
| 212 | set index=$order(^TIU(8925,0))
|
---|
| 213 | for do quit:(index="")
|
---|
| 214 | . ;"write "."
|
---|
| 215 | . if index="" quit
|
---|
| 216 | . new k
|
---|
| 217 | . use IO(0) read *k:0 use IO
|
---|
| 218 | . if k=27 do quit
|
---|
| 219 | . . set index=""
|
---|
| 220 | . . write "Report aborted by ESC from user.",!
|
---|
| 221 | . new tDate set tDate=$piece($get(^TIU(8925,index,12)),"^",1)
|
---|
| 222 | . set tDate=tDate\1 ;"remove time from date
|
---|
| 223 | . ;"set mC=mC+1 set tC=tC+1 if tC>100 write mC," " set tC=0
|
---|
| 224 | . if (tDate'<StartDT)&(tDate'>EndDT) do
|
---|
| 225 | . . set TransIEN=+$piece($get(^TIU(8925,index,13)),"^",2) ;"field 1302
|
---|
| 226 | . . ;"write "index=",index," "
|
---|
| 227 | . . ;"write "TransIEN='"
|
---|
| 228 | . . ;"write TransIEN,"'"
|
---|
| 229 | . . if ($data(OPTIONS("TRANS"))=0)!($$InList^TMGMISC(TransIEN,TransArrayP)=1) do
|
---|
| 230 | . . . set AuthorIEN=$piece($get(^TIU(8925,index,12)),"^",2) ;field 1202
|
---|
| 231 | . . . if ($data(OPTIONS("AUTHOR"))=0)!($$InList^TMGMISC(AuthorIEN,AuthorArrayP)=1) do
|
---|
| 232 | . . . . new tCharCt,tLineCt,Date,DateS,Pt
|
---|
| 233 | . . . . new VDate,VDateSi
|
---|
| 234 | . . . . new pStatus
|
---|
| 235 | . . . . new Status set Status="N"
|
---|
| 236 | . . . . new Patient set Patient=""
|
---|
| 237 | . . . . set tCharCt=+$piece($get(^TIU(8925,index,"TMG")),"^",2);"field 22711=char count
|
---|
| 238 | . . . . set tLineCt=+$piece($get(^TIU(8925,index,0)),"^",10) ;"field .1 = line count
|
---|
| 239 | . . . . set pStatus=$piece($get(^TIU(8925,index,0)),"^",5) ;"field .05 is status file pointer
|
---|
| 240 | . . . . if +pStatus'=0 do
|
---|
| 241 | . . . . . set Status=$piece($get(^TIU(8925.6,pStatus,0)),"^",2) ;"8925.6=TIU Status. field .02=symbol
|
---|
| 242 | . . . . . if Status="c" set Status="Y"
|
---|
| 243 | . . . . . else set Status="N"
|
---|
| 244 | . . . . if (tLineCt=0)!(tCharCt=0) do
|
---|
| 245 | . . . . . if (tLineCt=0)&(tCharCt'=0) do
|
---|
| 246 | . . . . . . set tLineCt=(((tCharCt/CharsPerLine)*10)\1)/10
|
---|
| 247 | . . . . . else if (tCharCt=0)&(tLineCt'=0) do
|
---|
| 248 | . . . . . . set tCharCt=tLineCt*CharsPerLine
|
---|
| 249 | . . . . . else do
|
---|
| 250 | . . . . . . set tLineCt=$$DocLines^TMGMISC(index,.tCharCt)
|
---|
| 251 | . . . . . . if tLineCt=0 set tLineCt=(((tCharCt/CharsPerLine)*10)\1)/10
|
---|
| 252 | . . . . . set tLineCt=$$Round^TMGMISC(tLineCt)
|
---|
| 253 | . . . . . set tCharCt=$$Round^TMGMISC(tCharCt)
|
---|
| 254 | . . . . . ;"Store values, so next time we won't have to calculate it.
|
---|
| 255 | . . . . . set $piece(^TIU(8925,index,0),"^",10)=+tLineCt ;"field .1 = line count
|
---|
| 256 | . . . . . set $piece(^TIU(8925,index,"TMG"),"^",2)=tCharCt ;"field 22711 = char count
|
---|
| 257 | . . . . set Date=$piece($get(^TIU(8925,index,12)),"^",1) ;"field 1201 = Entry Date
|
---|
| 258 | . . . . ;"set DateS=$$FMTE^XLFDT(Date,"D")
|
---|
| 259 | . . . . set DateS=$$DTFormat^TMGMISC(Date,"ww mm/dd/yy")
|
---|
| 260 | . . . . set VDate=$piece($get(^TIU(8925,index,13)),"^",1) ;"field 1301=Ref/Visit Date
|
---|
| 261 | . . . . ;"set VDateS=$$FMTE^XLFDT(VDate,"D")
|
---|
| 262 | . . . . set VDateS=$$DTFormat^TMGMISC(VDate,"mm/dd/yy")
|
---|
| 263 | . . . . set AuthorInitials=$piece($get(^VA(200,AuthorIEN,0)),"^",2)
|
---|
| 264 | . . . . set TransInitials=$piece($get(^VA(200,TransIEN,0)),"^",2) ;"field 1 = initials
|
---|
| 265 | . . . . set CtAuthor(AuthorIEN,"LINES")=$get(CtAuthor(AuthorIEN,"LINES"))+tLineCt
|
---|
| 266 | . . . . set CtAuthor(AuthorIEN,"NOTES")=+$get(CtAuthor(AuthorIEN,"NOTES"))+1
|
---|
| 267 | . . . . set CtTrans(TransIEN,"LINES")=$get(CtTrans(TransIEN,"LINES"))+tLineCt
|
---|
| 268 | . . . . set CtTrans(TransIEN,"NOTES")=+$get(CtTrans(TransIEN,"NOTES"))+1
|
---|
| 269 | . . . . set Pt=+$piece($get(^TIU(8925,index,0)),"^",2) ;"field .02 = patient
|
---|
| 270 | . . . . if Pt'=0 set Patient=$piece($get(^DPT(Pt,0)),"^",1) ;"field .01 = name
|
---|
| 271 | . . . . new NoteBonus set NoteBonus=0
|
---|
| 272 | . . . . new PayRate set PayRate=$$PayRate(TransIEN,Date,.NoteBonus)
|
---|
| 273 | . . . . ;"new LineCost set LineCost=$$RoundDn^TMGMISC(tLineCt*PayRate)
|
---|
| 274 | . . . . ;"new LineCost set LineCost=(tLineCt*PayRate)
|
---|
| 275 | . . . . new LineCost set LineCost=(tLineCt*PayRate)+NoteBonus
|
---|
| 276 | . . . . set CtAuthor(AuthorIEN,"COST")=+$get(CtAuthor(AuthorIEN,"COST"))+LineCost
|
---|
| 277 | . . . . set CtAuthor(AuthorIEN,"BONUS")=+$get(CtAuthor(AuthorIEN,"BONUS"))+NoteBonus
|
---|
| 278 | . . . . set CtTrans(TransIEN,"COST")=+$get(CtTrans(TransIEN,"COST"))+LineCost
|
---|
| 279 | . . . . set CtTrans(TransIEN,"BONUS")=+$get(CtTrans(TransIEN,"BONUS"))+NoteBonus
|
---|
| 280 | . . . . if ShowDetails do
|
---|
| 281 | . . . . . write VDateS,"; "
|
---|
| 282 | . . . . . write $$RJ^XLFSTR(DateS,13),";"
|
---|
| 283 | . . . . . new tS set tS=tLineCt_" @"_PayRate
|
---|
| 284 | . . . . . if NoteBonus>0 set tS=tS_")+"_NoteBonus
|
---|
| 285 | . . . . . write $$RJ^XLFSTR(.tS,15)
|
---|
| 286 | . . . . . set tS=" =$"_LineCost_"; "
|
---|
| 287 | . . . . . write $$RJ^XLFSTR(.tS,10)
|
---|
| 288 | . . . . . write TransInitials,"; ",AuthorInitials,"; "
|
---|
| 289 | . . . . . write " ",Status,"; "
|
---|
| 290 | . . . . . write $$Clip^TMGSTUTL(Patient,15),!
|
---|
| 291 | . . . . set LineCt=LineCt+tLineCt
|
---|
| 292 | . set index=+$order(^TIU(8925,index))
|
---|
| 293 | . if index=0 set index=""
|
---|
| 294 |
|
---|
| 295 | write !,"Transcriptionist breakdown",!
|
---|
| 296 | write "-----------------------------",!
|
---|
| 297 | set index=$order(CtTrans(""))
|
---|
| 298 | for do quit:(index="")
|
---|
| 299 | . new TransS,Lines,Notes
|
---|
| 300 | . if index="" quit
|
---|
| 301 | . set TransS=$piece($get(^VA(200,index,0)),"^",1)
|
---|
| 302 | . if TransS="" set TransS="(Unknown Transcriptionist)"
|
---|
| 303 | . set Lines=+$get(CtTrans(index,"LINES"))
|
---|
| 304 | . set Notes=+$get(CtTrans(index,"NOTES"))
|
---|
| 305 | . write " ",TransS,": ",Lines," lines in ",Notes," notes."
|
---|
| 306 | . write " $",$get(CtTrans(index,"COST"))
|
---|
| 307 | . write " (income)",!
|
---|
| 308 | . if +$get(CtTrans(index,"BONUS"))>0 do
|
---|
| 309 | . . new c set c=+$get(CtTrans(index,"COST"))
|
---|
| 310 | . . new b set b=$get(CtTrans(index,"BONUS"))
|
---|
| 311 | . . write ?15,"$",c," = $",(c-b)," + $",b," per-note bonus.",!
|
---|
| 312 | . set index=$order(CtTrans(index))
|
---|
| 313 |
|
---|
| 314 | write !,"Author breakdown",!
|
---|
| 315 | write "--------------------",!
|
---|
| 316 | set index=$order(CtAuthor(""))
|
---|
| 317 | for do quit:(index="")
|
---|
| 318 | . new AuthorS,Lines,Notes
|
---|
| 319 | . if index="" quit
|
---|
| 320 | . set AuthorS=$piece($get(^VA(200,index,0)),"^",1)
|
---|
| 321 | . if AuthorS="" set AuthorS="(Unknown Author)"
|
---|
| 322 | . set Lines=+$get(CtAuthor(index,"LINES"))
|
---|
| 323 | . set Notes=+$get(CtAuthor(index,"NOTES"))
|
---|
| 324 | . write " ",AuthorS,": ",Lines," lines in ",Notes," notes."
|
---|
| 325 | . write " $",$get(CtAuthor(index,"COST"))," (expense)",!
|
---|
| 326 | . if +$get(CtAuthor(index,"BONUS"))>0 do
|
---|
| 327 | . . new c set c=+$get(CtAuthor(index,"COST"))
|
---|
| 328 | . . new b set b=$get(CtAuthor(index,"BONUS"))
|
---|
| 329 | . . write ?15,"$",c," = $",(c-b)," + $",b," per-note bonus.",!
|
---|
| 330 | . set index=$order(CtAuthor(index))
|
---|
| 331 |
|
---|
| 332 | write !!,"Done.",!
|
---|
| 333 |
|
---|
| 334 | RQDone
|
---|
| 335 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"RPTQUIET^TMGTRANS1")
|
---|
| 336 | quit
|
---|
| 337 |
|
---|
| 338 |
|
---|
| 339 | PayRateE(TransIEN,Date)
|
---|
| 340 | ;"Purpose: To provide a 'shell' for PayRate below, except external
|
---|
| 341 | ;" format of date alowed
|
---|
| 342 |
|
---|
| 343 | new IDate
|
---|
| 344 |
|
---|
| 345 | set X=$get(Date)
|
---|
| 346 | ;"set IDate=
|
---|
| 347 |
|
---|
| 348 | ;"COMPLETE FUNCTION LATER...
|
---|
| 349 |
|
---|
| 350 | quit
|
---|
| 351 |
|
---|
| 352 |
|
---|
| 353 | PayRate(TransIEN,Date,NoteBonus)
|
---|
| 354 | ;"Purpose: Get payrate in effect at time of Date
|
---|
| 355 | ;"Input: TransIEN -- the record number in file 200
|
---|
| 356 | ;" Date: reference date to lookup, ** in internal fileman format **
|
---|
| 357 | ;" NoteBonus -- [OPTIONAL] This is an out parameter. See below.
|
---|
| 358 | ;"Result: The payrate found in file TMG TRANSCRIPTION PAYRATE file
|
---|
| 359 | ;" This is dollars/line
|
---|
| 360 | ;" If NoteBonus was passed by reference, then the value of the
|
---|
| 361 | ;" NOTE BONUS field (field #3) is returned, or 0 if not found.
|
---|
| 362 | ;" Note: a result of 0 is returned if TransIEN not found, or
|
---|
| 363 | ;" no date range covers Date
|
---|
| 364 |
|
---|
| 365 | new result set result=0
|
---|
| 366 | new bonusresult set bonusresult=0
|
---|
| 367 | new RateIEN
|
---|
| 368 | new index
|
---|
| 369 |
|
---|
| 370 | if (+$get(TransIEN)=0)!(+$get(Date)=0) goto PRDone
|
---|
| 371 | set Date=Date\1
|
---|
| 372 | set RateIEN=+$order(^TMG(22704,"B",TransIEN,""))
|
---|
| 373 | if RateIEN=0 goto PRDone
|
---|
| 374 | merge PayRates=^TMG(22704,RateIEN,1)
|
---|
| 375 | set index=$order(^TMG(22704,RateIEN,1,0))
|
---|
| 376 | for do quit:(index="")
|
---|
| 377 | . if index="" quit
|
---|
| 378 | . new Rate set Rate=$get(^TMG(22704,RateIEN,1,index,0))
|
---|
| 379 | . if Rate'="" do
|
---|
| 380 | . . new StartDate,EndDate
|
---|
| 381 | . . set StartDate=$piece(Rate,"^",2)
|
---|
| 382 | . . set EndDate=$piece(Rate,"^",3)
|
---|
| 383 | . . if Date<StartDate do quit
|
---|
| 384 | . . . ;"write "Date=",Date," StartDate=",StartDate,!
|
---|
| 385 | . . if (EndDate'="")&(Date>EndDate) do quit
|
---|
| 386 | . . . ;"write "Date=",Date," EndDate=",EndDate,!
|
---|
| 387 | . . set result=$piece(Rate,"^",1)
|
---|
| 388 | . . set bonusresult=$piece(Rate,"^",4) ;"field#3 (NOTE BONUS)
|
---|
| 389 | . if result'=0 set index="" quit
|
---|
| 390 | . set index=$order(^TMG(22704,RateIEN,1,index))
|
---|
| 391 |
|
---|
| 392 | if result=0 do
|
---|
| 393 | . ;"write !,"TransIEN=",TransIEN," Date=",Date,!
|
---|
| 394 | PRDone
|
---|
| 395 | set NoteBonus=bonusresult
|
---|
| 396 | quit result
|
---|
| 397 |
|
---|
| 398 | ;"=======================================================================
|
---|
| 399 |
|
---|
| 400 | FREECUR
|
---|
| 401 | ;"Purpose: For current user, cycle through all alerts regarding
|
---|
| 402 | ;" documents needing to be signed, and automatically sign
|
---|
| 403 | ;" them, then print if user wants.
|
---|
| 404 | ;"Input: none. User will be asked for signature password,
|
---|
| 405 | ;" and if they want documents printed.
|
---|
| 406 | ;"Output: Produces a report to chosen output channel.
|
---|
| 407 |
|
---|
| 408 | ;"write @IOF
|
---|
| 409 | write !!,"-- RELEASE UNSIGNED DOCUMENTS -- ",!!
|
---|
| 410 | write "Releasing transcription for: ",$piece($get(^VA(200,DUZ,0)),"^",1),!!
|
---|
| 411 |
|
---|
| 412 | do FreeDocs(DUZ,1)
|
---|
| 413 |
|
---|
| 414 | write !,"Goodbye.",!
|
---|
| 415 |
|
---|
| 416 | quit
|
---|
| 417 |
|
---|
| 418 |
|
---|
| 419 | FREEASK
|
---|
| 420 | ;"Purpose: Ask for chosen user, then cycle through all alerts
|
---|
| 421 | ;" regarding documents needing to be signed, and automatically
|
---|
| 422 | ;" sign them, then print if user wants.
|
---|
| 423 | ;"Input: none. User will be asked for signature password,
|
---|
| 424 | ;" and if they want documents printed.
|
---|
| 425 | ;"Output: Produces a report to choses output channel.
|
---|
| 426 |
|
---|
| 427 | new Y,DIC,TransIEN,DocIEN
|
---|
| 428 | set TransIEN=-1
|
---|
| 429 |
|
---|
| 430 | ;"write @IOF
|
---|
| 431 | write !!,"-- RELEASE UNSIGNED DOCUMENTS -- ",!!
|
---|
| 432 |
|
---|
| 433 | set DIC=200 ;"NEW PERSON file
|
---|
| 434 | set DIC(0)="MAQE"
|
---|
| 435 | set DIC("A")="Enter name of author (^ to abort): "
|
---|
| 436 | do ^DIC
|
---|
| 437 | if +Y'>0 do goto RADone
|
---|
| 438 | . write !,"No author selected. Aborting report.",!
|
---|
| 439 | set DocIEN=+Y
|
---|
| 440 |
|
---|
| 441 | write !!,"OPTIONAL-- Enter name of transcriptionist to screen for. If specified, ",!
|
---|
| 442 | write "only notes entered by this transcriptionist will be signed and released."
|
---|
| 443 | set DIC("A")="Enter name of transcriptionist (ENTER or ^ to skip): "
|
---|
| 444 | do ^DIC
|
---|
| 445 | write !!
|
---|
| 446 | if +Y'>0 set TransIEN=+Y
|
---|
| 447 |
|
---|
| 448 | do FreeDocs(DocIEN,1,TransIEN)
|
---|
| 449 |
|
---|
| 450 | write !,"Goodbye.",!
|
---|
| 451 |
|
---|
| 452 | FADone
|
---|
| 453 | quit
|
---|
| 454 |
|
---|
| 455 |
|
---|
| 456 | FreeDocs(AuthorIEN,ShowDetails,TransIEN)
|
---|
| 457 | ;"Purpose: to finish the interactive release documents process.
|
---|
| 458 | ;" This separate entry point allows restriction of the author
|
---|
| 459 | ;" whose's documents are to be released.
|
---|
| 460 | ;"Input: AuthorIEN, the record number of the author in file 200
|
---|
| 461 | ;" ShowDetails: optional. Default is to show details (1)
|
---|
| 462 | ;" 0=don't show, 1=show
|
---|
| 463 | ;" TransIEN: OPTIONAL -- the IEN of the transcriptionist.
|
---|
| 464 | ;" IF specified, then ONLY those notes created by this
|
---|
| 465 | ;" transcriptionist will be finished/released
|
---|
| 466 |
|
---|
| 467 | new Signed
|
---|
| 468 | new abort set abort=0
|
---|
| 469 | new Options
|
---|
| 470 | new PrintAfter
|
---|
| 471 | new YN
|
---|
| 472 | new SignAll
|
---|
| 473 |
|
---|
| 474 | set Options("AUTHOR")=+$get(AuthorIEN)
|
---|
| 475 | set Options("SIG")=0
|
---|
| 476 | set Options("DETAILS")=$get(ShowDetails,1)
|
---|
| 477 | if +$get(TransIEN)>0 set Options("TRANS")=+TransIEN
|
---|
| 478 |
|
---|
| 479 | do
|
---|
| 480 | . write "Enter 'your' (meaning author's) signature code below."
|
---|
| 481 | . new DUZ
|
---|
| 482 | . set DUZ=+$get(AuthorIEN)
|
---|
| 483 | . if DUZ=0 quit
|
---|
| 484 | . do SIG^XUSESIG
|
---|
| 485 | . write !
|
---|
| 486 | . if X1'="" set Options("SIG")=1
|
---|
| 487 | if Options("SIG")'=1 do goto FADDone
|
---|
| 488 | . write "Signature code incorrect. Aborting.",!
|
---|
| 489 |
|
---|
| 490 | read "Sign all notes at once (^/Y/N): YES// ",SignAll:$get(DTIME,3600),!
|
---|
| 491 | if SignAll="" set SignAll="Y"
|
---|
| 492 | if SignAll="^" write "Aborting.",! goto ADRDone
|
---|
| 493 | set Options("SIGN ALL")=($$UP^XLFSTR(SignAll)["Y")
|
---|
| 494 |
|
---|
| 495 | write !,"Print Notes after signing? (^/Y/N): YES// "
|
---|
| 496 | read YN:$get(DTIME,3600),!
|
---|
| 497 | if YN="^" write "Aborting.",! goto ADRDone
|
---|
| 498 | if YN="" set YN="Y"
|
---|
| 499 | set PrintAfter=($$UP^XLFSTR(YN)["Y")
|
---|
| 500 |
|
---|
| 501 | do AlertSign(.Options,.Signed)
|
---|
| 502 |
|
---|
| 503 | write "Now look at ALL documents to find any unsigned ones.",!
|
---|
| 504 | set Options("START")="0001111"
|
---|
| 505 | do NOW^%DTC
|
---|
| 506 | set Options("END")=X
|
---|
| 507 | do ScanSign(.Options,.Signed)
|
---|
| 508 |
|
---|
| 509 | merge ^TMG("BATCH SIGNED DOCS",$J)=Signed
|
---|
| 510 |
|
---|
| 511 | if PrintAfter do PRINT(.Signed)
|
---|
| 512 |
|
---|
| 513 | FADDone
|
---|
| 514 | quit
|
---|
| 515 |
|
---|
| 516 |
|
---|
| 517 | ScanSign(OPTIONS,SIGNED)
|
---|
| 518 | ;"Purpose: To scan through all TIU DOCUMENTS, and release those
|
---|
| 519 | ;" that have a status of unsigned to completed
|
---|
| 520 | ;"Input: The following elements in OPTIONS should be defined
|
---|
| 521 | ;" 0PTIONS("AUTHOR") ;"the IEN of the user (IEN from file 200)
|
---|
| 522 | ;" OPTIONS("START") ;"Earliest date of documents, in Fileman internal format
|
---|
| 523 | ;" ;"Note if not specified, then all dates are matched
|
---|
| 524 | ;" OPTIONS("END") ;"Latest date of documents, in Fileman internal format
|
---|
| 525 | ;" ;"Note if not specified, then all dates are matched
|
---|
| 526 | ;" OPTIONS("DETAILS") ;"if 1, then each document is shown as signed (not quiet)
|
---|
| 527 | ;" OPTIONS("SIG") ;"1 if signature has been verified.
|
---|
| 528 | ;" -----------Optional OPTIONS below---------------
|
---|
| 529 | ;" OPTIONS("TRANS") ;"the IEN of note. If specified, then note will not be signed
|
---|
| 530 | ;" ;"unless the transcriptionist (i.e. ENTERED BY field) = this IEN
|
---|
| 531 | ;" -------------------------------------------------------
|
---|
| 532 | ;" SIGNED: OPTIONAL. This is an OUT PARAMETER -- must be passed by reference
|
---|
| 533 | ;" This will contain list of documents freed/signed, in this format:
|
---|
| 534 | ;" SIGNED(1234)=1234 with 1234 being IEN of document signed.
|
---|
| 535 | ;" SIGNED(1235)=1235 with 1235 being IEN of document signed.
|
---|
| 536 | ;" SIGNED(1236)=1236 with 1235 being IEN of document signed.
|
---|
| 537 |
|
---|
| 538 | new index
|
---|
| 539 | new DocAuth,Status,EnteredBy
|
---|
| 540 | new User,initials
|
---|
| 541 | new NeedsCR set NeedsCR=1
|
---|
| 542 | new StartDT,EndDT
|
---|
| 543 | new ShowDetails set ShowDetails=+$get(OPTIONS("DETAILS"))
|
---|
| 544 |
|
---|
| 545 | if +$get(OPTIONS("START"))=0 do
|
---|
| 546 | . new %DT
|
---|
| 547 | . set %DT="AEP"
|
---|
| 548 | . set %DT("A")="Enter starting date (^ to abort): "
|
---|
| 549 | . do ^%DT
|
---|
| 550 | . set OPTIONS("START")=Y
|
---|
| 551 | if $get(OPTIONS("START"))'>0 do goto SSDone
|
---|
| 552 | . if ShowDetails write "START date invalid. Aborting.",!
|
---|
| 553 |
|
---|
| 554 | if +$get(OPTIONS("END"))=0 do
|
---|
| 555 | . set %DT("A")="Enter ending date (^ to abort): "
|
---|
| 556 | . do ^%DT
|
---|
| 557 | . set OPTIONS("END")=Y
|
---|
| 558 | if $get(OPTIONS("END"))'>0 do goto SSDone
|
---|
| 559 | . if ShowDetails write "END date invalid. Aborting.",!
|
---|
| 560 |
|
---|
| 561 | set User=+$get(OPTIONS("AUTHOR"))
|
---|
| 562 | if User=0 do goto RQDone
|
---|
| 563 | . if $get(OPTIONS("DETAILS")) write "No author IEN supplied. Aborting.",!
|
---|
| 564 | set StartDT=+$get(OPTIONS("START"))
|
---|
| 565 | set EndDT=+$get(OPTIONS("END"))
|
---|
| 566 |
|
---|
| 567 | if $get(OPTIONS("DETAILS")) do
|
---|
| 568 | . write !,"------------------------------------------------",!
|
---|
| 569 | . write "Starting scan of all documents. [ESC] will abort.",!
|
---|
| 570 | . write "------------------------------------------------",!
|
---|
| 571 |
|
---|
| 572 | set initials=$piece($get(^VA(200,User,0)),"^",2) ;"field 1 = initials
|
---|
| 573 | new sUnsigned set sUnsigned=$order(^TIU(8925.6,"B","UNSIGNED",""))
|
---|
| 574 | new sUnverified set sUnverified=$order(^TIU(8925.6,"B","UNVERIFIED",""))
|
---|
| 575 |
|
---|
| 576 | set index=$order(^TIU(8925,0))
|
---|
| 577 | for do quit:(index="")
|
---|
| 578 | . if index="" quit
|
---|
| 579 | . new k read *k:0
|
---|
| 580 | . if k=27 do quit
|
---|
| 581 | . . set index=""
|
---|
| 582 | . . if $get(OPTIONS("DETAILS")) write "Release aborted by ESC from user.",!
|
---|
| 583 | . set DocAuth=$piece($get(^TIU(8925,index,12)),"^",2) ;"field 1202 = Author
|
---|
| 584 | . set EnteredBy=$piece($get(^TIU(8925,index,13)),"^",2) ;"field 1302 = Entered By
|
---|
| 585 | . if (DocAuth=$get(OPTIONS("AUTHOR"))) do
|
---|
| 586 | . . if $data(OPTIONS("TRANS"))&($get(OPTIONS("TRANS"))'=EnteredBy) quit
|
---|
| 587 | . . set Status=$piece($get(^TIU(8925,index,0)),"^",5) ;"field .05 = Status
|
---|
| 588 | . . if (Status=sUnsigned)!(Status=sUnverified) do ;"*** What else should go here?!!
|
---|
| 589 | . . . new tDate
|
---|
| 590 | . . . set tDate=$piece($get(^TIU(8925,index,12)),"^",1)
|
---|
| 591 | . . . set tDate=tDate\1 ;"integer round down (removes time decimal amount)
|
---|
| 592 | . . . if (StartDT=0)!(EndDT=0)!((tDate'<StartDT)&(tDate'>EndDT)) do
|
---|
| 593 | . . . . if $$SIGNDOC(index,.OPTIONS) do
|
---|
| 594 | . . . . . set SIGNED(index)=index
|
---|
| 595 | . set index=+$order(^TIU(8925,index))
|
---|
| 596 | . if index=0 set index=""
|
---|
| 597 |
|
---|
| 598 | SSDone
|
---|
| 599 | if $get(OPTIONS("DETAILS")) write !,"Done scanning all documents.",!
|
---|
| 600 |
|
---|
| 601 | quit
|
---|
| 602 |
|
---|
| 603 |
|
---|
| 604 | AlertSign(OPTIONS,SIGNED)
|
---|
| 605 | ;"Purpose: To cycle through all alerts for AUTHOR, and release TIU DOCUMENTS
|
---|
| 606 | ;" needing signature.
|
---|
| 607 | ;"Input: The following elements in OPTIONS should be defined
|
---|
| 608 | ;" 0PTIONS("AUTHOR") ;"the IEN of the user (IEN from file 200)
|
---|
| 609 | ;" OPTIONS("DETAILS") ;"if 1, then each document is shown as signed (not quiet)
|
---|
| 610 | ;" OPTIONS("SIG") ;"1 if signature has been verified.
|
---|
| 611 | ;" OPTIONS("SIGN ALL");"if 1, then all are signed without asking each one.
|
---|
| 612 | ;" SIGNED: OPTIONAL. This is an OUT PARAMETER -- must be passed by reference
|
---|
| 613 | ;" This will contain list of documents freed/signed, in this format:
|
---|
| 614 | ;" SIGNED(1234)=1234 with 1234 being IEN of document signed.
|
---|
| 615 | ;" SIGNED(1235)=1235 with 1235 being IEN of document signed.
|
---|
| 616 | ;" SIGNED(1236)=1236 with 1235 being IEN of document signed.
|
---|
| 617 |
|
---|
| 618 | new index
|
---|
| 619 | new Abort set Abort=0
|
---|
| 620 | new Alert
|
---|
| 621 | new DocIEN
|
---|
| 622 | new NumFound set NumFound=0
|
---|
| 623 | new SignAll set SignAll=+$get(OPTIONS("SIGN ALL"))
|
---|
| 624 |
|
---|
| 625 | set User=+$get(OPTIONS("AUTHOR"))
|
---|
| 626 | if User=0 do goto RQDone
|
---|
| 627 | . if $get(OPTIONS("DETAILS")) write "No author IEN supplied. Aborting.",!
|
---|
| 628 |
|
---|
| 629 | if $get(OPTIONS("DETAILS")) do
|
---|
| 630 | . write !,"-------------------------------------------------------",!
|
---|
| 631 | . write "Search for 'signature-needed' alerts. [ESC] will abort.",!
|
---|
| 632 | . write "-------------------------------------------------------",!
|
---|
| 633 |
|
---|
| 634 | if SignAll'=1 do if NumFound=0 goto ASgn2
|
---|
| 635 | . write !!,"-------- List of Documents to be Signed --------",!
|
---|
| 636 | . set index=$order(^XTV(8992,User,"XQA",0))
|
---|
| 637 | . for do quit:(index="")
|
---|
| 638 | . . if index="" quit
|
---|
| 639 | . . new k read *k:0
|
---|
| 640 | . . if k=27 do quit
|
---|
| 641 | . . . set index=""
|
---|
| 642 | . . . if $get(OPTIONS("DETAILS")) write "List aborted by ESC from user.",!
|
---|
| 643 | . . set Alert=$get(^XTV(8992,User,"XQA",index,0))
|
---|
| 644 | . . if $piece(Alert,"^",3)["available for SIGNATURE" do
|
---|
| 645 | . . . write $piece(Alert,"^",3),!
|
---|
| 646 | . . . set NumFound=NumFound+1
|
---|
| 647 | . . set index=$order(^XTV(8992,User,"XQA",index))
|
---|
| 648 | . write "-----------------------------------------------",!
|
---|
| 649 | . write !,NumFound," documents needing signature.",!!
|
---|
| 650 | . if NumFound=0 do quit
|
---|
| 651 | . . write "No alerts for a missing signature found.!",!
|
---|
| 652 |
|
---|
| 653 | ;"WRITE "STARTING SIGN LOOP",!
|
---|
| 654 | set NumFound=0
|
---|
| 655 | set index=$order(^XTV(8992,User,"XQA",0))
|
---|
| 656 | for do quit:(index="")!(Abort=1)
|
---|
| 657 | . new Title,YN
|
---|
| 658 | . if index="" quit
|
---|
| 659 | . set Alert=$get(^XTV(8992,User,"XQA",index,0))
|
---|
| 660 | . set Title=$piece(Alert,"^",3)
|
---|
| 661 | . if Title["available for SIGNATURE" do
|
---|
| 662 | . . set NumFound=NumFound+1
|
---|
| 663 | . . if SignAll'=1 do
|
---|
| 664 | . . . write "Sign: ",$piece(Title," ",1),"? (Y/N/ALL): ALL// "
|
---|
| 665 | . . . read YN:$get(DTIME,3600),!
|
---|
| 666 | . . . set YN=$$UP^XLFSTR(YN)
|
---|
| 667 | . . else set YN="Y"
|
---|
| 668 | . . if YN="" set YN="ALL" write "ALL",!
|
---|
| 669 | . . if YN="ALL" set SignAll=1 set YN="Y"
|
---|
| 670 | . . else if YN["^" write !,"Aborting.",! set Abort=1 quit
|
---|
| 671 | . . if YN["Y" do
|
---|
| 672 | . . . set DocIEN=+$get(^XTV(8992,User,"XQA",index,1))
|
---|
| 673 | . . . if DocIEN'=0 do
|
---|
| 674 | . . . . if $$SIGNDOC(DocIEN,.OPTIONS) do
|
---|
| 675 | . . . . . set SIGNED(DocIEN)=DocIEN
|
---|
| 676 | . set index=$order(^XTV(8992,User,"XQA",index))
|
---|
| 677 |
|
---|
| 678 | if $get(OPTIONS("DETAILS")) do
|
---|
| 679 | . write !!,"Done searching for 'needed-signature' alerts.",!
|
---|
| 680 |
|
---|
| 681 | ASgn2
|
---|
| 682 | if (1=0) do ;"if (NumFound=0) do
|
---|
| 683 | . if $get(OPTIONS("DETAILS")) do
|
---|
| 684 | . . write "No alert indicating a signature is needed was found....",!
|
---|
| 685 | . . write "...So starting a scan of all documents to look for unsigned documents.",!
|
---|
| 686 | . set OPTIONS("START")="0001111"
|
---|
| 687 | . do NOW^%DTC
|
---|
| 688 | . set OPTIONS("END")=X
|
---|
| 689 | . do ScanSign(.OPTIONS,.Signed)
|
---|
| 690 |
|
---|
| 691 | ASgnDone
|
---|
| 692 | quit
|
---|
| 693 |
|
---|
| 694 |
|
---|
| 695 | SIGNDOC(DocIEN,OPTIONS)
|
---|
| 696 | ;"Purpose: To sign one document
|
---|
| 697 | ;"Input: DocIEN -- the record number of the document to sign
|
---|
| 698 | ;" OPTIONS -- An array with input values. The following are used:
|
---|
| 699 | ;" 0PTIONS("AUTHOR") ;"the IEN of the user (IEN from file 200)
|
---|
| 700 | ;" OPTIONS("DETAILS") ;"if 1, then each document showed
|
---|
| 701 | ;" OPTIONS("SIG") ;"1 if signature has been verified.
|
---|
| 702 | ;"Results: 1 = successful sign. 0 = failure
|
---|
| 703 |
|
---|
| 704 | new result set result=0 ;"default to failure
|
---|
| 705 | new Node0
|
---|
| 706 | new sCompleted set sCompleted=$order(^TIU(8925.6,"B","COMPLETED",""))
|
---|
| 707 | new NewStatus
|
---|
| 708 | if $get(OPTIONS("SIG"))'=1 goto SDCDone
|
---|
| 709 | if +$get(OPTIONS("AUTHOR"))'>0 goto SDCDone
|
---|
| 710 | if $get(DocIEN)="" goto SDCDone
|
---|
| 711 |
|
---|
| 712 | new SignerS
|
---|
| 713 | set SignerS=1_"^"_$piece($get(^VA(200,+OPTIONS("AUTHOR"),20)),"^",2,3)
|
---|
| 714 | if $data(^TIU(8925,DocIEN,0))=0 do goto SDCDone
|
---|
| 715 | . write "Unable to sign document #",DocIEN," because it doesn't seem to exist.",!
|
---|
| 716 | do ES^TIURS(DocIEN,SignerS)
|
---|
| 717 | ;"Note: alert(s) r.e. "Note available for signature" are automatically removed
|
---|
| 718 |
|
---|
| 719 | SDLoop
|
---|
| 720 | set Node0=$get(^TIU(8925,DocIEN,0))
|
---|
| 721 | set NewStatus=$piece(Node0,"^",5) ;"field .05 = Status
|
---|
| 722 |
|
---|
| 723 | new Date,DateS,Pt
|
---|
| 724 | set Date=$piece(Node0,"^",7) ;"field .07 = Episode begin date/time
|
---|
| 725 | set DateS=$$FMTE^XLFDT(Date,"D")
|
---|
| 726 | set Pt=+$piece(Node0,"^",2) ;"field .02 = patient
|
---|
| 727 | if Pt'=0 set Patient=$piece($get(^DPT(Pt,0)),"^",1) ;"field .01 = name
|
---|
| 728 | if OPTIONS("DETAILS")=1 do
|
---|
| 729 | . write DateS," -- ",Patient
|
---|
| 730 |
|
---|
| 731 | if NewStatus'=sCompleted do goto SDLoop
|
---|
| 732 | . if OPTIONS("DETAILS")=1 do
|
---|
| 733 | . . new s
|
---|
| 734 | . . set s=$piece($get(^TIU(8925.6,NewStatus,0)),"^",1)
|
---|
| 735 | . . write " NOT completed. Status=",s
|
---|
| 736 | . . write !," TRYING AGAIN. (utilizing a lower-level signature method.)",!
|
---|
| 737 | . . set $piece(^TIU(8925,DocIEN,0),"^",5)=sCompleted
|
---|
| 738 |
|
---|
| 739 | if OPTIONS("DETAILS")=1 do
|
---|
| 740 | . write " Released (auto-'signed')",!
|
---|
| 741 |
|
---|
| 742 | set result=1 ;"success
|
---|
| 743 |
|
---|
| 744 | SDCDone
|
---|
| 745 | quit result
|
---|
| 746 |
|
---|
| 747 |
|
---|
| 748 | PRINT(DocArray) ; Prompt and print, or array
|
---|
| 749 | ;"This function was copied from PRINT^TIUEPRNT, to allow modification
|
---|
| 750 | ;"Function modification: changed to allow array input.
|
---|
| 751 | ;" DocArray: This will contain list of documents to print, in this format:
|
---|
| 752 | ;" DocArray(1234)=1234 with 1234 being IEN of document to be printed.
|
---|
| 753 | ;" DocArray(1235)=1235 with 1235 being IEN of document to be printed.
|
---|
| 754 | ;" DocArray(1236)=1236 with 1235 being IEN of document to be printed.
|
---|
| 755 | ;" Note: Is appears that DocArray(IEN)="" is the needed format.
|
---|
| 756 |
|
---|
| 757 | New TIUDEV,TIUTYP,DFN,TIUPMTHD,TIUD0,TIUMSG,TIUPR,TIUDARR,TIUDPRM
|
---|
| 758 | new TIUFLAG set TIUFLAG="x"
|
---|
| 759 | New TIUPGRP,TIUPFHDR,TIUPFNBR
|
---|
| 760 |
|
---|
| 761 | new index set index=$order(DocArray(""))
|
---|
| 762 | if index="" goto PRINT1X
|
---|
| 763 | for do quit:(index="")
|
---|
| 764 | . set DocIEN=index
|
---|
| 765 | . ;
|
---|
| 766 | . If +$$ISADDNDM^TIULC1(DocIEN) Set DocIEN=$Piece($Get(^TIU(8925,+DocIEN,0)),U,6)
|
---|
| 767 | . If $Get(^TIU(8925,DocIEN,21)) Set DocIEN=^TIU(8925,DocIEN,21)
|
---|
| 768 | . Set TIUD0=$Get(^TIU(8925,DocIEN,0))
|
---|
| 769 | . Set TIUTYP=$Piece(TIUD0,U)
|
---|
| 770 | . Set DFN=$Piece(TIUD0,U,2)
|
---|
| 771 | . If +TIUTYP'>0 Quit
|
---|
| 772 | . ;
|
---|
| 773 | . Set TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
|
---|
| 774 | . Set TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
|
---|
| 775 | . Set TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
|
---|
| 776 | . Set TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
|
---|
| 777 | . ;
|
---|
| 778 | . Do DOCPRM^TIULC1(+TIUTYP,.TIUDPRM,DocIEN)
|
---|
| 779 | . ;
|
---|
| 780 | . If +$Piece($Get(TIUDPRM(0)),U,9) do
|
---|
| 781 | . . if TIUFLAG="x" Set TIUFLAG=$$FLAG^TIUPRPN3 ;"Asks Chart vs. Work Copy? only ONCE
|
---|
| 782 | . If ($Get(TIUPMTHD)]"")&(+$Get(TIUPGRP))&($Get(TIUPFHDR)]"")&($Get(TIUPFNBR)]"") do
|
---|
| 783 | . . Set TIUDARR(TIUPMTHD,$Get(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,1,DocIEN)=TIUPFNBR
|
---|
| 784 | . Else Set TIUDARR(TIUPMTHD,DFN,1,DocIEN)=""
|
---|
| 785 | . ;
|
---|
| 786 | . If $Get(TIUPMTHD)']"" do ;"Goto PRINT1X
|
---|
| 787 | . . if OPTIONS("DETAILS")=1 do
|
---|
| 788 | . . . Write !,$Char(7),"No Print Method Defined for "
|
---|
| 789 | . . . write $Piece($Get(^TIU(8925.1,+TIUTYP,0)),U)
|
---|
| 790 | . . ;"Hang 2
|
---|
| 791 | . ;
|
---|
| 792 | . set index=$order(DocArray(index))
|
---|
| 793 |
|
---|
| 794 | Set TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device/allow queueing
|
---|
| 795 | If ($Get(IO)']"")!(TIUDEV']"") Do ^%ZISC Quit
|
---|
| 796 | If $Data(IO("Q")) Do QUE^TIUDEV("PRINTQ^TIUEPRNT",TIUDEV) Goto PRINT1X
|
---|
| 797 | Do PRINTQ^TIUEPRNT
|
---|
| 798 | Do ^%ZISC
|
---|
| 799 |
|
---|
| 800 | PRINT1X ; Exit single document print
|
---|
| 801 | Quit
|
---|
| 802 |
|
---|
| 803 |
|
---|
| 804 | SHOWUNSIGNED
|
---|
| 805 | ;"Purpose: to scan through all documents and show any that are unsigned
|
---|
| 806 |
|
---|
| 807 | new index
|
---|
| 808 | new DocAuth,Status,Patient,PtName
|
---|
| 809 | new TransIEN,TransInit
|
---|
| 810 | new User,initials,AuthName
|
---|
| 811 | new NeedsCR set NeedsCR=1
|
---|
| 812 | new StartDT,EndDT
|
---|
| 813 |
|
---|
| 814 | write !,"----------------------------------------------",!
|
---|
| 815 | write "Starting scan of documents. [ESC] will abort.",!
|
---|
| 816 | write "----------------------------------------------",!
|
---|
| 817 |
|
---|
| 818 | new sUnsigned set sUnsigned=$order(^TIU(8925.6,"B","UNSIGNED",""))
|
---|
| 819 | new sCompleted set sCompleted=$order(^TIU(8925.6,"B","COMPLETED",""))
|
---|
| 820 |
|
---|
| 821 | set index=$order(^TIU(8925,0))
|
---|
| 822 | for do quit:(index="")
|
---|
| 823 | . if index="" quit
|
---|
| 824 | . new k read *k:0
|
---|
| 825 | . if k=27 do quit
|
---|
| 826 | . . set index=""
|
---|
| 827 | . . if $get(OPTIONS("DETAILS")) write "Scan aborted by ESC from user.",!
|
---|
| 828 | . set Status=$piece($get(^TIU(8925,index,0)),"^",5) ;"field .05 = Status
|
---|
| 829 | . if (Status'=sCompleted) do
|
---|
| 830 | . . ;"write !
|
---|
| 831 | . . new tDate
|
---|
| 832 | . . set tDate=$piece($get(^TIU(8925,index,12)),"^",1)
|
---|
| 833 | . . set DocAuth=$piece($get(^TIU(8925,index,12)),"^",2) ;"field 1202 = Author
|
---|
| 834 | . . set initials=$piece($get(^VA(200,DocAuth,0)),"^",2) ;"field .02 = initials
|
---|
| 835 | . . set AuthName=$piece($get(^VA(200,DocAuth,0)),"^",1) ;"field .01 = Name
|
---|
| 836 | . . set Patient=$piece($get(^TIU(8925,index,0)),"^",2) ;"field .02 = patient IEN
|
---|
| 837 | . . set TransIEN=$piece($get(^TIU(8925,index,13)),"^",2) ;"field 1302 = Entered by IEN
|
---|
| 838 | . . if +TransIEN'=0 set TransInit=$piece($get(^VA(200,TransIEN,0)),"^",2) ;" field .02 = initials
|
---|
| 839 | . . else set TransInit="???"
|
---|
| 840 | . . if +Patient'=0 set PtName=$piece($get(^DPT(Patient,0)),"^",1) ;"field .01 is patient name
|
---|
| 841 | . . else set Patient="Name Unknown(?)"
|
---|
| 842 | . . set DateS=$$DTFormat^TMGMISC(tDate,"ww mm/dd/yy")
|
---|
| 843 | . . write "NOT COMPLETED. "
|
---|
| 844 | . . write $$RJ^XLFSTR(AuthName_"; ",20)
|
---|
| 845 | . . write $$RJ^XLFSTR(DateS_"; ",15)
|
---|
| 846 | . . write $$RJ^XLFSTR(TransInit_"; ",5)
|
---|
| 847 | . . write $$Clip^TMGSTUTL(PtName,20),!
|
---|
| 848 | . ;"else write "."
|
---|
| 849 | . set index=+$order(^TIU(8925,index))
|
---|
| 850 | . if index=0 set index=""
|
---|
| 851 |
|
---|
| 852 | write !,"Done scanning documents.",!
|
---|
| 853 |
|
---|
| 854 | quit
|
---|
| 855 |
|
---|
| 856 |
|
---|
| 857 |
|
---|
| 858 | PWDSNOOP(IEN)
|
---|
| 859 | ;"Purpose: To show private info for a given user
|
---|
| 860 | ;"NOTICE: This function MUST be used responsibly
|
---|
| 861 | ;"Input: IEN -- [OPTIONAL] the record number of the user to snoop on
|
---|
| 862 |
|
---|
| 863 | write !!,"------------------------------------------------------------------",!
|
---|
| 864 | write "Notice: This function will unmask private password codes.",!
|
---|
| 865 | write "These codes can be used spoof this EMR system. Note",!
|
---|
| 866 | write "that impersonating another user can be a CRIME.",!,!
|
---|
| 867 |
|
---|
| 868 | if $data(IEN) goto IS2
|
---|
| 869 |
|
---|
| 870 | set DIC=200 ;"NEW PERSON file
|
---|
| 871 | set DIC(0)="MAQE"
|
---|
| 872 | set DIC("A")="Enter name of user to unmask codes for (^ to abort): "
|
---|
| 873 | do ^DIC
|
---|
| 874 | if +Y=-1 do goto ISPDone
|
---|
| 875 | . write !,"No user selected. Aborting report.",!
|
---|
| 876 |
|
---|
| 877 | write !,!
|
---|
| 878 | set IEN=+Y
|
---|
| 879 |
|
---|
| 880 | IS2
|
---|
| 881 | new VerHash,AccHash,ESig
|
---|
| 882 | if '$data(IEN) goto ISPDone
|
---|
| 883 |
|
---|
| 884 | set VerHash=$piece($get(^VA(200,IEN,.1)),"^",2)
|
---|
| 885 | set AccHash=$piece($get(^VA(200,IEN,0)),"^",3)
|
---|
| 886 | set ESig=$piece($get(^VA(200,IEN,20)),"^",4)
|
---|
| 887 |
|
---|
| 888 | write "Access Code=",$$UN^XUSHSH(AccHash),!
|
---|
| 889 | write "Verify Code=",$$UN^XUSHSH(VerHash),!
|
---|
| 890 | write "Electronic Signature=",ESig,!!
|
---|
| 891 |
|
---|
| 892 | write "Remember, you are morally, ethically, and LEGALLY required to use",!
|
---|
| 893 | write "this information only in an appropriate manner.",!
|
---|
| 894 | write "------------------------------------------------------------------",!
|
---|
| 895 | write "Goodbye.",!!
|
---|
| 896 |
|
---|
| 897 | ISPDone
|
---|
| 898 | quit
|
---|
| 899 |
|
---|
| 900 |
|
---|
| 901 |
|
---|
| 902 |
|
---|
| 903 |
|
---|