- 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 Jan 18, 2025@03:39:34 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