source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS174.m@ 1556

Last change on this file since 1556 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1TIUPS174 ; SLC/AJB - Report for notes w/blank text ; 06/28/04
2 ;;1.0;TEXT INTEGRATION UTILITIES;**174,177**;Jun 20, 1997
3 ;
4 Q
5REPORT ; control segment
6 N ANS
7 W @IOF
8 D ASKUSER(.ANS) Q:$G(ANS("EXIT"))="YES"
9 D
10 .N POP,TIUDESC,TIURTN,TIUSAVE
11 .S TIUDESC="TIUPS174 Blank Note Report Routine",TIURTN="GATHER^TIUPS174",TIUSAVE("*")=""
12 .W ! D EN^XUTMDEVQ(TIURTN,TIUDESC,.TIUSAVE)
13EXIT Q
14ASKUSER(ANS) ;
15 N %DT,CNT,POP,X,Y
16 S %DT="AE",%DT(0)=$$NOW^XLFDT*-1
17 F CNT=1:1:2 D
18 . S %DT("A")=$S(CNT=1:"START WITH REFERENCE DATE: ",CNT=2:" GO TO REFERENCE DATE: ")
19 . S %DT("B")=$S(CNT=1:"Jan 01, 2003",CNT=2:$P($$HTE^XLFDT($H),"@"))
20 . D ^%DT
21 . I Y=-1 S CNT=2,ANS("EXIT")="YES" Q
22 . I CNT=1 S ANS("BEGDT")=$$DATE(Y,CNT),%DT(0)=ANS("BEGDT") Q
23 . S ANS("ENDDT")=$$DATE(Y,CNT),X=$P($$NOW^XLFDT,".")_".24" I ANS("ENDDT")>X S CNT=1
24 I $G(ANS("EXIT"))="YES" Q
25 ;
26 D I $G(ANS("EXIT"))="YES" Q
27 . N DIR,DIRUT,DUOUT,DTOUT,POP,X,Y
28 . S DIR(0)="Y"
29 . S DIR("A")="Would you like a delimited report"
30 . S DIR("B")="NO"
31 . S DIR("?")="Entering 'NO' will display/print the standard report."
32 . S DIR("?",1)="Entering 'YES' will provide a delimited report for importing into another application."
33 . W ! D ^DIR
34 . I $D(DUOUT)!($D(DTOUT)) S ANS("EXIT")="YES" Q
35 . S ANS("DELIM")=Y(0)
36 ;
37 Q
38IFTEXT() ;
39 N TIUCHK
40 S TIUCHK=0 F S TIUCHK=$O(^TIU(8925,DA,"TEXT",TIUCHK)) Q:TIUCHK=""!TIUCHK>0
41 Q TIUCHK
42DATE(TIUDT,TIUSEQ) ;
43 I TIUDT["0000" S TIUDT=TIUDT/10000,TIUDT=TIUDT_$S(TIUSEQ=1:"0101",TIUSEQ=2:"1231")
44 I TIUSEQ=2 S TIUDT=TIUDT_".24"
45 Q TIUDT
46GATHER ;
47 N DA,I,J,LINE,N,TIME,TIUBOTH,TIUDT,TIUMTC,TIUTOG,TIUZNC
48 K ^TMP("TIULIST",$J)
49 I ANS("DELIM")="NO" W:'$D(ZTQUEUED) !,"Searching...",!
50 S (I,J,TIUBOTH,TIUMTC,TIUZNC)=0,DA="",N=8925,TIUDT=ANS("BEGDT"),TIME("STRT")=$$NOW^XLFDT
51 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
52 . I $P($G(^TIU(8925,DA,0)),U,5)=15 Q
53 . S J=J+1,^TMP("TIULIST",$J,DA)=""
54 . I '$D(^TIU(8925,DA,"TEXT",0)),$$IFTEXT() S ^TMP("TIULIST",$J,DA)="0 Node",TIUZNC=TIUZNC+1
55 . I $D(^TIU(8925,DA,"TEXT",0)),'$$IFTEXT() S ^TMP("TIULIST",$J,DA)="Text",TIUMTC=TIUMTC+1
56 . I '$D(^TIU(8925,DA,"TEXT",0)),'$$IFTEXT() S ^TMP("TIULIST",$J,DA)="0/Text",TIUBOTH=TIUBOTH+1
57 . I $D(^TIU(8925,DA,"TEXT",300)) S ^TMP("TIULIST",$J,DA)=^TMP("TIULIST",$J,DA)_"*"
58 S TIME("STOP")=$$NOW^XLFDT,TIME("ELAP")=$FN($$FMDIFF^XLFDT(TIME("STRT"),TIME("STOP"),2)/60,"-")
59 ;
60 N LCNT,LINE,LINETXT,XQA,XQAMSG
61 S LCNT="",$P(LCNT,"-",$L(I))="-"
62 I ANS("DELIM")="NO" F LINE=1:1 S LINETXT=$P($T(TEXT+LINE),";;",2) Q:LINETXT="EOM" W @LINETXT,!
63 I ANS("DELIM")="YES" D
64 . W "Doc #^Missing^Status^Title^Author^Patient^Entry Date^Time" ; ^Reference Date^Time^Signature Date^Time",!
65 S DA=""
66 F S DA=$O(^TMP("TIULIST",$J,DA)) Q:DA="" D
67 .N TMP
68 .I ANS("DELIM")="YES" D Q
69 . . S TMP("AUTH")=$E($$GET1^DIQ(8925,DA_",",1202),1,34),TMP("RD")=$P($$FMTE^XLFDT($P($G(^TIU(8925,DA,13)),U)),"@")
70 . . S TMP("TITLE")=$E($$GET1^DIQ(8925,DA_",",.01),1,34),TMP("RT")=$P($$FMTE^XLFDT($P($G(^TIU(8925,DA,13)),U)),"@",2)
71 . . S TMP("PAT")=$E($$GET1^DIQ(8925,DA_",",.02),1,25)_"("_$$TIUSSN_")"
72 . . S TMP("ET")=$P($$FMTE^XLFDT($P($G(^TIU(8925,DA,12)),U)),"@",2)
73 . . S TMP("STAT")=$$GET1^DIQ(8925,DA,.05),TMP("ED")=$P($$FMTE^XLFDT($P($G(^TIU(8925,DA,12)),U)),"@")
74 . . 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)))
75 . . I TMP("SD")'="N/A" S TMP("ST")=$P(TMP("SD"),"@",2),TMP("SD")=$P(TMP("SD"),"@")
76 . . S TMP(DA)=DA_U_TMP("MISS")_U_TMP("STAT")_U_TMP("TITLE")_U_TMP("AUTH")_U_TMP("PAT")_U_TMP("ED")
77 . . S TMP(DA)=TMP(DA)_U_TMP("ET") ; _U_TMP("RD")_U_TMP("RT")_U_TMP("SD")_U_$G(TMP("ST"))
78 . . W TMP(DA),! Q
79 .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)
80 .W TMP(DA),!
81 .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_")"
82 .W TMP(DA),!
83 .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)
84 .W TMP(DA),!!
85 K ^TMP("TIULIST",$J)
86 S XQA(DUZ)="",XQAMSG="TIUPS174 has finished."
87 D SETUP^XQALERT
88 Q
89TIUSSN() ;
90 ; DBIA #10061
91 N DFN,VA,VADM,VAERR
92 S DFN=$P($G(^TIU(8925,DA,0)),U,2)
93 D DEM^VADPT
94 Q $P(VA("PID"),"-",3)
95SPACER(TEXT,LENGTH,REV) ;
96 N SPACER
97 S SPACER=""
98 S $P(SPACER," ",(LENGTH-$L(TEXT)))=" "
99 S:'$D(REV) TEXT=TEXT_SPACER
100 S:$D(REV) TEXT=SPACER_TEXT
101 Q TEXT
102TEXT ;
103 ;;""
104 ;;"Date range searched: "_($$FMTE^XLFDT(ANS("BEGDT"),"D"))_" - "_($$FMTE^XLFDT(ANS("ENDDT"),"D"))
105 ;;" # of Records:"
106 ;;" Searched "_I
107 ;;" Missing Text Only "_$$SPACER(TIUMTC,$L(I),1)
108 ;;" Missing 0 Node Only "_$$SPACER(TIUZNC,$L(I),1)
109 ;;" Missing 0 node & Text "_$$SPACER(TIUBOTH,$L(I),1)
110 ;;" "_LCNT
111 ;;" Total "_$$SPACER(J,$L(I),1)
112 ;;""
113 ;;" Elapsed Time: "_(TIME("ELAP")\1)_" minute(s) "_($FN((TIME("ELAP")#1)*60,"-",0))_" second(s)"
114 ;;" Current User: "_($$GET1^DIQ(200,$G(DUZ),.01))
115 ;;" Current Date: "_($$HTE^XLFDT($H))
116 ;;""
117 ;;"Doc # Entry Date/Time Title"
118 ;;"Missing Reference Date/Time Patient"
119 ;;"Status Signature Date/Time Author/Dictator"
120 ;;"------ ------------------- ---------------"
121 ;;EOM
122 Q
Note: See TracBrowser for help on using the repository browser.