TIUASCU ; NA/AJB - ADDITIONAL SIGNER CLEANUP 2.0;11/08/23 10:30
;;1.0;TEXT INTEGRATION UTILITIES;**254,357**;Jun 20, 1997;Build 5
;
; Reference to $$GET1^DID supported by ICR #2052
; Reference to $$GET1^DIQ supported by ICR #2056
; Reference to $$DIV^XUSER supported by ICR #2533
; Reference to HOME^%ZIS supported by ICR #10086
; Reference to *^XGF supported by ICR #3173
; Reference to *^XLFDT supported by ICR #10103
; Reference to *^XLFSTR supported by ICR #10104
; Reference to ^%ZTLOAD supported by ICR #10063
; Reference to ^DIC supported by ICR #10006
; Reference to ^DIK supported by ICR #10013
; Reference to ^DIR supported by ICR #10026
; Reference to ^XMD supported by ICR #10070
; Reference to File ^DIC(49 supported by ICR #4330
; Reference to File ^DPT supported by ICR #10035
; Reference to File ^VA supported by ICR #10060
; Reference to EN^XUTMDEVQ supported by ICR #1519
; Reference to HASH^XUSHSHP supported by ICR #10045
; Reference to ^%ZOSF(*) supported by ICR #10096
; Reference to *^XGF supported by ICR #3173
;
Q
EN N C,DATE,EXIT,POP,X,Y S DT=$$DT^XLFDT,U="^"
D HOME^%ZIS,PREP^XGF G EXIT:$$CHK(.DATE)
D INTRO^TIUASCU1,IOXY^XGF(IOSL-1,0),ENTER
F D Q:EXIT
. S EXIT=$$CHK(.DATE) Q:EXIT D PREP^XGF
. N CNT,DIERR,DILOCKTM,DIR,DISYS,EXE,ROW,SCR
. S SCR("User")=$G(DUZ,0)_U_$$GET1^DIQ(200,$G(DUZ)_",",.01)
. F X=0:1 S Y=$P($T(MENU+X),";;",2) Q:Y="" D
. . I X=0 W IOUON_$$CJ^XLFSTR(Y,IOM)_IOUOFF,! Q
. . I (Y["VIEW"&('+$O(^XTMP("TIUASCU",0))))!(Y'["VIEW"&('DATE("Start"))) Q
. . S CNT=+$G(CNT)+1,EXE(CNT)=Y,$P(DIR,";",CNT)=CNT_":"_$P(Y,U)
. . W !,?22,CNT_" "_$P(Y,U)
. S CNT=CNT+1,EXE(CNT)="QUIT^S EXIT=1",$P(DIR,";",CNT)=CNT_":"_"QUIT" W !,?22,CNT_" QUIT"
. N DEFAULT S DEFAULT=$P($P($P(DIR,";"),"1:",2)," ")
. S DIR="SAO^"_DIR W !,IOCUON S X=$$DIR^TIUASCU1(.DIR,"What would you like to do? ",DEFAULT) S:'X EXIT=1 Q:EXIT S SCR("Action")=$P(EXE(X),U)
. W ! X $TR($P(EXE(X),U,2),":",U) Q:'Y!(EXIT) D CLS
. ; check criteria, if none entered quit
. N I,J S I=0 F J=4,49,200,8925.6,"Start","End","Terminated","DISUSER'd" S I=I+$G(SCR(J)) S:'$G(SCR(J)) SCR(J)=""
. Q:'I I SCR("Start")="" S SCR("Start")=DATE("Start")_U_$$FMTE^XLFDT(DATE("Start")),SCR("End")=$$FMADD^XLFDT(DATE("End"),-30)+.24_U_$$FMTE^XLFDT($$FMADD^XLFDT(DATE("End"),-30))
. S ROW=0 D IOXY^XGF(ROW,0),SAY^XGF(ROW,0,"Preparing a task to "_$S(EXE(X)'["BOTH":$P(EXE(X),U),1:$TR($P($P(EXE(X),U),"[",2),"]",""))_":","U1")
. S ROW=ROW+1 D SAY^XGF(ROW,2,"Documents from "_$P(SCR("Start"),U,2)_" to "_$P(SCR("End"),U,2)_".")
. I SCR(8925.6) S ROW=ROW+1 D SAY^XGF(ROW,2,"Document STATUS must be "_$P(SCR(8925.6),U,2)_".")
. I SCR(200) S ROW=ROW+1 D SAY^XGF(ROW,2,$P(SCR(200),U,2)_" must be the additional signer.")
. I SCR("Terminated") S ROW=ROW+1 D SAY^XGF(ROW,2,"Additional Signers must be terminated as of "_$$FMTE^XLFDT(DT)_".")
. I SCR("DISUSER'd") S ROW=ROW+1 D SAY^XGF(ROW,2,"Additional Signers must be DISUSER'd.")
. N ERR,MSG,TIUFT F X=49,4 D
. . S MSG="" S:SCR(X) MSG="Additional Signers must be assigned to the "_$P(SCR(X),U,2)_" ["_$S(X=4:"DIVISION",X=49:"SERVICE/SECTION")_"]."
. . K TIUFT D:MSG'="" WRAP^TIUFLD(MSG,IOM-2) S TIUFT=0 F S TIUFT=$O(TIUFT(TIUFT)) Q:'TIUFT S ROW=ROW+1 D SAY^XGF(ROW,$S(TIUFT>1:4,1:2),TIUFT(TIUFT))
. I +SCR(200) D Q:$D(ERR) ; verify search criteria for the additional signer
. . N DIV,NODE,SRV S DIV=$$DIV4^XUSER(.DIV,+SCR(200)),SRV=$P($G(^VA(200,+SCR(200),5)),U) S:SRV $P(SRV,U,2)=$P($G(^DIC(49,SRV,0)),U)
. . S NODE=$G(^VA(200,+SCR(200),0))
. . I +SCR(4),'$D(DIV(+SCR(4))) S ERR(4)="Divison(s):"
. . I +SCR(49),+SCR(49)'=+SRV S ERR(49)="Service/Section: "_$P(SRV,U,2)
. . I +SCR("DISUSER'd"),'$P(NODE,U,7) S ERR("D")="Status: ACTIVE"
. . I +SCR("Terminated"),'+$P(NODE,U,11) S ERR("T")="Termination Date: <none>"
. . I +SCR("Terminated"),+$P(NODE,U,11)>0,$P(NODE,U,11)>DT S ERR("T")="Termination Date: "_$$FMTE^XLFDT($P(NODE,U,11),"5Z")
. . I $D(ERR) D
. . . N EC,XGRT S EC=3 S ERR="" F S ERR=$O(ERR(ERR)) Q:ERR="" S EC=EC+1 I ERR=4 N X S X=0 F S X=$O(DIV(X)) Q:'X S:X'=$O(DIV(0)) EC=EC+1
. . . N DISP D WIN^XGF(ROW+1,10,ROW+EC+4,74,"DISP")
. . . D SAY^XGF(ROW+2,25,"*** Conflicting SEARCH CRITERIA ***")
. . . D SAY^XGF(ROW+4,11,"Additional Signer:"),SAY^XGF(ROW+4,30,$E($P(SCR(200),U,2),1,43))
. . . S ERR="" N TROW S TROW=ROW+4 F S ERR=$O(ERR(ERR),-1) Q:ERR="" D
. . . . S TROW=TROW+1 D SAY^XGF(TROW,11,ERR(ERR))
. . . . I ERR=4 N X S X=0 F S X=$O(DIV(X)) Q:'X D SAY^XGF(TROW,30,$$GET1^DIQ(4,X,.01)) S:$O(DIV(X)) TROW=TROW+1
. . . S TROW=TROW+2 D SAY^XGF(TROW,11,"No results possible. "),ENTER,RESTORE^XGF("DISP")
. I $P(SCR("Action")," ")'="GENERATE" D Q:X'>0
. . N DISP,X1 D WIN^XGF(ROW+1,10,ROW+13,70,"DISP")
. . D SAY^XGF(ROW+2,32," *** WARNING *** ","B1R1")
. . D SAY^XGF(ROW+4,11,"This action will PERMANENTLY REMOVE all pending additional")
. . D SAY^XGF(ROW+5,11,"signatures that match the criteria above.")
. . D SAY^XGF(ROW+7,11,"You must type YES to continue or ^ to Quit: ")
. . N NOW,XGRT S NOW=$H F S X=$$READ^XGF(4) Q:X="YES"!(X="^")!($$HDIFF^XLFDT($H,NOW,2)>$G(DTIME,60)) D SAY^XGF(,56," "),IOXY^XGF(,56)
. . S X=$S(X="YES":1,1:0) D:'X RESTORE^XGF("DISP") Q:'X D IOXY^XGF(ROW+9,0) S X=$$SIG^TIUASCU1(ROW+9,11)
. . D IOXY^XGF(ROW+11,11),ENTER,RESTORE^XGF("DISP")
. D IOXY^XGF(ROW+1,0)
. S X=$$DIR^TIUASCU1("YA","Start the task now? ","NO") Q:'X
. N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK S ZTDESC="Additional Signer Cleanup [TIU]",ZTDTH=+$H_","_($P($H,",",2)+3),ZTIO=""
. S X="" F S X=$O(SCR(X)) Q:X="" S ZTSAVE($NA(SCR(X)))=""
. S ZTRTN="TASK^TIUASCU(.SCR)" D ^%ZTLOAD W:+$G(ZTSK) !!,"Task #",$G(ZTSK) ; load/start the task
. ; D TASK(.SCR) ; for live testing
. D IOXY^XGF(IOSL-1,0),ENTER
EXIT D CLEAN^XGF
Q
CHK(DATE) ; check environment for outstanding signatures or reports to view, remove if needed
N EXIT,NODE S EXIT=0,NODE=$G(^XTMP("TIUASCU",0)) I +NODE,NODE'["v2" D Q:'EXIT 1
. D CLS,WARN S EXIT=$$DIR^TIUASCU1("YA","Remove the old reports now? ","NO") Q:'EXIT D CLEAN F Q:$Y+4>IOSL W !
. D DIR^TIUASCU1("EA","Press <Enter> to continue. "),CLS
S DATE("Start")=$P($O(^TIU(8925.7,"AC",0)),"."),DATE("End")=DT,EXIT=0
I '+DATE("Start"),'+$O(^XTMP("TIUASCU",0)) D
. S EXIT=1 W !,IOCUON,"No outstanding signatures or reports to view."
. D IOXY^XGF(IOSL-1,0),ENTER
Q EXIT
CLEAN ; remove reports generated with previous utility in ^XTMP("TIUASCU")
W !!,"Removing entries in ^XTMP..." K ^XTMP("TIUASCU") W "done.",!
Q
CUDON X ^%ZOSF("EON") Q ; keyboard output on
CUDOFF X ^%ZOSF("EOFF") Q ; keyboard output off
CUON W IOCUON Q ; cursor on
CUOFF W IOCUOFF Q ; cursor off
ENTER D CUDOFF,CUOFF,SAY^XGF(,,"<Press any key to continue.>") N NOW,X,XGRT S NOW=$H F S X=$$READ^XGF(1) D CUDON,CUON Q:$D(XGRT)!($$HDIFF^XLFDT($H,NOW,2)>$G(DTIME,60))
Q
TASK(SCR) ; create [remove] the report of outstanding additional signatures
N CNT,DATA,DATE,DE,DELIM,LOC,REM,QFLDS,X,Y S DATA="",DELIM=U,LOC=$S(SCR("Action")["REMOVE":"REM",1:$NA(^XTMP("TIUASCU")))
S @LOC@(0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"Additional Signer Report v2"
S LOC=$NA(@LOC@(($O(@LOC@(""),-1)+1))) K @LOC ; increment location & prep location
S @LOC@("Start Time")=$H,X=0 F S X=$O(SCR(X)) Q:X="" S @LOC@(X)=SCR(X)
F X=1:1 S Y=$P($T(DE+X),";;",2) Q:Y="" S $P(DATA,DELIM,X)=$$QM($P(Y,";"),1) D:$P(Y,";",3)
. S:+$G(QFLDS($P(Y,";",3))) QFLDS($P(Y,";",3))=QFLDS($P(Y,";",3))_U S $P(QFLDS($P(Y,";",3)),U,$L($G(QFLDS($P(Y,";",3))),U))=X ; set quoted field info
S CNT=0,@LOC@("zData",CNT)=$TR(DATA,U,","),$P(SCR("End"),U)=+SCR("End")_".9999"
S @LOC@("User")=$P(SCR("User"),U,2)_U_$P($$FMTE^XLFDT($$NOW^XLFDT,"2Z"),":",1,2)
S @LOC@("Action")=SCR("Action"),@LOC@("Start Date")=$P(SCR("Start"),U,2),@LOC@("Stop Date")=$P(SCR("End"),U,2)
S DATE("Entry DT")=+SCR("Start") F S DATE("Entry DT")=$O(^TIU(8925.7,"AC",DATE("Entry DT"))) Q:'DATE("Entry DT")!(DATE("Entry DT")>SCR("End")) D
. N TIUDA S TIUDA=0 F S TIUDA=$O(^TIU(8925.7,"AC",DATE("Entry DT"),TIUDA)) Q:'+TIUDA D
. . N IEN S IEN=0 F S IEN=$O(^TIU(8925.7,"AC",DATE("Entry DT"),TIUDA,IEN)) Q:'IEN D
. . . I '$D(^TIU(8925.7,IEN)) K ^TIU(8925.7,"AC",DATE("Entry DT"),TIUDA,IEN) Q
. . . N DATA,DIV,NODE,PT S DATA="",NODE(8925,0)=$G(^TIU(8925,TIUDA,0))
. . . S NODE(8925.7,0)=$G(^TIU(8925.7,IEN,0)) I '+$P(NODE(8925.7,0),U,3)!('$P(NODE(8925,0),U,2)) D Q ; if document deleted or missing expected signer, delete entry
. . . . N DA,DIK S DA=IEN,DIK="^TIU(8925.7," D ^DIK K ^TIU(8925.7,"AC",DATE("Entry DT"),TIUDA,IEN) D SEND^TIUALRT(TIUDA)
. . . Q:'NODE(8925.7,0)!(TIUDA'=+NODE(8925.7,0))
. . . S NODE(8925,12)=$G(^TIU(8925,TIUDA,12)),NODE(8925,13)=$G(^TIU(8925,TIUDA,13))
. . . S NODE(200,0)=$G(^VA(200,$P(NODE(8925.7,0),U,3),0)),NODE(200,5)=$G(^VA(200,$P(NODE(8925.7,0),U,3),5))
. . . S DIV=$$DIV4^XUSER(.DIV,$P(NODE(8925.7,0),U,3)) S DIV=$S(+DIV:$$GET1^DIQ(4,$O(DIV(0)),.01),1:"")
. . . Q:SCR("Terminated")&'($P(NODE(200,0),U,11)>0&($P(NODE(200,0),U,11)'>DT)) Q:SCR("DISUSER'd")&'($P(NODE(200,0),U,7))
. . . Q:+SCR(8925.6)&(+SCR(8925.6)'=$P(NODE(8925,0),U,5)) Q:+SCR(200)&(+SCR(200)'=$P(NODE(8925.7,0),U,3)) Q:+SCR(4)&('$D(DIV(+SCR(4)))) Q:+SCR(49)&(+SCR(49)'=$P(NODE(200,5),U))
. . . S CNT=CNT+1
. . . I SCR("Action")'["GENERATE" D I SCR("Action")["REMOVE" Q
. . . . N DA,DIK S DA=IEN,DIK="^TIU(8925.7," D ^DIK K ^TIU(8925.7,"AC",DATE("Entry DT"),TIUDA,IEN) D SEND^TIUALRT(TIUDA)
. . . N TIUDIV1 D PATVADPT^TIULV(.PT,$P(NODE(8925,0),U,2))
. . . F DE=1:1 S Y=$P($P($T(DE+DE),";;",2),";",2) Q:Y="" X Y
. . . S @LOC@("zData",CNT)=$TR($$CHKLEN(DATA),U,",")
S @LOC@("Total")=CNT,@LOC@("Stop Time")=$H,@LOC@("Elapsed")=$$CONVERT($$HDIFF^XLFDT(@LOC@("Stop Time"),@LOC@("Start Time"),2))
S @LOC@("Start Time")=$$HTE^XLFDT(@LOC@("Start Time")),@LOC@("Stop Time")=$$HTE^XLFDT(@LOC@("Stop Time"))
D MAIL^TIUASCU1(.LOC) ; mail the completion message
K SCR S ZTREQ="@"
Q
CHKLEN(DATA) ; check length of data and truncate fields as needed
N I,J,LEN,MAX S LEN=$L(DATA),MAX=255
N FN S FN="" F S FN=$O(QFLDS(FN),-1) Q:'FN F I=$L(QFLDS(FN),U):-1:1 I $P(DATA,U,$P(QFLDS(FN),U,I))'="" S MAX=MAX-2
S FN="" F S FN=$O(QFLDS(FN),-1) Q:'FN!(LEN'>MAX) F I=$L(QFLDS(FN),U):-1:1 I $P(DATA,U,$P(QFLDS(FN),U,I))'="" D Q:LEN'>MAX
. N TLEN S TLEN=$P($T(@("F"_FN)),";",2) ; truncated field length (after F### tag)
. I $L($P(DATA,U,$P(QFLDS(FN),U,I)))'<TLEN D
. . S LEN=$L(DATA),$P(DATA,U,$P(QFLDS(FN),U,I))=$E($P(DATA,U,$P(QFLDS(FN),U,I)),1,TLEN)
; add quotes to specific fields, annotated
S FN="" F S FN=$O(QFLDS(FN),-1) Q:'FN F I=$L(QFLDS(FN),U):-1:1 I $P(DATA,U,$P(QFLDS(FN),U,I))'="" S $P(DATA,U,$P(QFLDS(FN),U,I))=$$QM($P(DATA,U,$P(QFLDS(FN),U,I)),1)
Q DATA
DATE(DATA) ; convert to external format MM/DD/YYYY, length 10
Q $$FMTE^XLFDT($P(DATA,"."),"5Z")
F2(PT) ;30;<--truncated length if needed
Q $E(PT("PNM"),1,22)_" ("_$E(PT("PNM"),1)_$P(PT("SSN"),"-",3)_")"
F200(DATA) ;20;<--truncated length if needed
Q $S(+DATA:$P($G(^VA(200,DATA,0)),U),1:$E(DATA,1,35))
F49(DATA) ;15;<--truncated length if needed
Q $S(+DATA:$P($G(^DIC(49,DATA,0)),U),1:"")
F4(DATA) ;15;<--truncated length if needed
I +SCR(4) N X S X=0 F S X=$O(DATA(X)) Q:'X S:+SCR(4)=X DATA=$$GET1^DIQ(4,X,.01)
Q DATA
F8925(DATA) ;30;<--truncated length if needed
Q $P($G(^TIU(8925.1,+DATA,0)),U)
VIEW ;
D CLS I '+$O(^XTMP("TIUASCU",0)) W !!,"There are no reports to view.",! D DIR^TIUASCU1("EA","Press <Enter> to continue.") Q
N DIR,LOC,X,Y F X=1:1 S Y=$P($T(RPT+X),";;",2) Q:Y="" W $S(X=2:IOUON,1:""),!,Y,$S(X=2:IOUOFF,1:"")
S LOC=$NA(^XTMP("TIUASCU")),(X,Y)=0 F S X=$O(@LOC@(X)) Q:'X D
. Q:'$D(@LOC@(X,"Stop Time")) ; in progress, don't display until complete
. S Y=Y+1,$P(DIR,";",Y)=Y_":Report #"_X,Y=$$SETSTR^TIUASCU1($E($P(@LOC@(X,"User"),U),1,15),Y,4,18)
. S Y=$$SETSTR^TIUASCU1($P($P(@LOC@(X,"User"),U,2),":",1,2),Y,20,15)
. S Y=$$SETSTR^TIUASCU1(@LOC@(X,"Total"),Y,(51-$L(@LOC@(X,"Total"))),$L(@LOC@(X,"Total")))
. S Y=$$SETSTR^TIUASCU1(@LOC@(X,"Start Date")_"-"_@LOC@(X,"Stop Date"),Y,56,25)
. W !,Y D
. . N Y F Y="DISUSER'd","Terminated",200,49,4,8925.6 D:+@LOC@(X,Y)
. . . N DATA S DATA=$P(@LOC@(X,Y),U,2)_$S(Y=200:" [Additional Signer]",Y=49:" [Service/Section]",Y=4:" [Division]",Y=8925.6:" [Status]",1:" ["_Y_"]") ;"Additional Signers must be ["_Y_"]")
. . . W !,$$SETSTR^TIUASCU1(DATA,"",(IOM-($L(DATA)-1)),$L(DATA))
. W:$O(@LOC@(X)) !
I '$G(DIR) D Q
. W !!,$$CJ^XLFSTR("No completed report to view.",IOM),!!,$$CJ^XLFSTR("[Report(s) currently in progress.]",IOM),!
. F Q:$Y+4>IOSL W !
. D DIR^TIUASCU1("EA","Press <Enter> to continue.")
W ! S X=$$DIR^TIUASCU1("SAO^"_DIR,"Which report would you like to display? ") Q:'X
S LOC=$NA(^XTMP("TIUASCU",$P($P(DIR,";",X),"#",2))) I @LOC@("Total")=0 D G VIEW:+$O(^XTMP("TIUASCU",0)) Q
. W ! K:$$DIR^TIUASCU1("YA","No results in this report. OK to delete? ","YES") @LOC
D CLS W "This output is designed for 255 characters per row.",!
W !,"Example DEVICE setting: ;255",!
N ZTSAVE S ZTSAVE("LOC")="" D EN^XUTMDEVQ("DISPLAY^TIUASCU(LOC)","Additional Signer Report",.ZTSAVE) Q:POP
D DIR^TIUASCU1("EA","[stop logging before you...] Press <Enter> to continue.")
Q
DISPLAY(LOC) ;
I IOST["C-VT" D DIR^TIUASCU1("EA","To capture the report output, start logging now and press <Enter> to begin.") W @IOF
N X S X="" F S X=$O(@LOC@("zData",X)) Q:X="" W @LOC@("zData",X) W:$O(@LOC@("zData",X)) !
Q
CLS N X F X=1:1:(IOSL+1) W ! I X=(IOSL+1) D IOXY^XGF(0,0) ; clear screen
Q
CONVERT(SEC) ; convert seconds to hours/minutes/seconds
Q:SEC'>60 $FN(SEC,"",2)_" sec"
Q:SEC'>3600 (SEC\60)_" min "_$S($L($FN((SEC#60),"",0))'>1:"0"_$FN((SEC#60),"",0),1:$FN((SEC#60),"",0))_" sec"
Q (SEC\3600)_" hr "_((SEC#3600)\60)_" min "_$S($L($FN(((SEC#3600)#60),"",0))'>1:"0"_$FN(((SEC#3600)#60),"",0),1:$FN(((SEC#3600)#60),"",0))_" sec"
QM(DATA,QM) ; quote me
I DATA[$C(34) N X S X("""")="""""" S DATA=$$REPLACE^XLFSTR(DATA,.X)
Q $S(+$G(QM):$C(34)_DATA_$C(34),1:DATA)
; data elements by field; m code; file # (optional, indicates field data must be quoted and may be truncated as needed)
DE ; field;data;
;;IEN;S $P(DATA,DELIM,DE)=TIUDA
;;ADDITIONAL SIGNER;S $P(DATA,DELIM,DE)=$$F200($P(NODE(200,0),U));200
;;SERVICE/SECTION;S $P(DATA,DELIM,DE)=$$F49($P(NODE(200,5),U));49
;;DIVISION;S $P(DATA,DELIM,DE)=$$F4(.DIV);4
;;DISUSER;S $P(DATA,DELIM,DE)=$S($P(NODE(200,0),U,7):"YES",1:"")
;;TERMINATED;S $P(DATA,DELIM,DE)="" I $P(NODE(200,0),U,11)>0 S:$P(NODE(200,0),U,11)'>DT $P(DATA,DELIM,DE)=$$DATE($P(NODE(200,0),U,11))
;;PATIENT;S $P(DATA,DELIM,DE)=$$F2(.PT);2
;;LOCAL TITLE;S $P(DATA,DELIM,DE)=$$F8925(NODE(8925,0));8925
;;PARENT TITLE;S:$P(NODE(8925,0),U,6) $P(DATA,DELIM,DE)=$$F8925($P($G(^TIU(8925,$P(NODE(8925,0),U,6),0)),U));8925
;;PARENT DATE;S:$P(NODE(8925,0),U,6) $P(DATA,DELIM,DE)=$$DATE($P($G(^TIU(8925,$P(NODE(8925,0),U,6),13)),U))
;;STATUS;S $P(DATA,DELIM,DE)=$$GET1^DIQ(8925.6,$P(NODE(8925,0),U,5)_",",.01)
;;ENTRY DATE;S $P(DATA,DELIM,DE)=$$DATE($P(NODE(8925,12),U))
;;REFERENCE DATE;S $P(DATA,DELIM,DE)=$$DATE($P(NODE(8925,13),U))
;;EXPECTED SIGNER;S $P(DATA,DELIM,DE)=$$F200($P(NODE(8925,12),U,4));200
;;EXPECTED COSIGNER;S $P(DATA,DELIM,DE)=$$F200($P(NODE(8925,12),U,8));200
;;REMOVED;S $P(DATA,DELIM,DE)="" S:SCR("Action")'["GENERATE" $P(DATA,DELIM,DE)=$$FMTE^XLFDT($$DT^XLFDT,"5Z")
;;REMOVED BY;S $P(DATA,DELIM,DE)="" S:SCR("Action")'["GENERATE" $P(DATA,DELIM,DE)=$$F200($G(DUZ));200
;;
;;GENERATE a Report^S Y=$$SETUP:TIUASCU1(.SCR,.DATE)
;;REMOVE Additional Signer(s)^S Y=$$SETUP:TIUASCU1(.SCR,.DATE)
;;BOTH [Generate a Report & Remove Additional Signer(s)]^S Y=$$SETUP:TIUASCU1(.SCR,.DATE)
;;VIEW Generated Report(s)^D VIEW
;;
RPT ;
;; Report Generated # Additional Date Range
;;# Generated By Date@Time Signatures [Additional Criteria]
;;
;; 01234567890123456789012345678901234567890123456789012345678901234567890123456789
WARN F X=1:1 S Y=$P($T(WARN+X),";;",2) Q:Y="EOM" W @Y,!,IOCUON
;;$$CJ^XLFSTR("** WARNING **",IOM)
;;""
;;"Reports generated with v1 are NOT compatible and must be removed before use."
;;""
;;"Additional Signer data in TIU MULTIPLE SIGNATURE [File #8925.7] will not be"
;;"altered."
;;""
;;"This process may take a few minutes and only needs to be completed once."
;;EOM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUASCU 16532 printed Nov 22, 2024@17:48:52 Page 2
TIUASCU ; NA/AJB - ADDITIONAL SIGNER CLEANUP 2.0;11/08/23 10:30
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**254,357**;Jun 20, 1997;Build 5
+2 ;
+3 ; Reference to $$GET1^DID supported by ICR #2052
+4 ; Reference to $$GET1^DIQ supported by ICR #2056
+5 ; Reference to $$DIV^XUSER supported by ICR #2533
+6 ; Reference to HOME^%ZIS supported by ICR #10086
+7 ; Reference to *^XGF supported by ICR #3173
+8 ; Reference to *^XLFDT supported by ICR #10103
+9 ; Reference to *^XLFSTR supported by ICR #10104
+10 ; Reference to ^%ZTLOAD supported by ICR #10063
+11 ; Reference to ^DIC supported by ICR #10006
+12 ; Reference to ^DIK supported by ICR #10013
+13 ; Reference to ^DIR supported by ICR #10026
+14 ; Reference to ^XMD supported by ICR #10070
+15 ; Reference to File ^DIC(49 supported by ICR #4330
+16 ; Reference to File ^DPT supported by ICR #10035
+17 ; Reference to File ^VA supported by ICR #10060
+18 ; Reference to EN^XUTMDEVQ supported by ICR #1519
+19 ; Reference to HASH^XUSHSHP supported by ICR #10045
+20 ; Reference to ^%ZOSF(*) supported by ICR #10096
+21 ; Reference to *^XGF supported by ICR #3173
+22 ;
+23 QUIT
EN NEW C,DATE,EXIT,POP,X,Y
SET DT=$$DT^XLFDT
SET U="^"
+1 DO HOME^%ZIS
DO PREP^XGF
if $$CHK(.DATE)
GOTO EXIT
+2 DO INTRO^TIUASCU1
DO IOXY^XGF(IOSL-1,0)
DO ENTER
+3 FOR
Begin DoDot:1
+4 SET EXIT=$$CHK(.DATE)
if EXIT
QUIT
DO PREP^XGF
+5 NEW CNT,DIERR,DILOCKTM,DIR,DISYS,EXE,ROW,SCR
+6 SET SCR("User")=$GET(DUZ,0)_U_$$GET1^DIQ(200,$GET(DUZ)_",",.01)
+7 FOR X=0:1
SET Y=$PIECE($TEXT(MENU+X),";;",2)
if Y=""
QUIT
Begin DoDot:2
+8 IF X=0
WRITE IOUON_$$CJ^XLFSTR(Y,IOM)_IOUOFF,!
QUIT
+9 IF (Y["VIEW"&('+$ORDER(^XTMP("TIUASCU",0))))!(Y'["VIEW"&('DATE("Start")))
QUIT
+10 SET CNT=+$GET(CNT)+1
SET EXE(CNT)=Y
SET $PIECE(DIR,";",CNT)=CNT_":"_$PIECE(Y,U)
+11 WRITE !,?22,CNT_" "_$PIECE(Y,U)
End DoDot:2
+12 SET CNT=CNT+1
SET EXE(CNT)="QUIT^S EXIT=1"
SET $PIECE(DIR,";",CNT)=CNT_":"_"QUIT"
WRITE !,?22,CNT_" QUIT"
+13 NEW DEFAULT
SET DEFAULT=$PIECE($PIECE($PIECE(DIR,";"),"1:",2)," ")
+14 SET DIR="SAO^"_DIR
WRITE !,IOCUON
SET X=$$DIR^TIUASCU1(.DIR,"What would you like to do? ",DEFAULT)
if 'X
SET EXIT=1
if EXIT
QUIT
SET SCR("Action")=$PIECE(EXE(X),U)
+15 WRITE !
XECUTE $TRANSLATE($PIECE(EXE(X),U,2),":",U)
if 'Y!(EXIT)
QUIT
DO CLS
+16 ; check criteria, if none entered quit
+17 NEW I,J
SET I=0
FOR J=4,49,200,8925.6,"Start","End","Terminated","DISUSER'd"
SET I=I+$GET(SCR(J))
if '$GET(SCR(J))
SET SCR(J)=""
+18 if 'I
QUIT
IF SCR("Start")=""
SET SCR("Start")=DATE("Start")_U_$$FMTE^XLFDT(DATE("Start"))
SET SCR("End")=$$FMADD^XLFDT(DATE("End"),-30)+.24_U_$$FMTE^XLFDT($$FMADD^XLFDT(DATE("End"),-30))
+19 SET ROW=0
DO IOXY^XGF(ROW,0)
DO SAY^XGF(ROW,0,"Preparing a task to "_$SELECT(EXE(X)'["BOTH":$PIECE(EXE(X),U),1:$TRANSLATE($PIECE($PIECE(EXE(X),U),"[",2),"]",""))_":","U1")
+20 SET ROW=ROW+1
DO SAY^XGF(ROW,2,"Documents from "_$PIECE(SCR("Start"),U,2)_" to "_$PIECE(SCR("End"),U,2)_".")
+21 IF SCR(8925.6)
SET ROW=ROW+1
DO SAY^XGF(ROW,2,"Document STATUS must be "_$PIECE(SCR(8925.6),U,2)_".")
+22 IF SCR(200)
SET ROW=ROW+1
DO SAY^XGF(ROW,2,$PIECE(SCR(200),U,2)_" must be the additional signer.")
+23 IF SCR("Terminated")
SET ROW=ROW+1
DO SAY^XGF(ROW,2,"Additional Signers must be terminated as of "_$$FMTE^XLFDT(DT)_".")
+24 IF SCR("DISUSER'd")
SET ROW=ROW+1
DO SAY^XGF(ROW,2,"Additional Signers must be DISUSER'd.")
+25 NEW ERR,MSG,TIUFT
FOR X=49,4
Begin DoDot:2
+26 SET MSG=""
if SCR(X)
SET MSG="Additional Signers must be assigned to the "_$PIECE(SCR(X),U,2)_" ["_$SELECT(X=4:"DIVISION",X=49:"SERVICE/SECTION")_"]."
+27 KILL TIUFT
if MSG'=""
DO WRAP^TIUFLD(MSG,IOM-2)
SET TIUFT=0
FOR
SET TIUFT=$ORDER(TIUFT(TIUFT))
if 'TIUFT
QUIT
SET ROW=ROW+1
DO SAY^XGF(ROW,$SELECT(TIUFT>1:4,1:2),TIUFT(TIUFT))
End DoDot:2
+28 ; verify search criteria for the additional signer
IF +SCR(200)
Begin DoDot:2
+29 NEW DIV,NODE,SRV
SET DIV=$$DIV4^XUSER(.DIV,+SCR(200))
SET SRV=$PIECE($GET(^VA(200,+SCR(200),5)),U)
if SRV
SET $PIECE(SRV,U,2)=$PIECE($GET(^DIC(49,SRV,0)),U)
+30 SET NODE=$GET(^VA(200,+SCR(200),0))
+31 IF +SCR(4)
IF '$DATA(DIV(+SCR(4)))
SET ERR(4)="Divison(s):"
+32 IF +SCR(49)
IF +SCR(49)'=+SRV
SET ERR(49)="Service/Section: "_$PIECE(SRV,U,2)
+33 IF +SCR("DISUSER'd")
IF '$PIECE(NODE,U,7)
SET ERR("D")="Status: ACTIVE"
+34 IF +SCR("Terminated")
IF '+$PIECE(NODE,U,11)
SET ERR("T")="Termination Date: <none>"
+35 IF +SCR("Terminated")
IF +$PIECE(NODE,U,11)>0
IF $PIECE(NODE,U,11)>DT
SET ERR("T")="Termination Date: "_$$FMTE^XLFDT($PIECE(NODE,U,11),"5Z")
+36 IF $DATA(ERR)
Begin DoDot:3
+37 NEW EC,XGRT
SET EC=3
SET ERR=""
FOR
SET ERR=$ORDER(ERR(ERR))
if ERR=""
QUIT
SET EC=EC+1
IF ERR=4
NEW X
SET X=0
FOR
SET X=$ORDER(DIV(X))
if 'X
QUIT
if X'=$ORDER(DIV(0))
SET EC=EC+1
+38 NEW DISP
DO WIN^XGF(ROW+1,10,ROW+EC+4,74,"DISP")
+39 DO SAY^XGF(ROW+2,25,"*** Conflicting SEARCH CRITERIA ***")
+40 DO SAY^XGF(ROW+4,11,"Additional Signer:")
DO SAY^XGF(ROW+4,30,$EXTRACT($PIECE(SCR(200),U,2),1,43))
+41 SET ERR=""
NEW TROW
SET TROW=ROW+4
FOR
SET ERR=$ORDER(ERR(ERR),-1)
if ERR=""
QUIT
Begin DoDot:4
+42 SET TROW=TROW+1
DO SAY^XGF(TROW,11,ERR(ERR))
+43 IF ERR=4
NEW X
SET X=0
FOR
SET X=$ORDER(DIV(X))
if 'X
QUIT
DO SAY^XGF(TROW,30,$$GET1^DIQ(4,X,.01))
if $ORDER(DIV(X))
SET TROW=TROW+1
End DoDot:4
+44 SET TROW=TROW+2
DO SAY^XGF(TROW,11,"No results possible. ")
DO ENTER
DO RESTORE^XGF("DISP")
End DoDot:3
End DoDot:2
if $DATA(ERR)
QUIT
+45 IF $PIECE(SCR("Action")," ")'="GENERATE"
Begin DoDot:2
+46 NEW DISP,X1
DO WIN^XGF(ROW+1,10,ROW+13,70,"DISP")
+47 DO SAY^XGF(ROW+2,32," *** WARNING *** ","B1R1")
+48 DO SAY^XGF(ROW+4,11,"This action will PERMANENTLY REMOVE all pending additional")
+49 DO SAY^XGF(ROW+5,11,"signatures that match the criteria above.")
+50 DO SAY^XGF(ROW+7,11,"You must type YES to continue or ^ to Quit: ")
+51 NEW NOW,XGRT
SET NOW=$HOROLOG
FOR
SET X=$$READ^XGF(4)
if X="YES"!(X="^")!($$HDIFF^XLFDT($HOROLOG,NOW,2)>$GET(DTIME,60))
QUIT
DO SAY^XGF(,56," ")
DO IOXY^XGF(,56)
+52 SET X=$SELECT(X="YES":1,1:0)
if 'X
DO RESTORE^XGF("DISP")
if 'X
QUIT
DO IOXY^XGF(ROW+9,0)
SET X=$$SIG^TIUASCU1(ROW+9,11)
+53 DO IOXY^XGF(ROW+11,11)
DO ENTER
DO RESTORE^XGF("DISP")
End DoDot:2
if X'>0
QUIT
+54 DO IOXY^XGF(ROW+1,0)
+55 SET X=$$DIR^TIUASCU1("YA","Start the task now? ","NO")
if 'X
QUIT
+56 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
SET ZTDESC="Additional Signer Cleanup [TIU]"
SET ZTDTH=+$HOROLOG_","_($PIECE($HOROLOG,",",2)+3)
SET ZTIO=""
+57 SET X=""
FOR
SET X=$ORDER(SCR(X))
if X=""
QUIT
SET ZTSAVE($NAME(SCR(X)))=""
+58 ; load/start the task
SET ZTRTN="TASK^TIUASCU(.SCR)"
DO ^%ZTLOAD
if +$GET(ZTSK)
WRITE !!,"Task #",$GET(ZTSK)
+59 ; D TASK(.SCR) ; for live testing
+60 DO IOXY^XGF(IOSL-1,0)
DO ENTER
End DoDot:1
if EXIT
QUIT
EXIT DO CLEAN^XGF
+1 QUIT
CHK(DATE) ; check environment for outstanding signatures or reports to view, remove if needed
+1 NEW EXIT,NODE
SET EXIT=0
SET NODE=$GET(^XTMP("TIUASCU",0))
IF +NODE
IF NODE'["v2"
Begin DoDot:1
+2 DO CLS
DO WARN
SET EXIT=$$DIR^TIUASCU1("YA","Remove the old reports now? ","NO")
if 'EXIT
QUIT
DO CLEAN
FOR
if $Y+4>IOSL
QUIT
WRITE !
+3 DO DIR^TIUASCU1("EA","Press <Enter> to continue. ")
DO CLS
End DoDot:1
if 'EXIT
QUIT 1
+4 SET DATE("Start")=$PIECE($ORDER(^TIU(8925.7,"AC",0)),".")
SET DATE("End")=DT
SET EXIT=0
+5 IF '+DATE("Start")
IF '+$ORDER(^XTMP("TIUASCU",0))
Begin DoDot:1
+6 SET EXIT=1
WRITE !,IOCUON,"No outstanding signatures or reports to view."
+7 DO IOXY^XGF(IOSL-1,0)
DO ENTER
End DoDot:1
+8 QUIT EXIT
CLEAN ; remove reports generated with previous utility in ^XTMP("TIUASCU")
+1 WRITE !!,"Removing entries in ^XTMP..."
KILL ^XTMP("TIUASCU")
WRITE "done.",!
+2 QUIT
CUDON ; keyboard output on
XECUTE ^%ZOSF("EON")
QUIT
CUDOFF ; keyboard output off
XECUTE ^%ZOSF("EOFF")
QUIT
CUON ; cursor on
WRITE IOCUON
QUIT
CUOFF ; cursor off
WRITE IOCUOFF
QUIT
ENTER DO CUDOFF
DO CUOFF
DO SAY^XGF(,,"<Press any key to continue.>")
NEW NOW,X,XGRT
SET NOW=$HOROLOG
FOR
SET X=$$READ^XGF(1)
DO CUDON
DO CUON
if $DATA(XGRT)!($$HDIFF^XLFDT($HOROLOG,NOW,2)>$GET(DTIME,60))
QUIT
+1 QUIT
TASK(SCR) ; create [remove] the report of outstanding additional signatures
+1 NEW CNT,DATA,DATE,DE,DELIM,LOC,REM,QFLDS,X,Y
SET DATA=""
SET DELIM=U
SET LOC=$SELECT(SCR("Action")["REMOVE":"REM",1:$NAME(^XTMP("TIUASCU")))
+2 SET @LOC@(0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"Additional Signer Report v2"
+3 ; increment location & prep location
SET LOC=$NAME(@LOC@(($ORDER(@LOC@(""),-1)+1)))
KILL @LOC
+4 SET @LOC@("Start Time")=$HOROLOG
SET X=0
FOR
SET X=$ORDER(SCR(X))
if X=""
QUIT
SET @LOC@(X)=SCR(X)
+5 FOR X=1:1
SET Y=$PIECE($TEXT(DE+X),";;",2)
if Y=""
QUIT
SET $PIECE(DATA,DELIM,X)=$$QM($PIECE(Y,";"),1)
if $PIECE(Y,";",3)
Begin DoDot:1
+6 ; set quoted field info
if +$GET(QFLDS($PIECE(Y,";",3)))
SET QFLDS($PIECE(Y,";",3))=QFLDS($PIECE(Y,";",3))_U
SET $PIECE(QFLDS($PIECE(Y,";",3)),U,$LENGTH($GET(QFLDS($PIECE(Y,";",3))),U))=X
End DoDot:1
+7 SET CNT=0
SET @LOC@("zData",CNT)=$TRANSLATE(DATA,U,",")
SET $PIECE(SCR("End"),U)=+SCR("End")_".9999"
+8 SET @LOC@("User")=$PIECE(SCR("User"),U,2)_U_$PIECE($$FMTE^XLFDT($$NOW^XLFDT,"2Z"),":",1,2)
+9 SET @LOC@("Action")=SCR("Action")
SET @LOC@("Start Date")=$PIECE(SCR("Start"),U,2)
SET @LOC@("Stop Date")=$PIECE(SCR("End"),U,2)
+10 SET DATE("Entry DT")=+SCR("Start")
FOR
SET DATE("Entry DT")=$ORDER(^TIU(8925.7,"AC",DATE("Entry DT")))
if 'DATE("Entry DT")!(DATE("Entry DT")>SCR("End"))
QUIT
Begin DoDot:1
+11 NEW TIUDA
SET TIUDA=0
FOR
SET TIUDA=$ORDER(^TIU(8925.7,"AC",DATE("Entry DT"),TIUDA))
if '+TIUDA
QUIT
Begin DoDot:2
+12 NEW IEN
SET IEN=0
FOR
SET IEN=$ORDER(^TIU(8925.7,"AC",DATE("Entry DT"),TIUDA,IEN))
if 'IEN
QUIT
Begin DoDot:3
+13 IF '$DATA(^TIU(8925.7,IEN))
KILL ^TIU(8925.7,"AC",DATE("Entry DT"),TIUDA,IEN)
QUIT
+14 NEW DATA,DIV,NODE,PT
SET DATA=""
SET NODE(8925,0)=$GET(^TIU(8925,TIUDA,0))
+15 ; if document deleted or missing expected signer, delete entry
SET NODE(8925.7,0)=$GET(^TIU(8925.7,IEN,0))
IF '+$PIECE(NODE(8925.7,0),U,3)!('$PIECE(NODE(8925,0),U,2))
Begin DoDot:4
+16 NEW DA,DIK
SET DA=IEN
SET DIK="^TIU(8925.7,"
DO ^DIK
KILL ^TIU(8925.7,"AC",DATE("Entry DT"),TIUDA,IEN)
DO SEND^TIUALRT(TIUDA)
End DoDot:4
QUIT
+17 if 'NODE(8925.7,0)!(TIUDA'=+NODE(8925.7,0))
QUIT
+18 SET NODE(8925,12)=$GET(^TIU(8925,TIUDA,12))
SET NODE(8925,13)=$GET(^TIU(8925,TIUDA,13))
+19 SET NODE(200,0)=$GET(^VA(200,$PIECE(NODE(8925.7,0),U,3),0))
SET NODE(200,5)=$GET(^VA(200,$PIECE(NODE(8925.7,0),U,3),5))
+20 SET DIV=$$DIV4^XUSER(.DIV,$PIECE(NODE(8925.7,0),U,3))
SET DIV=$SELECT(+DIV:$$GET1^DIQ(4,$ORDER(DIV(0)),.01),1:"")
+21 if SCR("Terminated")&'($PIECE(NODE(200,0),U,11)>0&($PIECE(NODE(200,0),U,11)'>DT))
QUIT
if SCR("DISUSER'd")&'($PIECE(NODE(200,0),U,7))
QUIT
+22 if +SCR(8925.6)&(+SCR(8925.6)'=$PIECE(NODE(8925,0),U,5))
QUIT
if +SCR(200)&(+SCR(200)'=$PIECE(NODE(8925.7,0),U,3))
QUIT
if +SCR(4)&('$DATA(DIV(+SCR(4))))
QUIT
if +SCR(49)&(+SCR(49)'=$PIECE(NODE(200,5),U))
QUIT
+23 SET CNT=CNT+1
+24 IF SCR("Action")'["GENERATE"
Begin DoDot:4
+25 NEW DA,DIK
SET DA=IEN
SET DIK="^TIU(8925.7,"
DO ^DIK
KILL ^TIU(8925.7,"AC",DATE("Entry DT"),TIUDA,IEN)
DO SEND^TIUALRT(TIUDA)
End DoDot:4
IF SCR("Action")["REMOVE"
QUIT
+26 NEW TIUDIV1
DO PATVADPT^TIULV(.PT,$PIECE(NODE(8925,0),U,2))
+27 FOR DE=1:1
SET Y=$PIECE($PIECE($TEXT(DE+DE),";;",2),";",2)
if Y=""
QUIT
XECUTE Y
+28 SET @LOC@("zData",CNT)=$TRANSLATE($$CHKLEN(DATA),U,",")
End DoDot:3
End DoDot:2
End DoDot:1
+29 SET @LOC@("Total")=CNT
SET @LOC@("Stop Time")=$HOROLOG
SET @LOC@("Elapsed")=$$CONVERT($$HDIFF^XLFDT(@LOC@("Stop Time"),@LOC@("Start Time"),2))
+30 SET @LOC@("Start Time")=$$HTE^XLFDT(@LOC@("Start Time"))
SET @LOC@("Stop Time")=$$HTE^XLFDT(@LOC@("Stop Time"))
+31 ; mail the completion message
DO MAIL^TIUASCU1(.LOC)
+32 KILL SCR
SET ZTREQ="@"
+33 QUIT
CHKLEN(DATA) ; check length of data and truncate fields as needed
+1 NEW I,J,LEN,MAX
SET LEN=$LENGTH(DATA)
SET MAX=255
+2 NEW FN
SET FN=""
FOR
SET FN=$ORDER(QFLDS(FN),-1)
if 'FN
QUIT
FOR I=$LENGTH(QFLDS(FN),U):-1:1
IF $PIECE(DATA,U,$PIECE(QFLDS(FN),U,I))'=""
SET MAX=MAX-2
+3 SET FN=""
FOR
SET FN=$ORDER(QFLDS(FN),-1)
if 'FN!(LEN'>MAX)
QUIT
FOR I=$LENGTH(QFLDS(FN),U):-1:1
IF $PIECE(DATA,U,$PIECE(QFLDS(FN),U,I))'=""
Begin DoDot:1
+4 ; truncated field length (after F### tag)
NEW TLEN
SET TLEN=$PIECE($TEXT(@("F"_FN)),";",2)
+5 IF $LENGTH($PIECE(DATA,U,$PIECE(QFLDS(FN),U,I)))'<TLEN
Begin DoDot:2
+6 SET LEN=$LENGTH(DATA)
SET $PIECE(DATA,U,$PIECE(QFLDS(FN),U,I))=$EXTRACT($PIECE(DATA,U,$PIECE(QFLDS(FN),U,I)),1,TLEN)
End DoDot:2
End DoDot:1
if LEN'>MAX
QUIT
+7 ; add quotes to specific fields, annotated
+8 SET FN=""
FOR
SET FN=$ORDER(QFLDS(FN),-1)
if 'FN
QUIT
FOR I=$LENGTH(QFLDS(FN),U):-1:1
IF $PIECE(DATA,U,$PIECE(QFLDS(FN),U,I))'=""
SET $PIECE(DATA,U,$PIECE(QFLDS(FN),U,I))=$$QM($PIECE(DATA,U,$PIECE(QFLDS(FN),U,I)),1)
+9 QUIT DATA
DATE(DATA) ; convert to external format MM/DD/YYYY, length 10
+1 QUIT $$FMTE^XLFDT($PIECE(DATA,"."),"5Z")
F2(PT) ;30;<--truncated length if needed
+1 QUIT $EXTRACT(PT("PNM"),1,22)_" ("_$EXTRACT(PT("PNM"),1)_$PIECE(PT("SSN"),"-",3)_")"
F200(DATA) ;20;<--truncated length if needed
+1 QUIT $SELECT(+DATA:$PIECE($GET(^VA(200,DATA,0)),U),1:$EXTRACT(DATA,1,35))
F49(DATA) ;15;<--truncated length if needed
+1 QUIT $SELECT(+DATA:$PIECE($GET(^DIC(49,DATA,0)),U),1:"")
F4(DATA) ;15;<--truncated length if needed
+1 IF +SCR(4)
NEW X
SET X=0
FOR
SET X=$ORDER(DATA(X))
if 'X
QUIT
if +SCR(4)=X
SET DATA=$$GET1^DIQ(4,X,.01)
+2 QUIT DATA
F8925(DATA) ;30;<--truncated length if needed
+1 QUIT $PIECE($GET(^TIU(8925.1,+DATA,0)),U)
VIEW ;
+1 DO CLS
IF '+$ORDER(^XTMP("TIUASCU",0))
WRITE !!,"There are no reports to view.",!
DO DIR^TIUASCU1("EA","Press <Enter> to continue.")
QUIT
+2 NEW DIR,LOC,X,Y
FOR X=1:1
SET Y=$PIECE($TEXT(RPT+X),";;",2)
if Y=""
QUIT
WRITE $SELECT(X=2:IOUON,1:""),!,Y,$SELECT(X=2:IOUOFF,1:"")
+3 SET LOC=$NAME(^XTMP("TIUASCU"))
SET (X,Y)=0
FOR
SET X=$ORDER(@LOC@(X))
if 'X
QUIT
Begin DoDot:1
+4 ; in progress, don't display until complete
if '$DATA(@LOC@(X,"Stop Time"))
QUIT
+5 SET Y=Y+1
SET $PIECE(DIR,";",Y)=Y_":Report #"_X
SET Y=$$SETSTR^TIUASCU1($EXTRACT($PIECE(@LOC@(X,"User"),U),1,15),Y,4,18)
+6 SET Y=$$SETSTR^TIUASCU1($PIECE($PIECE(@LOC@(X,"User"),U,2),":",1,2),Y,20,15)
+7 SET Y=$$SETSTR^TIUASCU1(@LOC@(X,"Total"),Y,(51-$LENGTH(@LOC@(X,"Total"))),$LENGTH(@LOC@(X,"Total")))
+8 SET Y=$$SETSTR^TIUASCU1(@LOC@(X,"Start Date")_"-"_@LOC@(X,"Stop Date"),Y,56,25)
+9 WRITE !,Y
Begin DoDot:2
+10 NEW Y
FOR Y="DISUSER'd","Terminated",200,49,4,8925.6
if +@LOC@(X,Y)
Begin DoDot:3
+11 ;"Additional Signers must be ["_Y_"]")
NEW DATA
SET DATA=$PIECE(@LOC@(X,Y),U,2)_$SELECT(Y=200:" [Additional Signer]",Y=49:" [Service/Section]",Y=4:" [Division]",Y=8925.6:" [Status]",1:" ["_Y_"]")
+12 WRITE !,$$SETSTR^TIUASCU1(DATA,"",(IOM-($LENGTH(DATA)-1)),$LENGTH(DATA))
End DoDot:3
End DoDot:2
+13 if $ORDER(@LOC@(X))
WRITE !
End DoDot:1
+14 IF '$GET(DIR)
Begin DoDot:1
+15 WRITE !!,$$CJ^XLFSTR("No completed report to view.",IOM),!!,$$CJ^XLFSTR("[Report(s) currently in progress.]",IOM),!
+16 FOR
if $Y+4>IOSL
QUIT
WRITE !
+17 DO DIR^TIUASCU1("EA","Press <Enter> to continue.")
End DoDot:1
QUIT
+18 WRITE !
SET X=$$DIR^TIUASCU1("SAO^"_DIR,"Which report would you like to display? ")
if 'X
QUIT
+19 SET LOC=$NAME(^XTMP("TIUASCU",$PIECE($PIECE(DIR,";",X),"#",2)))
IF @LOC@("Total")=0
Begin DoDot:1
+20 WRITE !
if $$DIR^TIUASCU1("YA","No results in this report. OK to delete? ","YES")
KILL @LOC
End DoDot:1
if +$ORDER(^XTMP("TIUASCU",0))
GOTO VIEW
QUIT
+21 DO CLS
WRITE "This output is designed for 255 characters per row.",!
+22 WRITE !,"Example DEVICE setting: ;255",!
+23 NEW ZTSAVE
SET ZTSAVE("LOC")=""
DO EN^XUTMDEVQ("DISPLAY^TIUASCU(LOC)","Additional Signer Report",.ZTSAVE)
if POP
QUIT
+24 DO DIR^TIUASCU1("EA","[stop logging before you...] Press <Enter> to continue.")
+25 QUIT
DISPLAY(LOC) ;
+1 IF IOST["C-VT"
DO DIR^TIUASCU1("EA","To capture the report output, start logging now and press <Enter> to begin.")
WRITE @IOF
+2 NEW X
SET X=""
FOR
SET X=$ORDER(@LOC@("zData",X))
if X=""
QUIT
WRITE @LOC@("zData",X)
if $ORDER(@LOC@("zData",X))
WRITE !
+3 QUIT
CLS ; clear screen
NEW X
FOR X=1:1:(IOSL+1)
WRITE !
IF X=(IOSL+1)
DO IOXY^XGF(0,0)
+1 QUIT
CONVERT(SEC) ; convert seconds to hours/minutes/seconds
+1 if SEC'>60
QUIT $FNUMBER(SEC,"",2)_" sec"
+2 if SEC'>3600
QUIT (SEC\60)_" min "_$SELECT($LENGTH($FNUMBER((SEC#60),"",0))'>1:"0"_$FNUMBER((SEC#60),"",0),1:$FNUMBER((SEC#60),"",0))_" sec"
+3 QUIT (SEC\3600)_" hr "_((SEC#3600)\60)_" min "_$SELECT($LENGTH($FNUMBER(((SEC#3600)#60),"",0))'>1:"0"_$FNUMBER(((SEC#3600)#60),"",0),1:$FNUMBER(((SEC#3600)#60),"",0))_" sec"
QM(DATA,QM) ; quote me
+1 IF DATA[$CHAR(34)
NEW X
SET X("""")=""""""
SET DATA=$$REPLACE^XLFSTR(DATA,.X)
+2 QUIT $SELECT(+$GET(QM):$CHAR(34)_DATA_$CHAR(34),1:DATA)
+3 ; data elements by field; m code; file # (optional, indicates field data must be quoted and may be truncated as needed)
DE ; field;data;
+1 ;;IEN;S $P(DATA,DELIM,DE)=TIUDA
+2 ;;ADDITIONAL SIGNER;S $P(DATA,DELIM,DE)=$$F200($P(NODE(200,0),U));200
+3 ;;SERVICE/SECTION;S $P(DATA,DELIM,DE)=$$F49($P(NODE(200,5),U));49
+4 ;;DIVISION;S $P(DATA,DELIM,DE)=$$F4(.DIV);4
+5 ;;DISUSER;S $P(DATA,DELIM,DE)=$S($P(NODE(200,0),U,7):"YES",1:"")
+6 ;;TERMINATED;S $P(DATA,DELIM,DE)="" I $P(NODE(200,0),U,11)>0 S:$P(NODE(200,0),U,11)'>DT $P(DATA,DELIM,DE)=$$DATE($P(NODE(200,0),U,11))
+7 ;;PATIENT;S $P(DATA,DELIM,DE)=$$F2(.PT);2
+8 ;;LOCAL TITLE;S $P(DATA,DELIM,DE)=$$F8925(NODE(8925,0));8925
+9 ;;PARENT TITLE;S:$P(NODE(8925,0),U,6) $P(DATA,DELIM,DE)=$$F8925($P($G(^TIU(8925,$P(NODE(8925,0),U,6),0)),U));8925
+10 ;;PARENT DATE;S:$P(NODE(8925,0),U,6) $P(DATA,DELIM,DE)=$$DATE($P($G(^TIU(8925,$P(NODE(8925,0),U,6),13)),U))
+11 ;;STATUS;S $P(DATA,DELIM,DE)=$$GET1^DIQ(8925.6,$P(NODE(8925,0),U,5)_",",.01)
+12 ;;ENTRY DATE;S $P(DATA,DELIM,DE)=$$DATE($P(NODE(8925,12),U))
+13 ;;REFERENCE DATE;S $P(DATA,DELIM,DE)=$$DATE($P(NODE(8925,13),U))
+14 ;;EXPECTED SIGNER;S $P(DATA,DELIM,DE)=$$F200($P(NODE(8925,12),U,4));200
+15 ;;EXPECTED COSIGNER;S $P(DATA,DELIM,DE)=$$F200($P(NODE(8925,12),U,8));200
+16 ;;REMOVED;S $P(DATA,DELIM,DE)="" S:SCR("Action")'["GENERATE" $P(DATA,DELIM,DE)=$$FMTE^XLFDT($$DT^XLFDT,"5Z")
+17 ;;REMOVED BY;S $P(DATA,DELIM,DE)="" S:SCR("Action")'["GENERATE" $P(DATA,DELIM,DE)=$$F200($G(DUZ));200
+18 ;;
+1 ;;GENERATE a Report^S Y=$$SETUP:TIUASCU1(.SCR,.DATE)
+2 ;;REMOVE Additional Signer(s)^S Y=$$SETUP:TIUASCU1(.SCR,.DATE)
+3 ;;BOTH [Generate a Report & Remove Additional Signer(s)]^S Y=$$SETUP:TIUASCU1(.SCR,.DATE)
+4 ;;VIEW Generated Report(s)^D VIEW
+5 ;;
RPT ;
+1 ;; Report Generated # Additional Date Range
+2 ;;# Generated By Date@Time Signatures [Additional Criteria]
+3 ;;
+4 ;; 01234567890123456789012345678901234567890123456789012345678901234567890123456789
WARN FOR X=1:1
SET Y=$PIECE($TEXT(WARN+X),";;",2)
if Y="EOM"
QUIT
WRITE @Y,!,IOCUON
+1 ;;$$CJ^XLFSTR("** WARNING **",IOM)
+2 ;;""
+3 ;;"Reports generated with v1 are NOT compatible and must be removed before use."
+4 ;;""
+5 ;;"Additional Signer data in TIU MULTIPLE SIGNATURE [File #8925.7] will not be"
+6 ;;"altered."
+7 ;;""
+8 ;;"This process may take a few minutes and only needs to be completed once."
+9 ;;EOM
