TIU189 ;BPFO/JML - UNCOSIGNED WITH NO COSIGNER ; 5/19/05 12:33pm
;;1.0;Text Integration Utilities;**189**;JUN 20, 1997
;
; This report can be run from the menu option
; TIUMEC - Missing Expected Cosignor Report found under the
; TIU MAIN MENU MGR option. It can also be added to Taskman with
; the entry point NITE^TIU189. This option will look for problems
; in the previous 30 days and upon finding any will send an email to
; the mail group G.TIU MIS ALERTS.
;
N TIUIEN,TIUDT,TIUDTS,TIUPDT,TIUJ,TIUPIEN,TIUPN,TIURES,TIU0,TIU12,TIUEDT,TIUCS,TIUAUTH,TIUTITLE
N TIUPAR,DFN,TIUPCO,TIURTYP,TIUSIEN,TIUSERV,TIUJIEN,TIUJTITL,NOCOL,DIR,TIUAUTHI,TIUQUIT,TIUPAGE,TIUOFF
N %ZIS,POP,NOW,Y,COSTAT,X1,X2
S TIUJ=$J,TIUCS=$$COSTAT()
D DTRANGE^TIUADCL(.TIUDTS)
Q:'$D(TIUDTS("BEGDT"))!('$D(TIUDTS("ENDDT")))
S X1=TIUDTS("BEGDT"),X2=-1 D C^%DTC
S TIUDT=X+.99999999,TIUEDT=TIUDTS("ENDDT")
D DEV
Q:$G(POP)>0
I $G(IO("Q"))=1 D Q
.N ZTRTN,ZTDESC,ZTSAVE
.S ZTRTN="MENU1^TIU189",ZTDESC="Uncosigned Problem Report"
.S ZTSAVE("TIU*")=""
.D ^%ZTLOAD K IO("Q")
F S TIUDT=$O(^TIU(8925,"F",TIUDT)) Q:TIUDT=""!(TIUDT>TIUEDT) D
.S TIUIEN=""
.F S TIUIEN=$O(^TIU(8925,"F",TIUDT,TIUIEN)) Q:TIUIEN="" D
..S TIUPDT=$$CHECK(TIUIEN)
..I TIUPDT>0 D SET(TIUJ,TIUPDT,TIUIEN)
D REPORT
K ^TMP(TIUJ)
D ^%ZISC
Q
;
REPORT ; ENTRIES WRITTEN TO REPORT
U IO
I $G(IO("Q"))'=1,IOST["C-",TIURTYP'="NOCOL" W @IOF
I '$D(^TMP(TIUJ,"TIU189")) D Q
.D TITLE
.W !!,"No Problem Notes Found."
.I $G(IO("Q"))='1,IOST["C-" D PAUSE^VALM1
S TIUQUIT=0
D HEAD
S TIUDT=""
F S TIUDT=$O(^TMP(TIUJ,"TIU189","PROBLEM",TIUDT)) Q:TIUDT=""!(TIUQUIT) D
.S TIUIEN=""
.F S TIUIEN=$O(^TMP(TIUJ,"TIU189","PROBLEM",TIUDT,TIUIEN)) Q:TIUIEN=""!(TIUQUIT) D
..D PAGE
..Q:TIUQUIT
..S TIU0=$G(^TIU(8925,TIUIEN,0)),TIU12=$G(^TIU(8925,TIUIEN,12))
..S Y=$P(TIU12,"^") D DD^%DT S TIUEDT=Y
..S DFN=$P(TIU0,"^",2) D DEM^VADPT
..S TIUSSN=$E($P(VADM(2),"^"),6,9)
..S TIULNAME=$P(VADM(1),","),TIUFNAME=$P(VADM(1),",",2),TIUMNAME=$P(TIUFNAME," ",2)
..S TIUPN=$E(TIUFNAME)_$E(TIUMNAME)_$E(TIULNAME)_TIUSSN
..S TIUAUTH=$E($$GET1^DIQ(8925,TIUIEN_",",1202),1,15)
..S TIUAUTHI=$P($G(^TIU(8925,TIUIEN,12)),"^",2)
..S TIUTITLE=$E($$GET1^DIQ(8925,TIUIEN_",",.01),1,15)
..S TIUSIEN=$$GET1^DIQ(200,TIUAUTHI_",",29,"I"),TIUSERV=$$GET1^DIQ(49,TIUSIEN_",",.01)
..S TIUJIEN=$$GET1^DIQ(200,TIUAUTHI_",",8,"I"),TIUJTITL=$$GET1^DIQ(3.1,TIUJIEN_",",.01)
..S TIUPAR=^TMP(TIUJ,"TIU189","PROBLEM",TIUDT,TIUIEN)
..I TIURTYP="COL80" D
...W !,TIUPN,?9,TIUEDT,?32,$E(TIUTITLE,1,20),?53,$E(TIUAUTH,1,15),?69,"~",TIUIEN
...D TIUPAR(TIUPAR)
..I TIURTYP="COL132" D
...W !,TIUPN,?9,TIUEDT,?32,$E(TIUTITLE,1,24),?58,$E(TIUAUTH,1,23),?83,$E(TIUSERV,1,16)
...W ?101,$E(TIUJTITL,1,16),?119,"~",TIUIEN
...D TIUPAR(TIUPAR)
..I TIURTYP="NOCOL" D
...W !,TIUPN,"^",TIUEDT,"^",TIUTITLE,"^",TIUAUTH,"^",TIUSERV,"^",TIUJTITL,"^",TIUIEN
...W "^",$P(TIUPAR,"^",1),"^",$P(TIUPAR,"^",2),"^",$P(TIUPAR,"^",3)
I $G(IO("Q"))'=1,IOST["C-",TIURTYP'="NOCOL" D PAUSE^VALM1 W @IOF
Q
;
TIUPAR(TIUPAR) ;
I TIUPAR'="" D
.W !,?12,"Parent Document Type: "_$E($P(TIUPAR,"^",1),1,44)
.W !,?12,"Parent Document Date: "_$P(TIUPAR,"^",2)
.W !,?12,"Parent Document Cosigner: "_$P(TIUPAR,"^",3)
Q
;
NITE ; ENTRY POINT FOR RUNNING IN TASKMAN
N TIUIEN,TIUDT,TIUDTS,TIUPDT,TIUJ,TIUPIEN,TIUPN,TIURES,TIU0,TIU12
N TIUEDT,TIUAUTH,TIUTITLE,TIUSSN
N %ZIS,POP,NOW,Y,COSTAT,X
S TIUJ=$J,TIUCS=$$COSTAT()
D NOW^%DTC S X1=X,X2=-31 D C^%DTC
S TIUDT=X+.99999999
F S TIUDT=$O(^TIU(8925,"F",TIUDT)) Q:TIUDT="" D
.S TIUIEN=""
.F S TIUIEN=$O(^TIU(8925,"F",TIUDT,TIUIEN)) Q:TIUIEN="" D
..S TIUPDT=$$CHECK(TIUIEN)
..I TIUPDT>0 D SET(TIUJ,TIUPDT,TIUIEN)
D MAIL
K ^TMP(TIUJ)
D ^%ZISC
Q
;
SET(TIUJ,TIUDT,TIUIEN) ; TEMP STORAGE OF DATA
N TIUTYP,TIUPIEN,TIUPIEN,TIUPDT,TIUPTYP,TIUPCO,TIUPAR,Y
S TIUPAR=""
S TIUTYP=$P(^TIU(8925,TIUIEN,0),"^"),TIUTYP=$P(^TIU(8925.1,TIUTYP,0),"^")
I TIUTYP="ADDENDUM" D
.S TIUPIEN=$P(^TIU(8925,TIUIEN,0),"^",6)
.Q:+TIUPIEN'>0
.Q:'$D(^TIU(8925,TIUPIEN))
.S Y=$P(^TIU(8925,TIUPIEN,12),"^") D DD^%DT S TIUPDT=Y
.S TIUPTYP=$P(^TIU(8925,TIUPIEN,0),"^"),TIUPTYP=$P(^TIU(8925.1,TIUPTYP,0),"^")
.S TIUPCO=$P($G(^TIU(8925,TIUPIEN,12)),"^",8)
.S TIUPCO=$$GET1^DIQ(200,TIUPCO_",",.01)
.S TIUPAR=TIUPTYP_"^"_TIUPDT_"^"_TIUPCO
S ^TMP(TIUJ,"TIU189","PROBLEM",TIUDT,TIUIEN)=TIUPAR
Q
;
CHECK(TIUIEN) ; CHECK IF THIS IS A PROBLEM NOTE
S TIURES=0
I $P($G(^TIU(8925,TIUIEN,0)),"^",5)=TIUCS D
.S TIU12=$G(^TIU(8925,TIUIEN,12))
.I $P(TIU12,"^",8)<1 S TIURES=$P(TIU12,"^")
Q TIURES
;
MAIL ; SEND MAIL TO MAIL GROUP
N XMDUZ,XMSUBJ,XMTO,DFN,VADM,TIUCNT,TIUAUTE,TIUAUTI,TIUATITL,TIUPIEN,TIUPTYPE,TIUPCO,TIUPAR
N TIULNAME,TIUFNAME,TIUMNAME,TIUSIEN,TIUJIEN,TIUASERV,TIUATITL,TIUAUTI
S XMDUZ="",XMSUBJ="MISSING EXPECTED COSIGNER"
K ^TMP(TIUJ,"MAIL")
S TIUDT="",TIUCNT=1
F S TIUDT=$O(^TMP(TIUJ,"TIU189","PROBLEM",TIUDT)) Q:TIUDT="" D
.S TIUIEN=""
.F S TIUIEN=$O(^TMP(TIUJ,"TIU189","PROBLEM",TIUDT,TIUIEN)) Q:TIUIEN="" D
..S TIU0=$G(^TIU(8925,TIUIEN,0)),TIU12=$G(^TIU(8925,TIUIEN,12))
..S Y=$P(TIU12,"^") D DD^%DT S TIUEDT=Y
..S TIUTITLE=$$GET1^DIQ(8925,TIUIEN_",",.01)
..S DFN=$P(TIU0,"^",2) D DEM^VADPT
..S TIUSSN=$E($P(VADM(2),"^"),6,9)
..S TIULNAME=$P(VADM(1),","),TIUFNAME=$P(VADM(1),",",2),TIUMNAME=$P(TIUFNAME," ",2)
..S TIUPN=$E(TIUFNAME)_$E(TIUMNAME)_$E(TIULNAME)_TIUSSN
..S TIUAUTE=$$GET1^DIQ(8925,TIUIEN_",",1202)
..S TIUAUTI=$P($G(^TIU(8925,TIUIEN,12)),"^",2)
..S TIUSIEN=$$GET1^DIQ(200,TIUAUTI_",",29,"I"),TIUASERV=$$GET1^DIQ(49,TIUSIEN_",",.01)
..S TIUJIEN=$$GET1^DIQ(200,TIUAUTI_",",8,"I"),TIUATITL=$$GET1^DIQ(3.1,TIUJIEN_",",.01)
..S TIUPAR=$G(^TMP(TIUJ,"TIU189","PROBLEM",TIUDT,TIUIEN))
..S ^TMP(TIUJ,"TIU189","MAIL",TIUCNT,0)="PATIENT: "_TIUPN
..S ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+1,0)="ENTRY DATE/TIME: "_TIUEDT
..S ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+2,0)="NOTE TITLE: "_TIUTITLE
..S ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+3,0)="AUTHOR: "_TIUAUTE
..S ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+4,0)="AUTHOR'S SERVICE/SECTION: "_TIUASERV
..S ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+5,0)="AUTHOR'S TITLE: "_TIUATITL
..S ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+6,0)="NOTE IEN: `"_TIUIEN
..S ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+7,0)="PARENT DOCUMENT TYPE: "_$P(TIUPAR,"^",1)
..S ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+8,0)="PARENT DOCUMENT ENTRY DATE: "_$P(TIUPAR,"^",2)
..S ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+9,0)="PARENT DOCUMENT COSIGNER: "_$P(TIUPAR,"^",3)
..S ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+10,0)=""
..S TIUCNT=TIUCNT+11
S XMTO("G.TIU MIS ALERTS")=""
D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,"^TMP($J,""TIU189"",""MAIL"")",.XMTO)
Q
;
HEAD ; HEADER FOR REPORT
I TIURTYP'="NOCOL" W @IOF D TITLE
I TIURTYP="COL80" D Q
.W !,"Patient",?9,"Entry Date/Time",?32,"Title",?53,"Author",?69,"Note IEN"
.W !,"-------",?9,"---------------",?32,"-----",?53,"------",?69,"--------"
.W !
I TIURTYP="COL132" D Q
.W !,"Patient",?9,"Entry Date/Time",?32,"Title",?58,"Author",?83,"Service/Section",?101,"Job Title",?119,"Note IEN"
.W !,"-------",?9,"---------------",?32,"-----",?58,"------",?83,"---------------",?101,"---------",?119,"--------"
.W !
I TIURTYP="NOCOL" D
.I +$G(NOCOL)=0 D
..S NOCOL=1
..W "Patient Name^Entry Date/Time^Title^Author^Service/Section^Job Title^Note IEN^Parent Document Type^"
..W "Parent Document Date^Parent Document Cosigner"
Q
;
TITLE ;
W !,?TIUOFF,"NOTES WITH 'UNCOSIGNED' STATUS THAT DON'T HAVE AN EXPECTED COSIGNER",!!
Q
;
PAGE ; HANDLE PAGING FOR TERMINAL OR PRINTER
Q:TIURTYP="NOCOL"
I $Y>(IOSL-8) D
.I IOST["C-" D PAUSE^VALM1 I $G(DIRUT)=1 S TIUQUIT=1 Q
.D HEAD
Q
;
COSTAT() ; GET UNCOSIGNED STATUS
Q $O(^TIU(8925.6,"B","UNCOSIGNED",""))
;
DEV ; PROMPT FOR OUTPUT DEVICE
N DIR,DIRUT
S DIR(0)="SO^1:80 column;2:132 column;3:Table Export"
S DIR("L",1)="Please select an output format from the following:"
S DIR("L",2)=""
S DIR("L",3)="1 - 80 column standard print [STANDARD]"
S DIR("L",4)="2 - 132 column standard print"
S DIR("L")="3 - Table without headers (export to another application)"
S DIR("B")=1
D ^DIR I $D(DIRUT)!(Y>3) S POP=1 Q
S TIURTYP=$S(Y=1:"COL80",Y=2:"COL132",Y=3:"NOCOL")
I TIURTYP="COL132" D MESS132
I TIURTYP="NOCOL" D MESSNCOL
S TIUOFF=$S(TIURTYP="COL80":5,TIURTYP="COL132":31,1:5)
S %ZIS="Q" D ^%ZIS
Q
;
MESS132 ; Instructional message if printing 132 column version
W !!,"You must configure your terminal so that it will support 132 character"
W !,"emulation and reply 132 to the right margin setting if using HOME"
W !,"as the device."
W !,""
Q
;
MESSNCOL ; Instructional message if printing "^" delimited version
W !!,"OK, you have selected a TABLE output format."
W !,"You must use your personal computer's terminal emulation"
W !,"to capture the output:"
W !,""
W !," 1. Enter at the DEVICE: HOME// prompt "";250;99999999"" "
W !," and do not hit the enter key."
W !," 2. Open a capture file within your terminal emulation program."
W !," 3. Hit enter to start the down load."
W !," 4. Close the capture file when the output stops."
W !,""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIU189 9353 printed Dec 13, 2024@02:38:25 Page 2
TIU189 ;BPFO/JML - UNCOSIGNED WITH NO COSIGNER ; 5/19/05 12:33pm
+1 ;;1.0;Text Integration Utilities;**189**;JUN 20, 1997
+2 ;
+3 ; This report can be run from the menu option
+4 ; TIUMEC - Missing Expected Cosignor Report found under the
+5 ; TIU MAIN MENU MGR option. It can also be added to Taskman with
+6 ; the entry point NITE^TIU189. This option will look for problems
+7 ; in the previous 30 days and upon finding any will send an email to
+8 ; the mail group G.TIU MIS ALERTS.
+9 ;
+1 NEW TIUIEN,TIUDT,TIUDTS,TIUPDT,TIUJ,TIUPIEN,TIUPN,TIURES,TIU0,TIU12,TIUEDT,TIUCS,TIUAUTH,TIUTITLE
+2 NEW TIUPAR,DFN,TIUPCO,TIURTYP,TIUSIEN,TIUSERV,TIUJIEN,TIUJTITL,NOCOL,DIR,TIUAUTHI,TIUQUIT,TIUPAGE,TIUOFF
+3 NEW %ZIS,POP,NOW,Y,COSTAT,X1,X2
+4 SET TIUJ=$JOB
SET TIUCS=$$COSTAT()
+5 DO DTRANGE^TIUADCL(.TIUDTS)
+6 if '$DATA(TIUDTS("BEGDT"))!('$DATA(TIUDTS("ENDDT")))
QUIT
+7 SET X1=TIUDTS("BEGDT")
SET X2=-1
DO C^%DTC
+8 SET TIUDT=X+.99999999
SET TIUEDT=TIUDTS("ENDDT")
+9 DO DEV
+10 if $GET(POP)>0
QUIT
+11 IF $GET(IO("Q"))=1
Begin DoDot:1
+12 NEW ZTRTN,ZTDESC,ZTSAVE
+13 SET ZTRTN="MENU1^TIU189"
SET ZTDESC="Uncosigned Problem Report"
+14 SET ZTSAVE("TIU*")=""
+15 DO ^%ZTLOAD
KILL IO("Q")
End DoDot:1
QUIT
+1 FOR
SET TIUDT=$ORDER(^TIU(8925,"F",TIUDT))
if TIUDT=""!(TIUDT>TIUEDT)
QUIT
Begin DoDot:1
+2 SET TIUIEN=""
+3 FOR
SET TIUIEN=$ORDER(^TIU(8925,"F",TIUDT,TIUIEN))
if TIUIEN=""
QUIT
Begin DoDot:2
+4 SET TIUPDT=$$CHECK(TIUIEN)
+5 IF TIUPDT>0
DO SET(TIUJ,TIUPDT,TIUIEN)
End DoDot:2
End DoDot:1
+6 DO REPORT
+7 KILL ^TMP(TIUJ)
+8 DO ^%ZISC
+9 QUIT
+10 ;
REPORT ; ENTRIES WRITTEN TO REPORT
+1 USE IO
+2 IF $GET(IO("Q"))'=1
IF IOST["C-"
IF TIURTYP'="NOCOL"
WRITE @IOF
+3 IF '$DATA(^TMP(TIUJ,"TIU189"))
Begin DoDot:1
+4 DO TITLE
+5 WRITE !!,"No Problem Notes Found."
+6 IF $GET(IO("Q"))='1
IF IOST["C-"
DO PAUSE^VALM1
End DoDot:1
QUIT
+7 SET TIUQUIT=0
+8 DO HEAD
+9 SET TIUDT=""
+10 FOR
SET TIUDT=$ORDER(^TMP(TIUJ,"TIU189","PROBLEM",TIUDT))
if TIUDT=""!(TIUQUIT)
QUIT
Begin DoDot:1
+11 SET TIUIEN=""
+12 FOR
SET TIUIEN=$ORDER(^TMP(TIUJ,"TIU189","PROBLEM",TIUDT,TIUIEN))
if TIUIEN=""!(TIUQUIT)
QUIT
Begin DoDot:2
+13 DO PAGE
+14 if TIUQUIT
QUIT
+15 SET TIU0=$GET(^TIU(8925,TIUIEN,0))
SET TIU12=$GET(^TIU(8925,TIUIEN,12))
+16 SET Y=$PIECE(TIU12,"^")
DO DD^%DT
SET TIUEDT=Y
+17 SET DFN=$PIECE(TIU0,"^",2)
DO DEM^VADPT
+18 SET TIUSSN=$EXTRACT($PIECE(VADM(2),"^"),6,9)
+19 SET TIULNAME=$PIECE(VADM(1),",")
SET TIUFNAME=$PIECE(VADM(1),",",2)
SET TIUMNAME=$PIECE(TIUFNAME," ",2)
+20 SET TIUPN=$EXTRACT(TIUFNAME)_$EXTRACT(TIUMNAME)_$EXTRACT(TIULNAME)_TIUSSN
+21 SET TIUAUTH=$EXTRACT($$GET1^DIQ(8925,TIUIEN_",",1202),1,15)
+22 SET TIUAUTHI=$PIECE($GET(^TIU(8925,TIUIEN,12)),"^",2)
+23 SET TIUTITLE=$EXTRACT($$GET1^DIQ(8925,TIUIEN_",",.01),1,15)
+24 SET TIUSIEN=$$GET1^DIQ(200,TIUAUTHI_",",29,"I")
SET TIUSERV=$$GET1^DIQ(49,TIUSIEN_",",.01)
+25 SET TIUJIEN=$$GET1^DIQ(200,TIUAUTHI_",",8,"I")
SET TIUJTITL=$$GET1^DIQ(3.1,TIUJIEN_",",.01)
+26 SET TIUPAR=^TMP(TIUJ,"TIU189","PROBLEM",TIUDT,TIUIEN)
+27 IF TIURTYP="COL80"
Begin DoDot:3
+28 WRITE !,TIUPN,?9,TIUEDT,?32,$EXTRACT(TIUTITLE,1,20),?53,$EXTRACT(TIUAUTH,1,15),?69,"~",TIUIEN
+29 DO TIUPAR(TIUPAR)
End DoDot:3
+30 IF TIURTYP="COL132"
Begin DoDot:3
+31 WRITE !,TIUPN,?9,TIUEDT,?32,$EXTRACT(TIUTITLE,1,24),?58,$EXTRACT(TIUAUTH,1,23),?83,$EXTRACT(TIUSERV,1,16)
+32 WRITE ?101,$EXTRACT(TIUJTITL,1,16),?119,"~",TIUIEN
+33 DO TIUPAR(TIUPAR)
End DoDot:3
+34 IF TIURTYP="NOCOL"
Begin DoDot:3
+35 WRITE !,TIUPN,"^",TIUEDT,"^",TIUTITLE,"^",TIUAUTH,"^",TIUSERV,"^",TIUJTITL,"^",TIUIEN
+36 WRITE "^",$PIECE(TIUPAR,"^",1),"^",$PIECE(TIUPAR,"^",2),"^",$PIECE(TIUPAR,"^",3)
End DoDot:3
End DoDot:2
End DoDot:1
+37 IF $GET(IO("Q"))'=1
IF IOST["C-"
IF TIURTYP'="NOCOL"
DO PAUSE^VALM1
WRITE @IOF
+38 QUIT
+39 ;
TIUPAR(TIUPAR) ;
+1 IF TIUPAR'=""
Begin DoDot:1
+2 WRITE !,?12,"Parent Document Type: "_$EXTRACT($PIECE(TIUPAR,"^",1),1,44)
+3 WRITE !,?12,"Parent Document Date: "_$PIECE(TIUPAR,"^",2)
+4 WRITE !,?12,"Parent Document Cosigner: "_$PIECE(TIUPAR,"^",3)
End DoDot:1
+5 QUIT
+6 ;
NITE ; ENTRY POINT FOR RUNNING IN TASKMAN
+1 NEW TIUIEN,TIUDT,TIUDTS,TIUPDT,TIUJ,TIUPIEN,TIUPN,TIURES,TIU0,TIU12
+2 NEW TIUEDT,TIUAUTH,TIUTITLE,TIUSSN
+3 NEW %ZIS,POP,NOW,Y,COSTAT,X
+4 SET TIUJ=$JOB
SET TIUCS=$$COSTAT()
+5 DO NOW^%DTC
SET X1=X
SET X2=-31
DO C^%DTC
+6 SET TIUDT=X+.99999999
+7 FOR
SET TIUDT=$ORDER(^TIU(8925,"F",TIUDT))
if TIUDT=""
QUIT
Begin DoDot:1
+8 SET TIUIEN=""
+9 FOR
SET TIUIEN=$ORDER(^TIU(8925,"F",TIUDT,TIUIEN))
if TIUIEN=""
QUIT
Begin DoDot:2
+10 SET TIUPDT=$$CHECK(TIUIEN)
+11 IF TIUPDT>0
DO SET(TIUJ,TIUPDT,TIUIEN)
End DoDot:2
End DoDot:1
+12 DO MAIL
+13 KILL ^TMP(TIUJ)
+14 DO ^%ZISC
+15 QUIT
+16 ;
SET(TIUJ,TIUDT,TIUIEN) ; TEMP STORAGE OF DATA
+1 NEW TIUTYP,TIUPIEN,TIUPIEN,TIUPDT,TIUPTYP,TIUPCO,TIUPAR,Y
+2 SET TIUPAR=""
+3 SET TIUTYP=$PIECE(^TIU(8925,TIUIEN,0),"^")
SET TIUTYP=$PIECE(^TIU(8925.1,TIUTYP,0),"^")
+4 IF TIUTYP="ADDENDUM"
Begin DoDot:1
+5 SET TIUPIEN=$PIECE(^TIU(8925,TIUIEN,0),"^",6)
+6 if +TIUPIEN'>0
QUIT
+7 if '$DATA(^TIU(8925,TIUPIEN))
QUIT
+8 SET Y=$PIECE(^TIU(8925,TIUPIEN,12),"^")
DO DD^%DT
SET TIUPDT=Y
+9 SET TIUPTYP=$PIECE(^TIU(8925,TIUPIEN,0),"^")
SET TIUPTYP=$PIECE(^TIU(8925.1,TIUPTYP,0),"^")
+10 SET TIUPCO=$PIECE($GET(^TIU(8925,TIUPIEN,12)),"^",8)
+11 SET TIUPCO=$$GET1^DIQ(200,TIUPCO_",",.01)
+12 SET TIUPAR=TIUPTYP_"^"_TIUPDT_"^"_TIUPCO
End DoDot:1
+13 SET ^TMP(TIUJ,"TIU189","PROBLEM",TIUDT,TIUIEN)=TIUPAR
+14 QUIT
+15 ;
CHECK(TIUIEN) ; CHECK IF THIS IS A PROBLEM NOTE
+1 SET TIURES=0
+2 IF $PIECE($GET(^TIU(8925,TIUIEN,0)),"^",5)=TIUCS
Begin DoDot:1
+3 SET TIU12=$GET(^TIU(8925,TIUIEN,12))
+4 IF $PIECE(TIU12,"^",8)<1
SET TIURES=$PIECE(TIU12,"^")
End DoDot:1
+5 QUIT TIURES
+6 ;
MAIL ; SEND MAIL TO MAIL GROUP
+1 NEW XMDUZ,XMSUBJ,XMTO,DFN,VADM,TIUCNT,TIUAUTE,TIUAUTI,TIUATITL,TIUPIEN,TIUPTYPE,TIUPCO,TIUPAR
+2 NEW TIULNAME,TIUFNAME,TIUMNAME,TIUSIEN,TIUJIEN,TIUASERV,TIUATITL,TIUAUTI
+3 SET XMDUZ=""
SET XMSUBJ="MISSING EXPECTED COSIGNER"
+4 KILL ^TMP(TIUJ,"MAIL")
+5 SET TIUDT=""
SET TIUCNT=1
+6 FOR
SET TIUDT=$ORDER(^TMP(TIUJ,"TIU189","PROBLEM",TIUDT))
if TIUDT=""
QUIT
Begin DoDot:1
+7 SET TIUIEN=""
+8 FOR
SET TIUIEN=$ORDER(^TMP(TIUJ,"TIU189","PROBLEM",TIUDT,TIUIEN))
if TIUIEN=""
QUIT
Begin DoDot:2
+9 SET TIU0=$GET(^TIU(8925,TIUIEN,0))
SET TIU12=$GET(^TIU(8925,TIUIEN,12))
+10 SET Y=$PIECE(TIU12,"^")
DO DD^%DT
SET TIUEDT=Y
+11 SET TIUTITLE=$$GET1^DIQ(8925,TIUIEN_",",.01)
+12 SET DFN=$PIECE(TIU0,"^",2)
DO DEM^VADPT
+13 SET TIUSSN=$EXTRACT($PIECE(VADM(2),"^"),6,9)
+14 SET TIULNAME=$PIECE(VADM(1),",")
SET TIUFNAME=$PIECE(VADM(1),",",2)
SET TIUMNAME=$PIECE(TIUFNAME," ",2)
+15 SET TIUPN=$EXTRACT(TIUFNAME)_$EXTRACT(TIUMNAME)_$EXTRACT(TIULNAME)_TIUSSN
+16 SET TIUAUTE=$$GET1^DIQ(8925,TIUIEN_",",1202)
+17 SET TIUAUTI=$PIECE($GET(^TIU(8925,TIUIEN,12)),"^",2)
+18 SET TIUSIEN=$$GET1^DIQ(200,TIUAUTI_",",29,"I")
SET TIUASERV=$$GET1^DIQ(49,TIUSIEN_",",.01)
+19 SET TIUJIEN=$$GET1^DIQ(200,TIUAUTI_",",8,"I")
SET TIUATITL=$$GET1^DIQ(3.1,TIUJIEN_",",.01)
+20 SET TIUPAR=$GET(^TMP(TIUJ,"TIU189","PROBLEM",TIUDT,TIUIEN))
+21 SET ^TMP(TIUJ,"TIU189","MAIL",TIUCNT,0)="PATIENT: "_TIUPN
+22 SET ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+1,0)="ENTRY DATE/TIME: "_TIUEDT
+23 SET ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+2,0)="NOTE TITLE: "_TIUTITLE
+24 SET ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+3,0)="AUTHOR: "_TIUAUTE
+25 SET ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+4,0)="AUTHOR'S SERVICE/SECTION: "_TIUASERV
+26 SET ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+5,0)="AUTHOR'S TITLE: "_TIUATITL
+27 SET ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+6,0)="NOTE IEN: `"_TIUIEN
+28 SET ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+7,0)="PARENT DOCUMENT TYPE: "_$PIECE(TIUPAR,"^",1)
+29 SET ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+8,0)="PARENT DOCUMENT ENTRY DATE: "_$PIECE(TIUPAR,"^",2)
+30 SET ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+9,0)="PARENT DOCUMENT COSIGNER: "_$PIECE(TIUPAR,"^",3)
+31 SET ^TMP(TIUJ,"TIU189","MAIL",TIUCNT+10,0)=""
+32 SET TIUCNT=TIUCNT+11
End DoDot:2
End DoDot:1
+33 SET XMTO("G.TIU MIS ALERTS")=""
+34 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,"^TMP($J,""TIU189"",""MAIL"")",.XMTO)
+35 QUIT
+36 ;
HEAD ; HEADER FOR REPORT
+1 IF TIURTYP'="NOCOL"
WRITE @IOF
DO TITLE
+2 IF TIURTYP="COL80"
Begin DoDot:1
+3 WRITE !,"Patient",?9,"Entry Date/Time",?32,"Title",?53,"Author",?69,"Note IEN"
+4 WRITE !,"-------",?9,"---------------",?32,"-----",?53,"------",?69,"--------"
+5 WRITE !
End DoDot:1
QUIT
+6 IF TIURTYP="COL132"
Begin DoDot:1
+7 WRITE !,"Patient",?9,"Entry Date/Time",?32,"Title",?58,"Author",?83,"Service/Section",?101,"Job Title",?119,"Note IEN"
+8 WRITE !,"-------",?9,"---------------",?32,"-----",?58,"------",?83,"---------------",?101,"---------",?119,"--------"
+9 WRITE !
End DoDot:1
QUIT
+10 IF TIURTYP="NOCOL"
Begin DoDot:1
+11 IF +$GET(NOCOL)=0
Begin DoDot:2
+12 SET NOCOL=1
+13 WRITE "Patient Name^Entry Date/Time^Title^Author^Service/Section^Job Title^Note IEN^Parent Document Type^"
+14 WRITE "Parent Document Date^Parent Document Cosigner"
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
TITLE ;
+1 WRITE !,?TIUOFF,"NOTES WITH 'UNCOSIGNED' STATUS THAT DON'T HAVE AN EXPECTED COSIGNER",!!
+2 QUIT
+3 ;
PAGE ; HANDLE PAGING FOR TERMINAL OR PRINTER
+1 if TIURTYP="NOCOL"
QUIT
+2 IF $Y>(IOSL-8)
Begin DoDot:1
+3 IF IOST["C-"
DO PAUSE^VALM1
IF $GET(DIRUT)=1
SET TIUQUIT=1
QUIT
+4 DO HEAD
End DoDot:1
+5 QUIT
+6 ;
COSTAT() ; GET UNCOSIGNED STATUS
+1 QUIT $ORDER(^TIU(8925.6,"B","UNCOSIGNED",""))
+2 ;
DEV ; PROMPT FOR OUTPUT DEVICE
+1 NEW DIR,DIRUT
+2 SET DIR(0)="SO^1:80 column;2:132 column;3:Table Export"
+3 SET DIR("L",1)="Please select an output format from the following:"
+4 SET DIR("L",2)=""
+5 SET DIR("L",3)="1 - 80 column standard print [STANDARD]"
+6 SET DIR("L",4)="2 - 132 column standard print"
+7 SET DIR("L")="3 - Table without headers (export to another application)"
+8 SET DIR("B")=1
+9 DO ^DIR
IF $DATA(DIRUT)!(Y>3)
SET POP=1
QUIT
+10 SET TIURTYP=$SELECT(Y=1:"COL80",Y=2:"COL132",Y=3:"NOCOL")
+11 IF TIURTYP="COL132"
DO MESS132
+12 IF TIURTYP="NOCOL"
DO MESSNCOL
+13 SET TIUOFF=$SELECT(TIURTYP="COL80":5,TIURTYP="COL132":31,1:5)
+14 SET %ZIS="Q"
DO ^%ZIS
+15 QUIT
+16 ;
MESS132 ; Instructional message if printing 132 column version
+1 WRITE !!,"You must configure your terminal so that it will support 132 character"
+2 WRITE !,"emulation and reply 132 to the right margin setting if using HOME"
+3 WRITE !,"as the device."
+4 WRITE !,""
+5 QUIT
+6 ;
MESSNCOL ; Instructional message if printing "^" delimited version
+1 WRITE !!,"OK, you have selected a TABLE output format."
+2 WRITE !,"You must use your personal computer's terminal emulation"
+3 WRITE !,"to capture the output:"
+4 WRITE !,""
+5 WRITE !," 1. Enter at the DEVICE: HOME// prompt "";250;99999999"" "
+6 WRITE !," and do not hit the enter key."
+7 WRITE !," 2. Open a capture file within your terminal emulation program."
+8 WRITE !," 3. Hit enter to start the down load."
+9 WRITE !," 4. Close the capture file when the output stops."
+10 WRITE !,""
+11 QUIT
