TIUPS155 ; SLC/CAM - Amended consult note clean up ;2/26/03
;;1.0;TEXT INTEGRATION UTILITIES;**155**;Jun 20,1997
;
; Disassociates the retracted consult note from the consult
; Links the amended note to the consult
; This routine should only need to be run once. It can be deleted after
; it has successfully completed.
; DBIA 10035 ^DPT( .01 NAME 0;1 Direct Global Read
; DBIA 3576 TIU use of GMRCTIU
; DBIA 3162 POINT TO REQUEST/CONSULTATION (#123) FILE
;
PRINT ; -- Device Selection
;
S %ZIS="Q" D ^%ZIS I POP K POP G PRT
I $D(IO("Q")) K IO("Q") D Q
. S ZTRTN="LINK^TIUPS155"
. S ZTDESC="TIU*1*155 - PRINT CLEAN-UP RESULTS"
. D ^%ZTLOAD W !,$S($D(ZTSK):"Request queued",1:"Request Cancelled!")
. K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,%ZIS
. D HOME^%ZIS
U IO D LINK,^%ZISC
PRT Q
;
LINK ; Updates the GMR global with the amended consult note. Stores in XTMP global
; Rollsback retracted note from ^GMR(123 node 50
N TIUDA,TIUDA2,STATUS,GMRCSTAT,TIUAUTH,FLAG
N CNSERV,TIUPT,TIUPT1,TIUCNT,CNSLT,TIUY,TIUODA
; Variables
; TIUPT = Patient DFN
; TIUPT1 = Patient name
; CNSERV = To consult service
; TIUDA = IEN of note in TIU "G" cross ref
; TIUDA2 = IEN of note in GMR "B" cross ref of 50 node
; TIUODA = IEN of retracted note
I $D(ZTQUEUED) S ZTREQ="@"
S U="^"
S TIUCNT=0,CNSLT=""
D HDR
F S CNSLT=$O(^TIU(8925,"G",CNSLT)) Q:CNSLT="" I CNSLT["GMR" D
.S TIUDA=0
.F S TIUDA=$O(^TIU(8925,"G",CNSLT,TIUDA)) Q:TIUDA="" D
..S STATUS=$P($G(^TIU(8925,TIUDA,0)),U,5) I STATUS=8 D
...S TIUY=+$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),+$$CLASS^TIUCNSLT)
...I TIUY=1 D
....S TIUDA2=0
....S FLAG="NO" F S TIUDA2=$O(^GMR(123,+CNSLT,50,"B",TIUDA2)) Q:TIUDA2="" I +TIUDA2=TIUDA S FLAG="YES" Q
....I FLAG="NO" D
.....S TIUCNT=TIUCNT+1
.....S TIUODA=$P($G(^TIU(8925,TIUDA,14)),U,6)
.....S TIUPT=$P($G(^TIU(8925,TIUDA,0)),U,2)
.....S TIUPT1=$P($G(^DPT(TIUPT,0)),U) I $L(TIUPT1)<25 S TIUPT1=$$ADDSP(TIUPT1)
.....S CNSERV=$$GET1^DIQ(123,+CNSLT,1) I $L(CNSERV)<25 S CNSERV=$$ADDSP(CNSERV)
.....S ^XTMP("TIUP155",$J,TIUCNT)=$E(TIUPT1,1,25)_" Consult No. "_+CNSLT
.....S GMRCSTAT=$S(STATUS>6:"COMPLETED",1:"INCOMPLETE")
.....S TIUAUTH=$P($G(^TIU(8925,TIUDA,12)),U,2)
.....D ROLLBACK^TIUCNSLT(TIUODA)
.....D GET^GMRCTIU(+CNSLT,TIUDA,GMRCSTAT,TIUAUTH)
.....W !,$E(TIUPT1,1,20),?22,$E(CNSERV,1,20),?45,+CNSLT
W !
I TIUCNT'>0 W !,"There are no records to print."
D MAIL
W !
Q
ADDSP(TIUY) ; Add space to name for display.
;
N SPC,LEN,ADSP,CNT
S SPC=" ",LEN=$L(TIUY),ADSP=25-LEN
F CNT=1:1:ADSP S TIUY=TIUY_SPC
Q TIUY
MAIL ; Send mail message
;
N XMSUB,XMTEXT,XMY,XMTXT,XMDUZ
S XMSUB="TIU*1*155 Amended Note - Consult Clean up Report",XMDUZ="Patch TIU*1*155"
I '$D(^XTMP("TIUP155")) S XMTXT(1)="",XMTXT(2)="",XMTXT(3)="There are no records to print.",XMTEXT="XMTXT("
I $D(^XTMP("TIUP155")) S XMTEXT="^XTMP(""TIUP155"",$J,"
S:$G(DUZ) XMY(DUZ)=""
S XMY("G.PATIENT SAFETY NOTIFICATIONS")=""
D ^XMD
Q
HDR ; --Header for report--
;
W !,?2,"TIU*1.0*155 Amended Note - Consult Clean Up Report"
W !!,"The following consult(s) have been updated to display and print amended"
W !,"notes on the Consult Tab."
W !!,"Patient",?22,"Consult Request",?45,"Consult No.",!
Q
TIUPS155 ; SLC/CAM - Amended consult note clean up ;2/26/03
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**155**;Jun 20,1997
+2 ;
+3 ; Disassociates the retracted consult note from the consult
+4 ; Links the amended note to the consult
+5 ; This routine should only need to be run once. It can be deleted after
+6 ; it has successfully completed.
+7 ; DBIA 10035 ^DPT( .01 NAME 0;1 Direct Global Read
+8 ; DBIA 3576 TIU use of GMRCTIU
+9 ; DBIA 3162 POINT TO REQUEST/CONSULTATION (#123) FILE
+10 ;
PRINT ; -- Device Selection
+1 ;
+2 SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL POP
GOTO PRT
+3 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+4 SET ZTRTN="LINK^TIUPS155"
+5 SET ZTDESC="TIU*1*155 - PRINT CLEAN-UP RESULTS"
+6 DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request queued",1:"Request Cancelled!")
+7 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,%ZIS
+8 DO HOME^%ZIS
End DoDot:1
QUIT
+9 USE IO
DO LINK
DO ^%ZISC
PRT QUIT
+1 ;
LINK ; Updates the GMR global with the amended consult note. Stores in XTMP global
+1 ; Rollsback retracted note from ^GMR(123 node 50
+2 NEW TIUDA,TIUDA2,STATUS,GMRCSTAT,TIUAUTH,FLAG
+3 NEW CNSERV,TIUPT,TIUPT1,TIUCNT,CNSLT,TIUY,TIUODA
+4 ; Variables
+5 ; TIUPT = Patient DFN
+6 ; TIUPT1 = Patient name
+7 ; CNSERV = To consult service
+8 ; TIUDA = IEN of note in TIU "G" cross ref
+9 ; TIUDA2 = IEN of note in GMR "B" cross ref of 50 node
+10 ; TIUODA = IEN of retracted note
+11 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+12 SET U="^"
+13 SET TIUCNT=0
SET CNSLT=""
+14 DO HDR
+15 FOR
SET CNSLT=$ORDER(^TIU(8925,"G",CNSLT))
IF CNSLT=""
QUIT
IF CNSLT["GMR"
Begin DoDot:1
+16 SET TIUDA=0
+17 FOR
SET TIUDA=$ORDER(^TIU(8925,"G",CNSLT,TIUDA))
IF TIUDA=""
QUIT
Begin DoDot:2
+18 SET STATUS=$PIECE($GET(^TIU(8925,TIUDA,0)),U,5)
IF STATUS=8
Begin DoDot:3
+19 SET TIUY=+$$ISA^TIULX(+$GET(^TIU(8925,TIUDA,0)),+$$CLASS^TIUCNSLT)
+20 IF TIUY=1
Begin DoDot:4
+21 SET TIUDA2=0
+22 SET FLAG="NO"
FOR
SET TIUDA2=$ORDER(^GMR(123,+CNSLT,50,"B",TIUDA2))
IF TIUDA2=""
QUIT
IF +TIUDA2=TIUDA
SET FLAG="YES"
QUIT
+23 IF FLAG="NO"
Begin DoDot:5
+24 SET TIUCNT=TIUCNT+1
+25 SET TIUODA=$PIECE($GET(^TIU(8925,TIUDA,14)),U,6)
+26 SET TIUPT=$PIECE($GET(^TIU(8925,TIUDA,0)),U,2)
+27 SET TIUPT1=$PIECE($GET(^DPT(TIUPT,0)),U)
IF $LENGTH(TIUPT1)<25
SET TIUPT1=$$ADDSP(TIUPT1)
+28 SET CNSERV=$$GET1^DIQ(123,+CNSLT,1)
IF $LENGTH(CNSERV)<25
SET CNSERV=$$ADDSP(CNSERV)
+29 SET ^XTMP("TIUP155",$JOB,TIUCNT)=$EXTRACT(TIUPT1,1,25)_" Consult No. "_+CNSLT
+30 SET GMRCSTAT=$SELECT(STATUS>6:"COMPLETED",1:"INCOMPLETE")
+31 SET TIUAUTH=$PIECE($GET(^TIU(8925,TIUDA,12)),U,2)
+32 DO ROLLBACK^TIUCNSLT(TIUODA)
+33 DO GET^GMRCTIU(+CNSLT,TIUDA,GMRCSTAT,TIUAUTH)
+34 WRITE !,$EXTRACT(TIUPT1,1,20),?22,$EXTRACT(CNSERV,1,20),?45,+CNSLT
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 WRITE !
+36 IF TIUCNT'>0
WRITE !,"There are no records to print."
+37 DO MAIL
+38 WRITE !
+39 QUIT
ADDSP(TIUY) ; Add space to name for display.
+1 ;
+2 NEW SPC,LEN,ADSP,CNT
+3 SET SPC=" "
SET LEN=$LENGTH(TIUY)
SET ADSP=25-LEN
+4 FOR CNT=1:1:ADSP
SET TIUY=TIUY_SPC
+5 QUIT TIUY
MAIL ; Send mail message
+1 ;
+2 NEW XMSUB,XMTEXT,XMY,XMTXT,XMDUZ
+3 SET XMSUB="TIU*1*155 Amended Note - Consult Clean up Report"
SET XMDUZ="Patch TIU*1*155"
+4 IF '$DATA(^XTMP("TIUP155"))
SET XMTXT(1)=""
SET XMTXT(2)=""
SET XMTXT(3)="There are no records to print."
SET XMTEXT="XMTXT("
+5 IF $DATA(^XTMP("TIUP155"))
SET XMTEXT="^XTMP(""TIUP155"",$J,"
+6 IF $GET(DUZ)
SET XMY(DUZ)=""
+7 SET XMY("G.PATIENT SAFETY NOTIFICATIONS")=""
+8 DO ^XMD
+9 QUIT
HDR ; --Header for report--
+1 ;
+2 WRITE !,?2,"TIU*1.0*155 Amended Note - Consult Clean Up Report"
+3 WRITE !!,"The following consult(s) have been updated to display and print amended"
+4 WRITE !,"notes on the Consult Tab."
+5 WRITE !!,"Patient",?22,"Consult Request",?45,"Consult No.",!
+6 QUIT
