- 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
