- TIUPS174 ; SLC/AJB - Report for notes w/blank text ; 06/28/04
- ;;1.0;TEXT INTEGRATION UTILITIES;**174,177**;Jun 20, 1997
- ;
- Q
- REPORT ; control segment
- N ANS
- W @IOF
- D ASKUSER(.ANS) Q:$G(ANS("EXIT"))="YES"
- D
- .N POP,TIUDESC,TIURTN,TIUSAVE
- .S TIUDESC="TIUPS174 Blank Note Report Routine",TIURTN="GATHER^TIUPS174",TIUSAVE("*")=""
- .W ! D EN^XUTMDEVQ(TIURTN,TIUDESC,.TIUSAVE)
- 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
- I $G(ANS("EXIT"))="YES" Q
- ;
- D I $G(ANS("EXIT"))="YES" Q
- . N DIR,DIRUT,DUOUT,DTOUT,POP,X,Y
- . S DIR(0)="Y"
- . S DIR("A")="Would you like a delimited report"
- . S DIR("B")="NO"
- . S DIR("?")="Entering 'NO' will display/print the standard report."
- . S DIR("?",1)="Entering 'YES' will provide a delimited report for importing into another application."
- . W ! D ^DIR
- . I $D(DUOUT)!($D(DTOUT)) S ANS("EXIT")="YES" Q
- . S ANS("DELIM")=Y(0)
- ;
- 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
- GATHER ;
- N DA,I,J,LINE,N,TIME,TIUBOTH,TIUDT,TIUMTC,TIUTOG,TIUZNC
- K ^TMP("TIULIST",$J)
- I ANS("DELIM")="NO" W:'$D(ZTQUEUED) !,"Searching...",!
- S (I,J,TIUBOTH,TIUMTC,TIUZNC)=0,DA="",N=8925,TIUDT=ANS("BEGDT"),TIME("STRT")=$$NOW^XLFDT
- F S TIUDT=$O(^TIU(N,"F",TIUDT)) Q:TIUDT=""!(TIUDT>ANS("ENDDT")) F S DA=$O(^TIU(N,"F",TIUDT,DA)) Q:DA="" S I=I+1 I '$D(^TIU(8925,"DAD",DA)),'$D(^TIU(8925.91,"ADI",DA)),$P($G(^TIU(8925,DA,0)),U,5)>5,('$D(^TIU(N,DA,"TEXT",0))!'$$IFTEXT) D
- . I $P($G(^TIU(8925,DA,0)),U,5)=15 Q
- . S J=J+1,^TMP("TIULIST",$J,DA)=""
- . I '$D(^TIU(8925,DA,"TEXT",0)),$$IFTEXT() S ^TMP("TIULIST",$J,DA)="0 Node",TIUZNC=TIUZNC+1
- . I $D(^TIU(8925,DA,"TEXT",0)),'$$IFTEXT() S ^TMP("TIULIST",$J,DA)="Text",TIUMTC=TIUMTC+1
- . I '$D(^TIU(8925,DA,"TEXT",0)),'$$IFTEXT() S ^TMP("TIULIST",$J,DA)="0/Text",TIUBOTH=TIUBOTH+1
- . I $D(^TIU(8925,DA,"TEXT",300)) S ^TMP("TIULIST",$J,DA)=^TMP("TIULIST",$J,DA)_"*"
- S TIME("STOP")=$$NOW^XLFDT,TIME("ELAP")=$FN($$FMDIFF^XLFDT(TIME("STRT"),TIME("STOP"),2)/60,"-")
- ;
- N LCNT,LINE,LINETXT,XQA,XQAMSG
- S LCNT="",$P(LCNT,"-",$L(I))="-"
- I ANS("DELIM")="NO" F LINE=1:1 S LINETXT=$P($T(TEXT+LINE),";;",2) Q:LINETXT="EOM" W @LINETXT,!
- I ANS("DELIM")="YES" D
- . W "Doc #^Missing^Status^Title^Author^Patient^Entry Date^Time" ; ^Reference Date^Time^Signature Date^Time",!
- S DA=""
- F S DA=$O(^TMP("TIULIST",$J,DA)) Q:DA="" D
- .N TMP
- .I ANS("DELIM")="YES" D Q
- . . S TMP("AUTH")=$E($$GET1^DIQ(8925,DA_",",1202),1,34),TMP("RD")=$P($$FMTE^XLFDT($P($G(^TIU(8925,DA,13)),U)),"@")
- . . S TMP("TITLE")=$E($$GET1^DIQ(8925,DA_",",.01),1,34),TMP("RT")=$P($$FMTE^XLFDT($P($G(^TIU(8925,DA,13)),U)),"@",2)
- . . S TMP("PAT")=$E($$GET1^DIQ(8925,DA_",",.02),1,25)_"("_$$TIUSSN_")"
- . . S TMP("ET")=$P($$FMTE^XLFDT($P($G(^TIU(8925,DA,12)),U)),"@",2)
- . . S TMP("STAT")=$$GET1^DIQ(8925,DA,.05),TMP("ED")=$P($$FMTE^XLFDT($P($G(^TIU(8925,DA,12)),U)),"@")
- . . S TMP("MISS")=^TMP("TIULIST",$J,DA),TMP("SD")=$S($P($G(^TIU(8925,DA,15)),U)="":"N/A",1:$$FMTE^XLFDT($P($G(^TIU(8925,DA,15)),U)))
- . . I TMP("SD")'="N/A" S TMP("ST")=$P(TMP("SD"),"@",2),TMP("SD")=$P(TMP("SD"),"@")
- . . S TMP(DA)=DA_U_TMP("MISS")_U_TMP("STAT")_U_TMP("TITLE")_U_TMP("AUTH")_U_TMP("PAT")_U_TMP("ED")
- . . S TMP(DA)=TMP(DA)_U_TMP("ET") ; _U_TMP("RD")_U_TMP("RT")_U_TMP("SD")_U_$G(TMP("ST"))
- . . W TMP(DA),! Q
- .S TMP(DA)=$$SPACER(DA,12)_$$SPACER($$FMTE^XLFDT($P($G(^TIU(8925,DA,12)),U)),32)_$E($$GET1^DIQ(8925,DA_",",.01),1,34)
- .W TMP(DA),!
- .S TMP(DA)=$$SPACER(^TMP("TIULIST",$J,DA),12)_$$SPACER($$FMTE^XLFDT($P($G(^TIU(8925,DA,13)),U)),32)_$E($$GET1^DIQ(8925,DA_",",.02),1,25)_"("_$$TIUSSN_")"
- .W TMP(DA),!
- .S TMP(DA)=$$SPACER($$GET1^DIQ(8925,DA,.05),12)_$$SPACER($S($P($G(^TIU(8925,DA,15)),U)="":"N/A",1:$$FMTE^XLFDT($P($G(^TIU(8925,DA,15)),U))),32)_$E($$GET1^DIQ(8925,DA_",",1202),1,34)
- .W TMP(DA),!!
- K ^TMP("TIULIST",$J)
- S XQA(DUZ)="",XQAMSG="TIUPS174 has finished."
- D SETUP^XQALERT
- Q
- TIUSSN() ;
- ; DBIA #10061
- N DFN,VA,VADM,VAERR
- S DFN=$P($G(^TIU(8925,DA,0)),U,2)
- D DEM^VADPT
- Q $P(VA("PID"),"-",3)
- SPACER(TEXT,LENGTH,REV) ;
- N SPACER
- S SPACER=""
- S $P(SPACER," ",(LENGTH-$L(TEXT)))=" "
- S:'$D(REV) TEXT=TEXT_SPACER
- S:$D(REV) TEXT=SPACER_TEXT
- Q TEXT
- TEXT ;
- ;;""
- ;;"Date range searched: "_($$FMTE^XLFDT(ANS("BEGDT"),"D"))_" - "_($$FMTE^XLFDT(ANS("ENDDT"),"D"))
- ;;" # of Records:"
- ;;" Searched "_I
- ;;" Missing Text Only "_$$SPACER(TIUMTC,$L(I),1)
- ;;" Missing 0 Node Only "_$$SPACER(TIUZNC,$L(I),1)
- ;;" Missing 0 node & Text "_$$SPACER(TIUBOTH,$L(I),1)
- ;;" "_LCNT
- ;;" Total "_$$SPACER(J,$L(I),1)
- ;;""
- ;;" Elapsed Time: "_(TIME("ELAP")\1)_" minute(s) "_($FN((TIME("ELAP")#1)*60,"-",0))_" second(s)"
- ;;" Current User: "_($$GET1^DIQ(200,$G(DUZ),.01))
- ;;" Current Date: "_($$HTE^XLFDT($H))
- ;;""
- ;;"Doc # Entry Date/Time Title"
- ;;"Missing Reference Date/Time Patient"
- ;;"Status Signature Date/Time Author/Dictator"
- ;;"------ ------------------- ---------------"
- ;;EOM
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS174 5837 printed Apr 23, 2025@18:58:42 Page 2
- TIUPS174 ; SLC/AJB - Report for notes w/blank text ; 06/28/04
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**174,177**;Jun 20, 1997
- +2 ;
- +3 QUIT
- REPORT ; control segment
- +1 NEW ANS
- +2 WRITE @IOF
- +3 DO ASKUSER(.ANS)
- if $GET(ANS("EXIT"))="YES"
- QUIT
- +4 Begin DoDot:1
- +5 NEW POP,TIUDESC,TIURTN,TIUSAVE
- +6 SET TIUDESC="TIUPS174 Blank Note Report Routine"
- SET TIURTN="GATHER^TIUPS174"
- SET TIUSAVE("*")=""
- +7 WRITE !
- DO EN^XUTMDEVQ(TIURTN,TIUDESC,.TIUSAVE)
- 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 IF $GET(ANS("EXIT"))="YES"
- QUIT
- +11 ;
- +12 Begin DoDot:1
- +13 NEW DIR,DIRUT,DUOUT,DTOUT,POP,X,Y
- +14 SET DIR(0)="Y"
- +15 SET DIR("A")="Would you like a delimited report"
- +16 SET DIR("B")="NO"
- +17 SET DIR("?")="Entering 'NO' will display/print the standard report."
- +18 SET DIR("?",1)="Entering 'YES' will provide a delimited report for importing into another application."
- +19 WRITE !
- DO ^DIR
- +20 IF $DATA(DUOUT)!($DATA(DTOUT))
- SET ANS("EXIT")="YES"
- QUIT
- +21 SET ANS("DELIM")=Y(0)
- End DoDot:1
- IF $GET(ANS("EXIT"))="YES"
- QUIT
- +22 ;
- +23 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
- GATHER ;
- +1 NEW DA,I,J,LINE,N,TIME,TIUBOTH,TIUDT,TIUMTC,TIUTOG,TIUZNC
- +2 KILL ^TMP("TIULIST",$JOB)
- +3 IF ANS("DELIM")="NO"
- if '$DATA(ZTQUEUED)
- WRITE !,"Searching...",!
- +4 SET (I,J,TIUBOTH,TIUMTC,TIUZNC)=0
- SET DA=""
- SET N=8925
- SET TIUDT=ANS("BEGDT")
- SET TIME("STRT")=$$NOW^XLFDT
- +5 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
- SET I=I+1
- IF '$DATA(^TIU(8925,"DAD",DA))
- IF '$DATA(^TIU(8925.91,"ADI",DA))
- IF $PIECE($GET(^TIU(8925,DA,0)),U,5)>5
- IF ('$DATA(^TIU(N,DA,"TEXT",0))!'$$IFTEXT)
- Begin DoDot:1
- +6 IF $PIECE($GET(^TIU(8925,DA,0)),U,5)=15
- QUIT
- +7 SET J=J+1
- SET ^TMP("TIULIST",$JOB,DA)=""
- +8 IF '$DATA(^TIU(8925,DA,"TEXT",0))
- IF $$IFTEXT()
- SET ^TMP("TIULIST",$JOB,DA)="0 Node"
- SET TIUZNC=TIUZNC+1
- +9 IF $DATA(^TIU(8925,DA,"TEXT",0))
- IF '$$IFTEXT()
- SET ^TMP("TIULIST",$JOB,DA)="Text"
- SET TIUMTC=TIUMTC+1
- +10 IF '$DATA(^TIU(8925,DA,"TEXT",0))
- IF '$$IFTEXT()
- SET ^TMP("TIULIST",$JOB,DA)="0/Text"
- SET TIUBOTH=TIUBOTH+1
- +11 IF $DATA(^TIU(8925,DA,"TEXT",300))
- SET ^TMP("TIULIST",$JOB,DA)=^TMP("TIULIST",$JOB,DA)_"*"
- End DoDot:1
- +12 SET TIME("STOP")=$$NOW^XLFDT
- SET TIME("ELAP")=$FNUMBER($$FMDIFF^XLFDT(TIME("STRT"),TIME("STOP"),2)/60,"-")
- +13 ;
- +14 NEW LCNT,LINE,LINETXT,XQA,XQAMSG
- +15 SET LCNT=""
- SET $PIECE(LCNT,"-",$LENGTH(I))="-"
- +16 IF ANS("DELIM")="NO"
- FOR LINE=1:1
- SET LINETXT=$PIECE($TEXT(TEXT+LINE),";;",2)
- if LINETXT="EOM"
- QUIT
- WRITE @LINETXT,!
- +17 IF ANS("DELIM")="YES"
- Begin DoDot:1
- +18 ; ^Reference Date^Time^Signature Date^Time",!
- WRITE "Doc #^Missing^Status^Title^Author^Patient^Entry Date^Time"
- End DoDot:1
- +19 SET DA=""
- +20 FOR
- SET DA=$ORDER(^TMP("TIULIST",$JOB,DA))
- if DA=""
- QUIT
- Begin DoDot:1
- +21 NEW TMP
- +22 IF ANS("DELIM")="YES"
- Begin DoDot:2
- +23 SET TMP("AUTH")=$EXTRACT($$GET1^DIQ(8925,DA_",",1202),1,34)
- SET TMP("RD")=$PIECE($$FMTE^XLFDT($PIECE($GET(^TIU(8925,DA,13)),U)),"@")
- +24 SET TMP("TITLE")=$EXTRACT($$GET1^DIQ(8925,DA_",",.01),1,34)
- SET TMP("RT")=$PIECE($$FMTE^XLFDT($PIECE($GET(^TIU(8925,DA,13)),U)),"@",2)
- +25 SET TMP("PAT")=$EXTRACT($$GET1^DIQ(8925,DA_",",.02),1,25)_"("_$$TIUSSN_")"
- +26 SET TMP("ET")=$PIECE($$FMTE^XLFDT($PIECE($GET(^TIU(8925,DA,12)),U)),"@",2)
- +27 SET TMP("STAT")=$$GET1^DIQ(8925,DA,.05)
- SET TMP("ED")=$PIECE($$FMTE^XLFDT($PIECE($GET(^TIU(8925,DA,12)),U)),"@")
- +28 SET TMP("MISS")=^TMP("TIULIST",$JOB,DA)
- SET TMP("SD")=$SELECT($PIECE($GET(^TIU(8925,DA,15)),U)="":"N/A",1:$$FMTE^XLFDT($PIECE($GET(^TIU(8925,DA,15)),U)))
- +29 IF TMP("SD")'="N/A"
- SET TMP("ST")=$PIECE(TMP("SD"),"@",2)
- SET TMP("SD")=$PIECE(TMP("SD"),"@")
- +30 SET TMP(DA)=DA_U_TMP("MISS")_U_TMP("STAT")_U_TMP("TITLE")_U_TMP("AUTH")_U_TMP("PAT")_U_TMP("ED")
- +31 ; _U_TMP("RD")_U_TMP("RT")_U_TMP("SD")_U_$G(TMP("ST"))
- SET TMP(DA)=TMP(DA)_U_TMP("ET")
- +32 WRITE TMP(DA),!
- QUIT
- End DoDot:2
- QUIT
- +33 SET TMP(DA)=$$SPACER(DA,12)_$$SPACER($$FMTE^XLFDT($PIECE($GET(^TIU(8925,DA,12)),U)),32)_$EXTRACT($$GET1^DIQ(8925,DA_",",.01),1,34)
- +34 WRITE TMP(DA),!
- +35 SET TMP(DA)=$$SPACER(^TMP("TIULIST",$JOB,DA),12)_$$SPACER($$FMTE^XLFDT($PIECE($GET(^TIU(8925,DA,13)),U)),32)_$EXTRACT($$GET1^DIQ(8925,DA_",",.02),1,25)_"("_$$TIUSSN_")"
- +36 WRITE TMP(DA),!
- +37 SET TMP(DA)=$$SPACER($$GET1^DIQ(8925,DA,.05),12)_$$SPACER($SELECT($PIECE($GET(^TIU(8925,DA,15)),U)="":"N/A",1:$$FMTE^XLFDT($PIECE($GET(^TIU(8925,DA,15)),U))),32)_$EXTRACT($$GET1^DIQ(8925,DA_",",1202),1,34)
- +38 WRITE TMP(DA),!!
- End DoDot:1
- +39 KILL ^TMP("TIULIST",$JOB)
- +40 SET XQA(DUZ)=""
- SET XQAMSG="TIUPS174 has finished."
- +41 DO SETUP^XQALERT
- +42 QUIT
- TIUSSN() ;
- +1 ; DBIA #10061
- +2 NEW DFN,VA,VADM,VAERR
- +3 SET DFN=$PIECE($GET(^TIU(8925,DA,0)),U,2)
- +4 DO DEM^VADPT
- +5 QUIT $PIECE(VA("PID"),"-",3)
- SPACER(TEXT,LENGTH,REV) ;
- +1 NEW SPACER
- +2 SET SPACER=""
- +3 SET $PIECE(SPACER," ",(LENGTH-$LENGTH(TEXT)))=" "
- +4 if '$DATA(REV)
- SET TEXT=TEXT_SPACER
- +5 if $DATA(REV)
- SET TEXT=SPACER_TEXT
- +6 QUIT TEXT
- TEXT ;
- +1 ;;""
- +2 ;;"Date range searched: "_($$FMTE^XLFDT(ANS("BEGDT"),"D"))_" - "_($$FMTE^XLFDT(ANS("ENDDT"),"D"))
- +3 ;;" # of Records:"
- +4 ;;" Searched "_I
- +5 ;;" Missing Text Only "_$$SPACER(TIUMTC,$L(I),1)
- +6 ;;" Missing 0 Node Only "_$$SPACER(TIUZNC,$L(I),1)
- +7 ;;" Missing 0 node & Text "_$$SPACER(TIUBOTH,$L(I),1)
- +8 ;;" "_LCNT
- +9 ;;" Total "_$$SPACER(J,$L(I),1)
- +10 ;;""
- +11 ;;" Elapsed Time: "_(TIME("ELAP")\1)_" minute(s) "_($FN((TIME("ELAP")#1)*60,"-",0))_" second(s)"
- +12 ;;" Current User: "_($$GET1^DIQ(200,$G(DUZ),.01))
- +13 ;;" Current Date: "_($$HTE^XLFDT($H))
- +14 ;;""
- +15 ;;"Doc # Entry Date/Time Title"
- +16 ;;"Missing Reference Date/Time Patient"
- +17 ;;"Status Signature Date/Time Author/Dictator"
- +18 ;;"------ ------------------- ---------------"
- +19 ;;EOM
- +20 QUIT
