TMGTRAN1 ;TMG/kst/TRANSCRIPTION REPORT FUNCTIONS -- UI ;03/25/06 ;;1.0;TMG-LIB;**1**;09/01/05 ;" TRANSCRIPTION REPORT FUNCTIONS ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"RPTCUR ;"RPTASK ;"RPTQUIET(OPTIONS) ;"FREECUR ;"FREEASK ;"ScanSign(OPTIONS,SIGNED) ;"PWDSNOOP(IEN) ;"SHOWUNSIGNED ;"SIGNDOC(DocIEN,OPTIONS) ;"PRINT(DocArray) ; Prompt and print, or array ;"======================================================================= ;" Private Functions. ;"======================================================================= ;"AskDatesRPT(Options) ;"FreeDocs(AuthorIEN,ShowDetails) ;"======================================================================= RPTCUR ;"SCOPE: PUBLIC ;"Purpose: To report transcription productivity for the current user (DUZ) ;"Input: none. User will be asked for start and end dates ;"Output: Produces a report to choses output channel. new Options write !,"-- TRANSCRIPTION PRODUCTIVITY CREDIT REPORT -- ",!! write "Showing credit for: ",$piece($get(^VA(200,DUZ,0)),"^",1),!! set Options("TRANS")=DUZ do AskDatesRPT(.Options) quit RPTASK ;"SCOPE: PUBLIC ;"Purpose: To report transcription productivity for a chosen user ;"Input: none. User will be asked for the user to report on, and also ;" start and end dates ;"Output: Produces a report to choses output channel. new Options ;"set TMGDEBUG=1 ;"TEMP!!! write !,"-- TRANSCRIPTION PRODUCTIVITY CREDIT REPORT -- ",!! set DIC=200 ;"NEW PERSON file set DIC(0)="MAQE" set DIC("A")="Enter name of transcriptionist (^ to abort): " do ^DIC if +Y=-1 do goto RADone . write !,"No transcriptionist selected. Aborting report.",! set Options("TRANS")=+Y do AskDatesRPT(.Options) RADone quit RPTCURA ;"SCOPE: PUBLIC ;"Purpose: To report current user's (DUZ) cost for all transcriptionists ;"Input: none. User will be asked for start and end dates ;"Output: Produces a report to choses output channel. new Options write !,"-- TRANSCRIPTION COST REPORT -- ",!! write "Showing cost for: ",$piece($get(^VA(200,DUZ,0)),"^",1),!! set Options("AUTHOR")=DUZ do AskDatesRPT(.Options) quit RPTASKA ;"SCOPE: PUBLIC ;"Purpose: To report transcription costs for a chosen user ;"Input: none. User will be asked for the user to report on, and also ;" start and end dates ;"Output: Produces a report to choses output channel. new Options write !,"-- TRANSCRIPTION COST REPORT -- ",!! set DIC=200 ;"NEW PERSON file set DIC(0)="MAQE" set DIC("A")="Enter name of author (^ to abort): " do ^DIC if +Y=-1 do goto RAADone . write !,"No author selected. Aborting report.",! set Options("AUTHOR")=+Y do AskDatesRPT(.Options) RAADone quit AskDatesRPT(Options) ;"SCOPE: PUBLIC ;"Purpose: to finish the interactive report process. ;"Input: An array that should contain Options("TRANS")=IEN write !!! write "NOTE: Enter date range for note ENTRY into system, not date of service.",! new %DT set %DT="AEP" set %DT("A")="Enter starting date (^ to abort): " do ^%DT if Y=-1 do goto ADRDone . write "Invalid date. Aborting report.",! set Options("START")=Y set %DT("A")="Enter ending date (^ to abort): " do ^%DT if Y=-1 do goto ADRDone . write "Invalid date. Aborting report.",! set Options("END")=Y new YN read !,"Show Details? YES// ",YN:$get(DTIME,3600) if YN="" set YN="Y" set Options("DETAILS")=($$UP^XLFSTR(YN)["Y") if YN="^" write "Aborting.",! goto ADRDone set %ZIS("A")="Enter output printer or device (^ to abort): " do ^%ZIS if POP do goto ADRDone . write !,"Error selecting output printer or device. Aborting report.",! use IO do RPTQUIET(.Options) use IO(0) do ^%ZISC ADRDone quit RPTQUIET(OPTIONS) ;"SCOPE: PUBLIC ;"Purpose: To create a report on transcription productivity based on ;" options specified in OPTIONS. ;"Input: The following elements in OPTIONS should be defined ;" 0PTIONS("TRANS") ;"the IEN of the transcriptionst (IEN from file 200) ;" This term is to limit the search. If all transcriptionsts are ;" wanted, then don't define OPTIONS("TRANS") ;" If multiple transcriptionists need to be specified, use this format: ;" OPTIONS("TRANS")="*" ;" OPTIONS("TRANS",1)=IEN#1 ;" OPTIONS("TRANS",2)=IEN#2 ;" OPTIONS("TRANS",3)=IEN#3 ;" 0PTIONS("AUTHOR") ;"the IEN of the author (IEN from file 200) ;" This term is to limit the search. If all authors are ;" wanted, then don't define OPTIONS("AUTHOR") ;" If multiple authors need to be specified, use this format: ;" OPTIONS("AUTHOR")="*" ;" OPTIONS("AUTHOR",1)=IEN#1 ;" OPTIONS("AUTHOR",2)=IEN#2 ;" OPTIONS("AUTHOR",3)=IEN#3 ;" OPTIONS("START") ;"Earliest date of documents, in Fileman internal format ;" OPTIONS("END") ;"Latest date of documents, in Fileman internal format ;" OPTIONS("DETAILS") ;"if 1, then each document showed ;"Note: This will create a report by writing to the current device ;" If the user wants output to go to a DEVICE, then they should call ;" ^%ZIS prior to calling this function, and call ^%ZISC aftewards to close if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"RPTQUIET^TMGTRANS1") new index new TransIEN,AuthorIEN new TransArrayP set TransArrayP="OPTIONS(""TRANS"")" new AuthorArrayP set AuthorArrayP="OPTIONS(""AUTHOR"")" new ChrCt set ChrCt=0 new LineCt set LineCt=0 new StartDT,EndDT new CtAuthor ;"An array to subdivide lines to each doctor's account new CtTrans ;"An array to track transcriptionists lines and income new AuthorInitials,TransInitials new ShowDetails set ShowDetails=+$get(OPTIONS("DETAILS")) set StartDT=+$get(OPTIONS("START")) if (StartDT=0) do goto RQDone . write "No start date specified. Aborting.",! set EndDT=+$get(OPTIONS("END"))\1 ;" \1 removes time from date if (EndDT=0) do goto RQDone . write "No end date specified. Aborting.",! new CharsPerLine set CharsPerLine=+$piece($get(^TIU(8925.99,1,0)),"^",3) if CharsPerLine=0 set CharsPerLine=65 write !!," Visit;" write $$RJ^XLFSTR("Entry Date;",15) write $$RJ^XLFSTR("Lines@Rate=$Cost",23),"; " write "Trn; Ath; Sgn; Patient",! write "------------------------------------------------------------------------------",! set index=$order(^TIU(8925,0)) for do quit:(index="") . ;"write "." . if index="" quit . new k . use IO(0) read *k:0 use IO . if k=27 do quit . . set index="" . . write "Report aborted by ESC from user.",! . new tDate set tDate=$piece($get(^TIU(8925,index,12)),"^",1) . set tDate=tDate\1 ;"remove time from date . ;"set mC=mC+1 set tC=tC+1 if tC>100 write mC," " set tC=0 . if (tDate'EndDT) do . . set TransIEN=+$piece($get(^TIU(8925,index,13)),"^",2) ;"field 1302 . . ;"write "index=",index," " . . ;"write "TransIEN='" . . ;"write TransIEN,"'" . . if ($data(OPTIONS("TRANS"))=0)!($$InList^TMGMISC(TransIEN,TransArrayP)=1) do . . . set AuthorIEN=$piece($get(^TIU(8925,index,12)),"^",2) ;field 1202 . . . if ($data(OPTIONS("AUTHOR"))=0)!($$InList^TMGMISC(AuthorIEN,AuthorArrayP)=1) do . . . . new tCharCt,tLineCt,Date,DateS,Pt . . . . new VDate,VDateSi . . . . new pStatus . . . . new Status set Status="N" . . . . new Patient set Patient="" . . . . set tCharCt=+$piece($get(^TIU(8925,index,"TMG")),"^",2);"field 22711=char count . . . . set tLineCt=+$piece($get(^TIU(8925,index,0)),"^",10) ;"field .1 = line count . . . . set pStatus=$piece($get(^TIU(8925,index,0)),"^",5) ;"field .05 is status file pointer . . . . if +pStatus'=0 do . . . . . set Status=$piece($get(^TIU(8925.6,pStatus,0)),"^",2) ;"8925.6=TIU Status. field .02=symbol . . . . . if Status="c" set Status="Y" . . . . . else set Status="N" . . . . if (tLineCt=0)!(tCharCt=0) do . . . . . if (tLineCt=0)&(tCharCt'=0) do . . . . . . set tLineCt=(((tCharCt/CharsPerLine)*10)\1)/10 . . . . . else if (tCharCt=0)&(tLineCt'=0) do . . . . . . set tCharCt=tLineCt*CharsPerLine . . . . . else do . . . . . . set tLineCt=$$DocLines^TMGMISC(index,.tCharCt) . . . . . . if tLineCt=0 set tLineCt=(((tCharCt/CharsPerLine)*10)\1)/10 . . . . . set tLineCt=$$Round^TMGMISC(tLineCt) . . . . . set tCharCt=$$Round^TMGMISC(tCharCt) . . . . . ;"Store values, so next time we won't have to calculate it. . . . . . set $piece(^TIU(8925,index,0),"^",10)=+tLineCt ;"field .1 = line count . . . . . set $piece(^TIU(8925,index,"TMG"),"^",2)=tCharCt ;"field 22711 = char count . . . . set Date=$piece($get(^TIU(8925,index,12)),"^",1) ;"field 1201 = Entry Date . . . . ;"set DateS=$$FMTE^XLFDT(Date,"D") . . . . set DateS=$$DTFormat^TMGMISC(Date,"ww mm/dd/yy") . . . . set VDate=$piece($get(^TIU(8925,index,13)),"^",1) ;"field 1301=Ref/Visit Date . . . . ;"set VDateS=$$FMTE^XLFDT(VDate,"D") . . . . set VDateS=$$DTFormat^TMGMISC(VDate,"mm/dd/yy") . . . . set AuthorInitials=$piece($get(^VA(200,AuthorIEN,0)),"^",2) . . . . set TransInitials=$piece($get(^VA(200,TransIEN,0)),"^",2) ;"field 1 = initials . . . . set CtAuthor(AuthorIEN,"LINES")=$get(CtAuthor(AuthorIEN,"LINES"))+tLineCt . . . . set CtAuthor(AuthorIEN,"NOTES")=+$get(CtAuthor(AuthorIEN,"NOTES"))+1 . . . . set CtTrans(TransIEN,"LINES")=$get(CtTrans(TransIEN,"LINES"))+tLineCt . . . . set CtTrans(TransIEN,"NOTES")=+$get(CtTrans(TransIEN,"NOTES"))+1 . . . . set Pt=+$piece($get(^TIU(8925,index,0)),"^",2) ;"field .02 = patient . . . . if Pt'=0 set Patient=$piece($get(^DPT(Pt,0)),"^",1) ;"field .01 = name . . . . new NoteBonus set NoteBonus=0 . . . . new PayRate set PayRate=$$PayRate(TransIEN,Date,.NoteBonus) . . . . ;"new LineCost set LineCost=$$RoundDn^TMGMISC(tLineCt*PayRate) . . . . ;"new LineCost set LineCost=(tLineCt*PayRate) . . . . new LineCost set LineCost=(tLineCt*PayRate)+NoteBonus . . . . set CtAuthor(AuthorIEN,"COST")=+$get(CtAuthor(AuthorIEN,"COST"))+LineCost . . . . set CtAuthor(AuthorIEN,"BONUS")=+$get(CtAuthor(AuthorIEN,"BONUS"))+NoteBonus . . . . set CtTrans(TransIEN,"COST")=+$get(CtTrans(TransIEN,"COST"))+LineCost . . . . set CtTrans(TransIEN,"BONUS")=+$get(CtTrans(TransIEN,"BONUS"))+NoteBonus . . . . if ShowDetails do . . . . . write VDateS,"; " . . . . . write $$RJ^XLFSTR(DateS,13),";" . . . . . new tS set tS=tLineCt_" @"_PayRate . . . . . if NoteBonus>0 set tS=tS_")+"_NoteBonus . . . . . write $$RJ^XLFSTR(.tS,15) . . . . . set tS=" =$"_LineCost_"; " . . . . . write $$RJ^XLFSTR(.tS,10) . . . . . write TransInitials,"; ",AuthorInitials,"; " . . . . . write " ",Status,"; " . . . . . write $$Clip^TMGSTUTL(Patient,15),! . . . . set LineCt=LineCt+tLineCt . set index=+$order(^TIU(8925,index)) . if index=0 set index="" write !,"Transcriptionist breakdown",! write "-----------------------------",! set index=$order(CtTrans("")) for do quit:(index="") . new TransS,Lines,Notes . if index="" quit . set TransS=$piece($get(^VA(200,index,0)),"^",1) . if TransS="" set TransS="(Unknown Transcriptionist)" . set Lines=+$get(CtTrans(index,"LINES")) . set Notes=+$get(CtTrans(index,"NOTES")) . write " ",TransS,": ",Lines," lines in ",Notes," notes." . write " $",$get(CtTrans(index,"COST")) . write " (income)",! . if +$get(CtTrans(index,"BONUS"))>0 do . . new c set c=+$get(CtTrans(index,"COST")) . . new b set b=$get(CtTrans(index,"BONUS")) . . write ?15,"$",c," = $",(c-b)," + $",b," per-note bonus.",! . set index=$order(CtTrans(index)) write !,"Author breakdown",! write "--------------------",! set index=$order(CtAuthor("")) for do quit:(index="") . new AuthorS,Lines,Notes . if index="" quit . set AuthorS=$piece($get(^VA(200,index,0)),"^",1) . if AuthorS="" set AuthorS="(Unknown Author)" . set Lines=+$get(CtAuthor(index,"LINES")) . set Notes=+$get(CtAuthor(index,"NOTES")) . write " ",AuthorS,": ",Lines," lines in ",Notes," notes." . write " $",$get(CtAuthor(index,"COST"))," (expense)",! . if +$get(CtAuthor(index,"BONUS"))>0 do . . new c set c=+$get(CtAuthor(index,"COST")) . . new b set b=$get(CtAuthor(index,"BONUS")) . . write ?15,"$",c," = $",(c-b)," + $",b," per-note bonus.",! . set index=$order(CtAuthor(index)) write !!,"Done.",! RQDone if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"RPTQUIET^TMGTRANS1") quit PayRateE(TransIEN,Date) ;"Purpose: To provide a 'shell' for PayRate below, except external ;" format of date alowed new IDate set X=$get(Date) ;"set IDate= ;"COMPLETE FUNCTION LATER... quit PayRate(TransIEN,Date,NoteBonus) ;"Purpose: Get payrate in effect at time of Date ;"Input: TransIEN -- the record number in file 200 ;" Date: reference date to lookup, ** in internal fileman format ** ;" NoteBonus -- [OPTIONAL] This is an out parameter. See below. ;"Result: The payrate found in file TMG TRANSCRIPTION PAYRATE file ;" This is dollars/line ;" If NoteBonus was passed by reference, then the value of the ;" NOTE BONUS field (field #3) is returned, or 0 if not found. ;" Note: a result of 0 is returned if TransIEN not found, or ;" no date range covers Date new result set result=0 new bonusresult set bonusresult=0 new RateIEN new index if (+$get(TransIEN)=0)!(+$get(Date)=0) goto PRDone set Date=Date\1 set RateIEN=+$order(^TMG(22704,"B",TransIEN,"")) if RateIEN=0 goto PRDone merge PayRates=^TMG(22704,RateIEN,1) set index=$order(^TMG(22704,RateIEN,1,0)) for do quit:(index="") . if index="" quit . new Rate set Rate=$get(^TMG(22704,RateIEN,1,index,0)) . if Rate'="" do . . new StartDate,EndDate . . set StartDate=$piece(Rate,"^",2) . . set EndDate=$piece(Rate,"^",3) . . if DateEndDate) do quit . . . ;"write "Date=",Date," EndDate=",EndDate,! . . set result=$piece(Rate,"^",1) . . set bonusresult=$piece(Rate,"^",4) ;"field#3 (NOTE BONUS) . if result'=0 set index="" quit . set index=$order(^TMG(22704,RateIEN,1,index)) if result=0 do . ;"write !,"TransIEN=",TransIEN," Date=",Date,! PRDone set NoteBonus=bonusresult quit result ;"======================================================================= FREECUR ;"Purpose: For current user, cycle through all alerts regarding ;" documents needing to be signed, and automatically sign ;" them, then print if user wants. ;"Input: none. User will be asked for signature password, ;" and if they want documents printed. ;"Output: Produces a report to chosen output channel. ;"write @IOF write !!,"-- RELEASE UNSIGNED DOCUMENTS -- ",!! write "Releasing transcription for: ",$piece($get(^VA(200,DUZ,0)),"^",1),!! do FreeDocs(DUZ,1) write !,"Goodbye.",! quit FREEASK ;"Purpose: Ask for chosen user, then cycle through all alerts ;" regarding documents needing to be signed, and automatically ;" sign them, then print if user wants. ;"Input: none. User will be asked for signature password, ;" and if they want documents printed. ;"Output: Produces a report to choses output channel. new Y,DIC,TransIEN,DocIEN set TransIEN=-1 ;"write @IOF write !!,"-- RELEASE UNSIGNED DOCUMENTS -- ",!! set DIC=200 ;"NEW PERSON file set DIC(0)="MAQE" set DIC("A")="Enter name of author (^ to abort): " do ^DIC if +Y'>0 do goto RADone . write !,"No author selected. Aborting report.",! set DocIEN=+Y write !!,"OPTIONAL-- Enter name of transcriptionist to screen for. If specified, ",! write "only notes entered by this transcriptionist will be signed and released." set DIC("A")="Enter name of transcriptionist (ENTER or ^ to skip): " do ^DIC write !! if +Y'>0 set TransIEN=+Y do FreeDocs(DocIEN,1,TransIEN) write !,"Goodbye.",! FADone quit FreeDocs(AuthorIEN,ShowDetails,TransIEN) ;"Purpose: to finish the interactive release documents process. ;" This separate entry point allows restriction of the author ;" whose's documents are to be released. ;"Input: AuthorIEN, the record number of the author in file 200 ;" ShowDetails: optional. Default is to show details (1) ;" 0=don't show, 1=show ;" TransIEN: OPTIONAL -- the IEN of the transcriptionist. ;" IF specified, then ONLY those notes created by this ;" transcriptionist will be finished/released new Signed new abort set abort=0 new Options new PrintAfter new YN new SignAll set Options("AUTHOR")=+$get(AuthorIEN) set Options("SIG")=0 set Options("DETAILS")=$get(ShowDetails,1) if +$get(TransIEN)>0 set Options("TRANS")=+TransIEN do . write "Enter 'your' (meaning author's) signature code below." . new DUZ . set DUZ=+$get(AuthorIEN) . if DUZ=0 quit . do SIG^XUSESIG . write ! . if X1'="" set Options("SIG")=1 if Options("SIG")'=1 do goto FADDone . write "Signature code incorrect. Aborting.",! read "Sign all notes at once (^/Y/N): YES// ",SignAll:$get(DTIME,3600),! if SignAll="" set SignAll="Y" if SignAll="^" write "Aborting.",! goto ADRDone set Options("SIGN ALL")=($$UP^XLFSTR(SignAll)["Y") write !,"Print Notes after signing? (^/Y/N): YES// " read YN:$get(DTIME,3600),! if YN="^" write "Aborting.",! goto ADRDone if YN="" set YN="Y" set PrintAfter=($$UP^XLFSTR(YN)["Y") do AlertSign(.Options,.Signed) write "Now look at ALL documents to find any unsigned ones.",! set Options("START")="0001111" do NOW^%DTC set Options("END")=X do ScanSign(.Options,.Signed) merge ^TMG("BATCH SIGNED DOCS",$J)=Signed if PrintAfter do PRINT(.Signed) FADDone quit ScanSign(OPTIONS,SIGNED) ;"Purpose: To scan through all TIU DOCUMENTS, and release those ;" that have a status of unsigned to completed ;"Input: The following elements in OPTIONS should be defined ;" 0PTIONS("AUTHOR") ;"the IEN of the user (IEN from file 200) ;" OPTIONS("START") ;"Earliest date of documents, in Fileman internal format ;" ;"Note if not specified, then all dates are matched ;" OPTIONS("END") ;"Latest date of documents, in Fileman internal format ;" ;"Note if not specified, then all dates are matched ;" OPTIONS("DETAILS") ;"if 1, then each document is shown as signed (not quiet) ;" OPTIONS("SIG") ;"1 if signature has been verified. ;" -----------Optional OPTIONS below--------------- ;" OPTIONS("TRANS") ;"the IEN of note. If specified, then note will not be signed ;" ;"unless the transcriptionist (i.e. ENTERED BY field) = this IEN ;" ------------------------------------------------------- ;" SIGNED: OPTIONAL. This is an OUT PARAMETER -- must be passed by reference ;" This will contain list of documents freed/signed, in this format: ;" SIGNED(1234)=1234 with 1234 being IEN of document signed. ;" SIGNED(1235)=1235 with 1235 being IEN of document signed. ;" SIGNED(1236)=1236 with 1235 being IEN of document signed. new index new DocAuth,Status,EnteredBy new User,initials new NeedsCR set NeedsCR=1 new StartDT,EndDT new ShowDetails set ShowDetails=+$get(OPTIONS("DETAILS")) if +$get(OPTIONS("START"))=0 do . new %DT . set %DT="AEP" . set %DT("A")="Enter starting date (^ to abort): " . do ^%DT . set OPTIONS("START")=Y if $get(OPTIONS("START"))'>0 do goto SSDone . if ShowDetails write "START date invalid. Aborting.",! if +$get(OPTIONS("END"))=0 do . set %DT("A")="Enter ending date (^ to abort): " . do ^%DT . set OPTIONS("END")=Y if $get(OPTIONS("END"))'>0 do goto SSDone . if ShowDetails write "END date invalid. Aborting.",! set User=+$get(OPTIONS("AUTHOR")) if User=0 do goto RQDone . if $get(OPTIONS("DETAILS")) write "No author IEN supplied. Aborting.",! set StartDT=+$get(OPTIONS("START")) set EndDT=+$get(OPTIONS("END")) if $get(OPTIONS("DETAILS")) do . write !,"------------------------------------------------",! . write "Starting scan of all documents. [ESC] will abort.",! . write "------------------------------------------------",! set initials=$piece($get(^VA(200,User,0)),"^",2) ;"field 1 = initials new sUnsigned set sUnsigned=$order(^TIU(8925.6,"B","UNSIGNED","")) new sUnverified set sUnverified=$order(^TIU(8925.6,"B","UNVERIFIED","")) set index=$order(^TIU(8925,0)) for do quit:(index="") . if index="" quit . new k read *k:0 . if k=27 do quit . . set index="" . . if $get(OPTIONS("DETAILS")) write "Release aborted by ESC from user.",! . set DocAuth=$piece($get(^TIU(8925,index,12)),"^",2) ;"field 1202 = Author . set EnteredBy=$piece($get(^TIU(8925,index,13)),"^",2) ;"field 1302 = Entered By . if (DocAuth=$get(OPTIONS("AUTHOR"))) do . . if $data(OPTIONS("TRANS"))&($get(OPTIONS("TRANS"))'=EnteredBy) quit . . set Status=$piece($get(^TIU(8925,index,0)),"^",5) ;"field .05 = Status . . if (Status=sUnsigned)!(Status=sUnverified) do ;"*** What else should go here?!! . . . new tDate . . . set tDate=$piece($get(^TIU(8925,index,12)),"^",1) . . . set tDate=tDate\1 ;"integer round down (removes time decimal amount) . . . if (StartDT=0)!(EndDT=0)!((tDate'EndDT)) do . . . . if $$SIGNDOC(index,.OPTIONS) do . . . . . set SIGNED(index)=index . set index=+$order(^TIU(8925,index)) . if index=0 set index="" SSDone if $get(OPTIONS("DETAILS")) write !,"Done scanning all documents.",! quit AlertSign(OPTIONS,SIGNED) ;"Purpose: To cycle through all alerts for AUTHOR, and release TIU DOCUMENTS ;" needing signature. ;"Input: The following elements in OPTIONS should be defined ;" 0PTIONS("AUTHOR") ;"the IEN of the user (IEN from file 200) ;" OPTIONS("DETAILS") ;"if 1, then each document is shown as signed (not quiet) ;" OPTIONS("SIG") ;"1 if signature has been verified. ;" OPTIONS("SIGN ALL");"if 1, then all are signed without asking each one. ;" SIGNED: OPTIONAL. This is an OUT PARAMETER -- must be passed by reference ;" This will contain list of documents freed/signed, in this format: ;" SIGNED(1234)=1234 with 1234 being IEN of document signed. ;" SIGNED(1235)=1235 with 1235 being IEN of document signed. ;" SIGNED(1236)=1236 with 1235 being IEN of document signed. new index new Abort set Abort=0 new Alert new DocIEN new NumFound set NumFound=0 new SignAll set SignAll=+$get(OPTIONS("SIGN ALL")) set User=+$get(OPTIONS("AUTHOR")) if User=0 do goto RQDone . if $get(OPTIONS("DETAILS")) write "No author IEN supplied. Aborting.",! if $get(OPTIONS("DETAILS")) do . write !,"-------------------------------------------------------",! . write "Search for 'signature-needed' alerts. [ESC] will abort.",! . write "-------------------------------------------------------",! if SignAll'=1 do if NumFound=0 goto ASgn2 . write !!,"-------- List of Documents to be Signed --------",! . set index=$order(^XTV(8992,User,"XQA",0)) . for do quit:(index="") . . if index="" quit . . new k read *k:0 . . if k=27 do quit . . . set index="" . . . if $get(OPTIONS("DETAILS")) write "List aborted by ESC from user.",! . . set Alert=$get(^XTV(8992,User,"XQA",index,0)) . . if $piece(Alert,"^",3)["available for SIGNATURE" do . . . write $piece(Alert,"^",3),! . . . set NumFound=NumFound+1 . . set index=$order(^XTV(8992,User,"XQA",index)) . write "-----------------------------------------------",! . write !,NumFound," documents needing signature.",!! . if NumFound=0 do quit . . write "No alerts for a missing signature found.!",! ;"WRITE "STARTING SIGN LOOP",! set NumFound=0 set index=$order(^XTV(8992,User,"XQA",0)) for do quit:(index="")!(Abort=1) . new Title,YN . if index="" quit . set Alert=$get(^XTV(8992,User,"XQA",index,0)) . set Title=$piece(Alert,"^",3) . if Title["available for SIGNATURE" do . . set NumFound=NumFound+1 . . if SignAll'=1 do . . . write "Sign: ",$piece(Title," ",1),"? (Y/N/ALL): ALL// " . . . read YN:$get(DTIME,3600),! . . . set YN=$$UP^XLFSTR(YN) . . else set YN="Y" . . if YN="" set YN="ALL" write "ALL",! . . if YN="ALL" set SignAll=1 set YN="Y" . . else if YN["^" write !,"Aborting.",! set Abort=1 quit . . if YN["Y" do . . . set DocIEN=+$get(^XTV(8992,User,"XQA",index,1)) . . . if DocIEN'=0 do . . . . if $$SIGNDOC(DocIEN,.OPTIONS) do . . . . . set SIGNED(DocIEN)=DocIEN . set index=$order(^XTV(8992,User,"XQA",index)) if $get(OPTIONS("DETAILS")) do . write !!,"Done searching for 'needed-signature' alerts.",! ASgn2 if (1=0) do ;"if (NumFound=0) do . if $get(OPTIONS("DETAILS")) do . . write "No alert indicating a signature is needed was found....",! . . write "...So starting a scan of all documents to look for unsigned documents.",! . set OPTIONS("START")="0001111" . do NOW^%DTC . set OPTIONS("END")=X . do ScanSign(.OPTIONS,.Signed) ASgnDone quit SIGNDOC(DocIEN,OPTIONS) ;"Purpose: To sign one document ;"Input: DocIEN -- the record number of the document to sign ;" OPTIONS -- An array with input values. The following are used: ;" 0PTIONS("AUTHOR") ;"the IEN of the user (IEN from file 200) ;" OPTIONS("DETAILS") ;"if 1, then each document showed ;" OPTIONS("SIG") ;"1 if signature has been verified. ;"Results: 1 = successful sign. 0 = failure new result set result=0 ;"default to failure new Node0 new sCompleted set sCompleted=$order(^TIU(8925.6,"B","COMPLETED","")) new NewStatus if $get(OPTIONS("SIG"))'=1 goto SDCDone if +$get(OPTIONS("AUTHOR"))'>0 goto SDCDone if $get(DocIEN)="" goto SDCDone new SignerS set SignerS=1_"^"_$piece($get(^VA(200,+OPTIONS("AUTHOR"),20)),"^",2,3) if $data(^TIU(8925,DocIEN,0))=0 do goto SDCDone . write "Unable to sign document #",DocIEN," because it doesn't seem to exist.",! do ES^TIURS(DocIEN,SignerS) ;"Note: alert(s) r.e. "Note available for signature" are automatically removed SDLoop set Node0=$get(^TIU(8925,DocIEN,0)) set NewStatus=$piece(Node0,"^",5) ;"field .05 = Status new Date,DateS,Pt set Date=$piece(Node0,"^",7) ;"field .07 = Episode begin date/time set DateS=$$FMTE^XLFDT(Date,"D") set Pt=+$piece(Node0,"^",2) ;"field .02 = patient if Pt'=0 set Patient=$piece($get(^DPT(Pt,0)),"^",1) ;"field .01 = name if OPTIONS("DETAILS")=1 do . write DateS," -- ",Patient if NewStatus'=sCompleted do goto SDLoop . if OPTIONS("DETAILS")=1 do . . new s . . set s=$piece($get(^TIU(8925.6,NewStatus,0)),"^",1) . . write " NOT completed. Status=",s . . write !," TRYING AGAIN. (utilizing a lower-level signature method.)",! . . set $piece(^TIU(8925,DocIEN,0),"^",5)=sCompleted if OPTIONS("DETAILS")=1 do . write " Released (auto-'signed')",! set result=1 ;"success SDCDone quit result PRINT(DocArray) ; Prompt and print, or array ;"This function was copied from PRINT^TIUEPRNT, to allow modification ;"Function modification: changed to allow array input. ;" DocArray: This will contain list of documents to print, in this format: ;" DocArray(1234)=1234 with 1234 being IEN of document to be printed. ;" DocArray(1235)=1235 with 1235 being IEN of document to be printed. ;" DocArray(1236)=1236 with 1235 being IEN of document to be printed. ;" Note: Is appears that DocArray(IEN)="" is the needed format. New TIUDEV,TIUTYP,DFN,TIUPMTHD,TIUD0,TIUMSG,TIUPR,TIUDARR,TIUDPRM new TIUFLAG set TIUFLAG="x" New TIUPGRP,TIUPFHDR,TIUPFNBR new index set index=$order(DocArray("")) if index="" goto PRINT1X for do quit:(index="") . set DocIEN=index . ; . If +$$ISADDNDM^TIULC1(DocIEN) Set DocIEN=$Piece($Get(^TIU(8925,+DocIEN,0)),U,6) . If $Get(^TIU(8925,DocIEN,21)) Set DocIEN=^TIU(8925,DocIEN,21) . Set TIUD0=$Get(^TIU(8925,DocIEN,0)) . Set TIUTYP=$Piece(TIUD0,U) . Set DFN=$Piece(TIUD0,U,2) . If +TIUTYP'>0 Quit . ; . Set TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP) . Set TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP) . Set TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP) . Set TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP) . ; . Do DOCPRM^TIULC1(+TIUTYP,.TIUDPRM,DocIEN) . ; . If +$Piece($Get(TIUDPRM(0)),U,9) do . . if TIUFLAG="x" Set TIUFLAG=$$FLAG^TIUPRPN3 ;"Asks Chart vs. Work Copy? only ONCE . If ($Get(TIUPMTHD)]"")&(+$Get(TIUPGRP))&($Get(TIUPFHDR)]"")&($Get(TIUPFNBR)]"") do . . Set TIUDARR(TIUPMTHD,$Get(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,1,DocIEN)=TIUPFNBR . Else Set TIUDARR(TIUPMTHD,DFN,1,DocIEN)="" . ; . If $Get(TIUPMTHD)']"" do ;"Goto PRINT1X . . if OPTIONS("DETAILS")=1 do . . . Write !,$Char(7),"No Print Method Defined for " . . . write $Piece($Get(^TIU(8925.1,+TIUTYP,0)),U) . . ;"Hang 2 . ; . set index=$order(DocArray(index)) Set TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device/allow queueing If ($Get(IO)']"")!(TIUDEV']"") Do ^%ZISC Quit If $Data(IO("Q")) Do QUE^TIUDEV("PRINTQ^TIUEPRNT",TIUDEV) Goto PRINT1X Do PRINTQ^TIUEPRNT Do ^%ZISC PRINT1X ; Exit single document print Quit SHOWUNSIGNED ;"Purpose: to scan through all documents and show any that are unsigned new index new DocAuth,Status,Patient,PtName new TransIEN,TransInit new User,initials,AuthName new NeedsCR set NeedsCR=1 new StartDT,EndDT write !,"----------------------------------------------",! write "Starting scan of documents. [ESC] will abort.",! write "----------------------------------------------",! new sUnsigned set sUnsigned=$order(^TIU(8925.6,"B","UNSIGNED","")) new sCompleted set sCompleted=$order(^TIU(8925.6,"B","COMPLETED","")) set index=$order(^TIU(8925,0)) for do quit:(index="") . if index="" quit . new k read *k:0 . if k=27 do quit . . set index="" . . if $get(OPTIONS("DETAILS")) write "Scan aborted by ESC from user.",! . set Status=$piece($get(^TIU(8925,index,0)),"^",5) ;"field .05 = Status . if (Status'=sCompleted) do . . ;"write ! . . new tDate . . set tDate=$piece($get(^TIU(8925,index,12)),"^",1) . . set DocAuth=$piece($get(^TIU(8925,index,12)),"^",2) ;"field 1202 = Author . . set initials=$piece($get(^VA(200,DocAuth,0)),"^",2) ;"field .02 = initials . . set AuthName=$piece($get(^VA(200,DocAuth,0)),"^",1) ;"field .01 = Name . . set Patient=$piece($get(^TIU(8925,index,0)),"^",2) ;"field .02 = patient IEN . . set TransIEN=$piece($get(^TIU(8925,index,13)),"^",2) ;"field 1302 = Entered by IEN . . if +TransIEN'=0 set TransInit=$piece($get(^VA(200,TransIEN,0)),"^",2) ;" field .02 = initials . . else set TransInit="???" . . if +Patient'=0 set PtName=$piece($get(^DPT(Patient,0)),"^",1) ;"field .01 is patient name . . else set Patient="Name Unknown(?)" . . set DateS=$$DTFormat^TMGMISC(tDate,"ww mm/dd/yy") . . write "NOT COMPLETED. " . . write $$RJ^XLFSTR(AuthName_"; ",20) . . write $$RJ^XLFSTR(DateS_"; ",15) . . write $$RJ^XLFSTR(TransInit_"; ",5) . . write $$Clip^TMGSTUTL(PtName,20),! . ;"else write "." . set index=+$order(^TIU(8925,index)) . if index=0 set index="" write !,"Done scanning documents.",! quit PWDSNOOP(IEN) ;"Purpose: To show private info for a given user ;"NOTICE: This function MUST be used responsibly ;"Input: IEN -- [OPTIONAL] the record number of the user to snoop on write !!,"------------------------------------------------------------------",! write "Notice: This function will unmask private password codes.",! write "These codes can be used spoof this EMR system. Note",! write "that impersonating another user can be a CRIME.",!,! if $data(IEN) goto IS2 set DIC=200 ;"NEW PERSON file set DIC(0)="MAQE" set DIC("A")="Enter name of user to unmask codes for (^ to abort): " do ^DIC if +Y=-1 do goto ISPDone . write !,"No user selected. Aborting report.",! write !,! set IEN=+Y IS2 new VerHash,AccHash,ESig if '$data(IEN) goto ISPDone set VerHash=$piece($get(^VA(200,IEN,.1)),"^",2) set AccHash=$piece($get(^VA(200,IEN,0)),"^",3) set ESig=$piece($get(^VA(200,IEN,20)),"^",4) write "Access Code=",$$UN^XUSHSH(AccHash),! write "Verify Code=",$$UN^XUSHSH(VerHash),! write "Electronic Signature=",ESig,!! write "Remember, you are morally, ethically, and LEGALLY required to use",! write "this information only in an appropriate manner.",! write "------------------------------------------------------------------",! write "Goodbye.",!! ISPDone quit