- 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
- 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
