Batch Signing of Documents

Back to Programming VistA Issues

This will allow batch signing and printing of documents.

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)

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 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.",!     do FreeDocs(+Y) FADone	quit

FreeDocs(AuthorIEN,ShowDetails) ;"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

new Signed new abort set abort=0 new Options set Options("AUTHOR")=+$get(AuthorIEN) set Options("SIG")=0 set Options("DETAILS")=$get(ShowDetails,1) do     . new DUZ . set DUZ=+$get(AuthorIEN) . if DUZ=0 quit . do SIG^XUSESIG . if X1'="" set Options("SIG")=1 if Options("SIG")'=1 do goto FADDone . write "Signature code incorrect. Aborting.",!

do AlertSign(.Options,.Signed) do PRINT(.Signed)

FADDone 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.	;"	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

set User=+$get(OPTIONS("AUTHOR")) if User=0 do goto RQDone . if $get(OPTIONS("DETAILS")) write "No author IEN supplied. Aborting.",! 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 goto ASgnDone . write "Good bye!",! 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       .. write "Sign: ",$piece(Title," ",1),"? YES// " . . read YN:$get(DTIME,3600) . . if YN="" set YN="Y" write "YES",! . . if YN["^" write "Aborting.",! set Abort=1 quit . . if ($$UP^XLFSTR(YN)["Y") do       .. . set DocIEN=+$get(^XTV(8992,User,"XQA",index,1)) . . . if DocIEN'=0 do       .. . . ;"write "Would call SIGNDOC(",DocIEN,",.OPTIONS)",!       . . . . if $$SIGNDOC(DocIEN,.OPTIONS) do	. . . . . set SIGNED(DocIEN)=DocIEN	. set index=$order(^XTV(8992,User,"XQA",index))

if $get(OPTIONS("DETAILS")) write !!,"Done signing documents.",! 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=1 ;"default to failure

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) do ES^TIURS(DocIEN,SignerS) ;"Note: alert r.e. "Note available for signature" are automatically removed

if OPTIONS("DETAILS")=1 do	. new Date,DateS,Pt . set Date=$piece($get(^TIU(8925,DocIEN,12)),"^",1)       ;"field 1201 = Entry Date	. set DateS=$$FMTE^XLFDT(Date,"D")	. set Pt=+$piece($get(^TIU(8925,DocIEN,0)),"^",2)          ;"field .02 = patient . if Pt'=0 set Patient=$piece($get(^DPT(Pt,0)),"^",1)    ;"field .01 = name      . write DateS," -- ",Patient," 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.

New TIUDEV,TIUTYP,DFN,TIUPMTHD,TIUD0,TIUMSG,TIUPR,TIUDARR,TIUFLAG,TIUDPRM 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) Set TIUFLAG=$$FLAG^TIUPRPN3 . 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