TIUPS174 ; SLC/AJB - Report for notes w/blank text ;17-Mar-2010 13:36;DU
;;1.0;TEXT INTEGRATION UTILITIES;**174,177,1007**;Jun 20, 1997;Build 5
;
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,HRCN
S DFN=$P($G(^TIU(8925,DA,0)),U,2)
;IHS/MSC/MGH Changed to use HRCN number
;D DEM^VADPT
;Q $P(VA("PID"),"-",3)
S HRCN=$$HRCN^TIUR2(DFN,+$G(DUZ(2)))
Q HRCN
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
TIUPS174 ; SLC/AJB - Report for notes w/blank text ;17-Mar-2010 13:36;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**174,177,1007**;Jun 20, 1997;Build 5
+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,HRCN
+3 SET DFN=$PIECE($GET(^TIU(8925,DA,0)),U,2)
+4 ;IHS/MSC/MGH Changed to use HRCN number
+5 ;D DEM^VADPT
+6 ;Q $P(VA("PID"),"-",3)
+7 SET HRCN=$$HRCN^TIUR2(DFN,+$GET(DUZ(2)))
+8 QUIT HRCN
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
