TIUPS177 ; SLC/AJB - Blank Doc Cleanup ; 06/12/04
;;1.0;TEXT INTEGRATION UTILITIES;**177,248**;Jun 20, 1997;Build 10
;
Q
EN ; control segment
I '$$RUN^TIUPS177(+($G(DUZ))) W !!,"You are not authorized to run this report" Q
N ANS
W @IOF
D ASKUSER(.ANS) Q:$G(ANS("EXIT"))="YES"
D
.N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTSK
.S ZTDESC="TIUPS177 Blank Note Text Cleanup",ZTRTN="CLEAN^TIUPS177",ZTSAVE("*")="",ZTIO=""
.W ! D ^%ZTLOAD I '$D(ZTSK) Q
.W !!,"Your task # is: ",ZTSK,!
EXIT Q
ASKUSER(ANS) ;
N %DT,CNT,POP,X,Y
S %DT="AE",%DT(0)=$$NOW^XLFDT*-1
F CNT=1:1:2 D
. S %DT("A")=$S(CNT=1:"START WITH REFERENCE DATE: ",CNT=2:" GO TO REFERENCE DATE: ")
. S %DT("B")=$S(CNT=1:"Jan 01, 2003",CNT=2:$P($$HTE^XLFDT($H),"@"))
. D ^%DT
. I Y=-1 S CNT=2,ANS("EXIT")="YES" Q
. I CNT=1 S ANS("BEGDT")=$$DATE(Y,CNT),%DT(0)=ANS("BEGDT") Q
. S ANS("ENDDT")=$$DATE(Y,CNT),X=$P($$NOW^XLFDT,".")_".24" I ANS("ENDDT")>X S CNT=1
Q
IFTEXT() ;
N TIUCHK
S TIUCHK=0 F S TIUCHK=$O(^TIU(8925,DA,"TEXT",TIUCHK)) Q:TIUCHK=""!TIUCHK>0
Q TIUCHK
DATE(TIUDT,TIUSEQ) ;
I TIUDT["0000" S TIUDT=TIUDT/10000,TIUDT=TIUDT_$S(TIUSEQ=1:"0101",TIUSEQ=2:"1231")
I TIUSEQ=2 S TIUDT=TIUDT_".24"
Q TIUDT
CLEAN ;
N DA,DR,DIE,N,TIUDT
S DA="",N=8925,TIUDT=ANS("BEGDT")
F S TIUDT=$O(^TIU(N,"F",TIUDT)) Q:TIUDT=""!(TIUDT>ANS("ENDDT")) F S DA=$O(^TIU(N,"F",TIUDT,DA)) Q:DA="" I '$D(^TIU(8925,"DAD",DA)),'$D(^TIU(8925.91,"ADI",DA)),'$D(^TIU(N,DA,"TEXT",0)),$P($G(^TIU(8925,DA,0)),U,5)>5,'$$IFTEXT D
. I $P($G(^TIU(8925,DA,0)),U,5)=15 Q
. N TIUCODE,TIUNOW
. S TIUCODE="A",TIUNOW=$$NOW^XLFDT,DIE=8925,DR=".05////15;1610////^S X=+DUZ;1611////^S X=TIUNOW;1612////^S X=TIUCODE"
. L +^TIU(8925,DA):0 I $T D ^DIE,AUDIT L -^TIU(8925,DA)
S XQA(DUZ)="",XQAMSG="TIUPS177 has finished."
D SETUP^XQALERT
Q
AUDIT ;
N TIU,TIUIEN,TIUMSG
S TIU(8925.5,"+1,",.01)=DA
S TIU(8925.5,"+1,",2.01)=TIUNOW
S TIU(8925.5,"+1,",2.02)=DUZ
S TIU(8925.5,"+1,",2.03)=TIUCODE
D UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
Q
;VMP/ELR PATCH 248 FOLLOWING CODE CALLED FROM MUMPS EXECUTABLE WHEN ASSIGNING SECURITY KEY TIU MISSING TEXT CLEAN
;ALSO CALLED FROM TAG EN+1 OF THIS ROUTINE
;DBIA 2324
RUN(TIUDUZ) ;
NEW TIUDAT S TIUDAT=""
I ($$ISA^USRLM(+$G(TIUDUZ),"CHIEF, MIS"))!($$ISA^USRLM(+$G(TIUDUZ),"CHIEF, HIM")) D
. S TIUDAT=1
Q TIUDAT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS177 2354 printed Apr 09, 2024@21:47:22 Page 2
TIUPS177 ; SLC/AJB - Blank Doc Cleanup ; 06/12/04
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**177,248**;Jun 20, 1997;Build 10
+2 ;
+3 QUIT
EN ; control segment
+1 IF '$$RUN^TIUPS177(+($GET(DUZ)))
WRITE !!,"You are not authorized to run this report"
QUIT
+2 NEW ANS
+3 WRITE @IOF
+4 DO ASKUSER(.ANS)
if $GET(ANS("EXIT"))="YES"
QUIT
+5 Begin DoDot:1
+6 NEW ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTSK
+7 SET ZTDESC="TIUPS177 Blank Note Text Cleanup"
SET ZTRTN="CLEAN^TIUPS177"
SET ZTSAVE("*")=""
SET ZTIO=""
+8 WRITE !
DO ^%ZTLOAD
IF '$DATA(ZTSK)
QUIT
+9 WRITE !!,"Your task # is: ",ZTSK,!
End DoDot:1
EXIT QUIT
ASKUSER(ANS) ;
+1 NEW %DT,CNT,POP,X,Y
+2 SET %DT="AE"
SET %DT(0)=$$NOW^XLFDT*-1
+3 FOR CNT=1:1:2
Begin DoDot:1
+4 SET %DT("A")=$SELECT(CNT=1:"START WITH REFERENCE DATE: ",CNT=2:" GO TO REFERENCE DATE: ")
+5 SET %DT("B")=$SELECT(CNT=1:"Jan 01, 2003",CNT=2:$PIECE($$HTE^XLFDT($HOROLOG),"@"))
+6 DO ^%DT
+7 IF Y=-1
SET CNT=2
SET ANS("EXIT")="YES"
QUIT
+8 IF CNT=1
SET ANS("BEGDT")=$$DATE(Y,CNT)
SET %DT(0)=ANS("BEGDT")
QUIT
+9 SET ANS("ENDDT")=$$DATE(Y,CNT)
SET X=$PIECE($$NOW^XLFDT,".")_".24"
IF ANS("ENDDT")>X
SET CNT=1
End DoDot:1
+10 QUIT
IFTEXT() ;
+1 NEW TIUCHK
+2 SET TIUCHK=0
FOR
SET TIUCHK=$ORDER(^TIU(8925,DA,"TEXT",TIUCHK))
if TIUCHK=""!TIUCHK>0
QUIT
+3 QUIT TIUCHK
DATE(TIUDT,TIUSEQ) ;
+1 IF TIUDT["0000"
SET TIUDT=TIUDT/10000
SET TIUDT=TIUDT_$SELECT(TIUSEQ=1:"0101",TIUSEQ=2:"1231")
+2 IF TIUSEQ=2
SET TIUDT=TIUDT_".24"
+3 QUIT TIUDT
CLEAN ;
+1 NEW DA,DR,DIE,N,TIUDT
+2 SET DA=""
SET N=8925
SET TIUDT=ANS("BEGDT")
+3 FOR
SET TIUDT=$ORDER(^TIU(N,"F",TIUDT))
if TIUDT=""!(TIUDT>ANS("ENDDT"))
QUIT
FOR
SET DA=$ORDER(^TIU(N,"F",TIUDT,DA))
if DA=""
QUIT
IF '$DATA(^TIU(8925,"DAD",DA))
IF '$DATA(^TIU(8925.91,"ADI",DA))
IF '$DATA(^TIU(N,DA,"TEXT",0))
IF $PIECE($GET(^TIU(8925,DA,0)),U,5)>5
IF '$$IFTEXT
Begin DoDot:1
+4 IF $PIECE($GET(^TIU(8925,DA,0)),U,5)=15
QUIT
+5 NEW TIUCODE,TIUNOW
+6 SET TIUCODE="A"
SET TIUNOW=$$NOW^XLFDT
SET DIE=8925
SET DR=".05////15;1610////^S X=+DUZ;1611////^S X=TIUNOW;1612////^S X=TIUCODE"
+7 LOCK +^TIU(8925,DA):0
IF $TEST
DO ^DIE
DO AUDIT
LOCK -^TIU(8925,DA)
End DoDot:1
+8 SET XQA(DUZ)=""
SET XQAMSG="TIUPS177 has finished."
+9 DO SETUP^XQALERT
+10 QUIT
AUDIT ;
+1 NEW TIU,TIUIEN,TIUMSG
+2 SET TIU(8925.5,"+1,",.01)=DA
+3 SET TIU(8925.5,"+1,",2.01)=TIUNOW
+4 SET TIU(8925.5,"+1,",2.02)=DUZ
+5 SET TIU(8925.5,"+1,",2.03)=TIUCODE
+6 DO UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
+7 QUIT
+8 ;VMP/ELR PATCH 248 FOLLOWING CODE CALLED FROM MUMPS EXECUTABLE WHEN ASSIGNING SECURITY KEY TIU MISSING TEXT CLEAN
+9 ;ALSO CALLED FROM TAG EN+1 OF THIS ROUTINE
+10 ;DBIA 2324
RUN(TIUDUZ) ;
+1 NEW TIUDAT
SET TIUDAT=""
+2 IF ($$ISA^USRLM(+$GET(TIUDUZ),"CHIEF, MIS"))!($$ISA^USRLM(+$GET(TIUDUZ),"CHIEF, HIM"))
Begin DoDot:1
+3 SET TIUDAT=1
End DoDot:1
+4 QUIT TIUDAT
