TIUPNCV6 ;SLC/DJP ;PNs ==> TIU cnv rtns ;5-7-97
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
;
TLSRCH ;Utility to search ^TIU(8925.1 FOR ^GMR(121.2 titles
K DIR W @IOF W !!?14,"***** TITLE REPORT *****"
W !!?5,"This option will identify TITLES in ^GMR(121.2,"
W !?5,"Generic Progress Note Title File which are NOT"
W !?5,"defined in ^TIU(8925.1, TIU Document Definition File."
W !!?5,"It is important for a successful conversion that"
W !?5,"all Progress Note Titles be defined as Documents"
W !?5,"within ^TIU(8925.1. The exceptions to this rule are"
W !?5,"titles which have been retired or inactivated. They"
W !?5,"do not need to be entered in the file."
W !! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue"
S DIR("B")="YES",DIR("?")="^D HELP8^TIUPNCV6"
D ^DIR K DIR I $D(DIRUT)!(Y=0) Q
D DEVICE
Q
;
LOOPT ;Loops through ^GMR(121.2
U IO
S CTR=0 F LKUP=0:0 S LKUP=$O(^GMR(121.2,LKUP)) Q:LKUP<1 D SRCH
D HDR,PRINT
K LKUP,GMRPTL,CTR,TIU,PRT,TIULN
K ^TMP("TIUTIL")
Q
;
SRCH ;Lookup on ^TIU(8925.1, TIU Document Definition File
S TIUFPRIV=1
S GMRPTL=$P(^GMR(121.2,LKUP,0),U,1)
I $P($G(^GMR(121.2,LKUP,0)),U,4)="1" D RETIRED Q
S X=$$UPPER^TIULS(GMRPTL),TYP="DOC"
K DIC S DIC(0)="XZ",DIC="^TIU(8925.1,"
S DIC("S")="I $P($G(^(0)),U,4)=TYP"
D ^DIC K DIC,TYP I Y<1 D NOTR Q
I $P(Y(0),U,4)'="DOC" D NORING
Q
;
NOTR ;Title not found in ^TIU(8925.1
S CTR=CTR+1
S ^TMP("TIUTIL",$J,CTR)=CTR_". "_GMRPTL_" not found in ^TIU(8925.1."
Q
NORING ;Title found in file but not defined as a DOCUMENT
S CTR=CTR+1
S ^TMP("TIUTIL",$J,CTR)=CTR_". "_GMRPTL_" not defined as a DOCUMENT."
Q
;
RETIRED ;Title assigned to existing note but RETIRED from further use
S CTR=CTR+1
S ^TMP("TIUTIL",$J,CTR)=CTR_". "_GMRPTL_" RETIRED."
Q
;
PRINT ;Prints Undefined Title Report
I '$D(^TMP("TIUTIL",$J))
I W !!,?19,"NO DISCREPANCIES FOUND",!?19,"**************",! Q
F PRT=0:0 S PRT=$O(^TMP("TIUTIL",$J,PRT)) Q:PRT<1 W !?5,^TMP("TIUTIL",$J,PRT),! D:PRT=CTR LASTLN Q:$D(TIU("QUIT")) D LNCK Q:$D(TIU("QUIT"))
Q
;
DEVICE ;prompts for device selection
K IOP S %ZIS="Q" D ^%ZIS I POP K POP Q
I $D(IO("Q")) K IO("Q") D Q
.S ZTSAVE("TIU*")="",ZTSAVE("GMRP*")=""
.S ZTRTN="LOOPT^TIUPNCV6",ZTDESC="TIU/GMRPN TITLE SEARCH" D ^%ZTLOAD
.W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled."),!
.K ZTRTN,ZTDESC,ZTSAVE
.D HOME^%ZIS
D LOOPT,^%ZISC
Q
;
LNCK ;Check current $Y value for paging
I IOST?1"P".E Q:$Y'>(IOSL-9) D HDR Q
I $Y>(IOSL-3) D RETURN I '$D(TIU("QUIT")) D HDR
Q
;
RETURN ;Issues RETURN prompt
K DIR F TIULN=1:1:(IOSL-$Y-4) W !
S DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S TIU("QUIT")=1 Q
I Y="" W @IOF
Q
;
HDR ;Header Line for Title Report
W !!?12,"****** UNDEFINED TITLE REPORT ******",!!
Q
;
LASTLN ;End of report
W !!?12,"****** END OF REPORT ******"
S TIU("QUIT")=1
Q
;
HELP8 ;Help text for SEARCH prompt
W !!?5,"Press <ret> to continue with compare of the Progress"
W !?5,"Note Title File and the TIU Document Definition File."
W !?5,"Enter NO or ""^"" to stop this option."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPNCV6 3143 printed Apr 09, 2024@21:41:57 Page 2
TIUPNCV6 ;SLC/DJP ;PNs ==> TIU cnv rtns ;5-7-97
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
+2 ;
TLSRCH ;Utility to search ^TIU(8925.1 FOR ^GMR(121.2 titles
+1 KILL DIR
WRITE @IOF
WRITE !!?14,"***** TITLE REPORT *****"
+2 WRITE !!?5,"This option will identify TITLES in ^GMR(121.2,"
+3 WRITE !?5,"Generic Progress Note Title File which are NOT"
+4 WRITE !?5,"defined in ^TIU(8925.1, TIU Document Definition File."
+5 WRITE !!?5,"It is important for a successful conversion that"
+6 WRITE !?5,"all Progress Note Titles be defined as Documents"
+7 WRITE !?5,"within ^TIU(8925.1. The exceptions to this rule are"
+8 WRITE !?5,"titles which have been retired or inactivated. They"
+9 WRITE !?5,"do not need to be entered in the file."
+10 WRITE !!
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
+11 SET DIR("B")="YES"
SET DIR("?")="^D HELP8^TIUPNCV6"
+12 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(Y=0)
QUIT
+13 DO DEVICE
+14 QUIT
+15 ;
LOOPT ;Loops through ^GMR(121.2
+1 USE IO
+2 SET CTR=0
FOR LKUP=0:0
SET LKUP=$ORDER(^GMR(121.2,LKUP))
if LKUP<1
QUIT
DO SRCH
+3 DO HDR
DO PRINT
+4 KILL LKUP,GMRPTL,CTR,TIU,PRT,TIULN
+5 KILL ^TMP("TIUTIL")
+6 QUIT
+7 ;
SRCH ;Lookup on ^TIU(8925.1, TIU Document Definition File
+1 SET TIUFPRIV=1
+2 SET GMRPTL=$PIECE(^GMR(121.2,LKUP,0),U,1)
+3 IF $PIECE($GET(^GMR(121.2,LKUP,0)),U,4)="1"
DO RETIRED
QUIT
+4 SET X=$$UPPER^TIULS(GMRPTL)
SET TYP="DOC"
+5 KILL DIC
SET DIC(0)="XZ"
SET DIC="^TIU(8925.1,"
+6 SET DIC("S")="I $P($G(^(0)),U,4)=TYP"
+7 DO ^DIC
KILL DIC,TYP
IF Y<1
DO NOTR
QUIT
+8 IF $PIECE(Y(0),U,4)'="DOC"
DO NORING
+9 QUIT
+10 ;
NOTR ;Title not found in ^TIU(8925.1
+1 SET CTR=CTR+1
+2 SET ^TMP("TIUTIL",$JOB,CTR)=CTR_". "_GMRPTL_" not found in ^TIU(8925.1."
+3 QUIT
NORING ;Title found in file but not defined as a DOCUMENT
+1 SET CTR=CTR+1
+2 SET ^TMP("TIUTIL",$JOB,CTR)=CTR_". "_GMRPTL_" not defined as a DOCUMENT."
+3 QUIT
+4 ;
RETIRED ;Title assigned to existing note but RETIRED from further use
+1 SET CTR=CTR+1
+2 SET ^TMP("TIUTIL",$JOB,CTR)=CTR_". "_GMRPTL_" RETIRED."
+3 QUIT
+4 ;
PRINT ;Prints Undefined Title Report
+1 IF '$DATA(^TMP("TIUTIL",$JOB))
+2 IF $TEST
WRITE !!,?19,"NO DISCREPANCIES FOUND",!?19,"**************",!
QUIT
+3 FOR PRT=0:0
SET PRT=$ORDER(^TMP("TIUTIL",$JOB,PRT))
if PRT<1
QUIT
WRITE !?5,^TMP("TIUTIL",$JOB,PRT),!
if PRT=CTR
DO LASTLN
if $DATA(TIU("QUIT"))
QUIT
DO LNCK
if $DATA(TIU("QUIT"))
QUIT
+4 QUIT
+5 ;
DEVICE ;prompts for device selection
+1 KILL IOP
SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL POP
QUIT
+2 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+3 SET ZTSAVE("TIU*")=""
SET ZTSAVE("GMRP*")=""
+4 SET ZTRTN="LOOPT^TIUPNCV6"
SET ZTDESC="TIU/GMRPN TITLE SEARCH"
DO ^%ZTLOAD
+5 WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled."),!
+6 KILL ZTRTN,ZTDESC,ZTSAVE
+7 DO HOME^%ZIS
End DoDot:1
QUIT
+8 DO LOOPT
DO ^%ZISC
+9 QUIT
+10 ;
LNCK ;Check current $Y value for paging
+1 IF IOST?1"P".E
if $Y'>(IOSL-9)
QUIT
DO HDR
QUIT
+2 IF $Y>(IOSL-3)
DO RETURN
IF '$DATA(TIU("QUIT"))
DO HDR
+3 QUIT
+4 ;
RETURN ;Issues RETURN prompt
+1 KILL DIR
FOR TIULN=1:1:(IOSL-$Y-4)
WRITE !
+2 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET TIU("QUIT")=1
QUIT
+3 IF Y=""
WRITE @IOF
+4 QUIT
+5 ;
HDR ;Header Line for Title Report
+1 WRITE !!?12,"****** UNDEFINED TITLE REPORT ******",!!
+2 QUIT
+3 ;
LASTLN ;End of report
+1 WRITE !!?12,"****** END OF REPORT ******"
+2 SET TIU("QUIT")=1
+3 QUIT
+4 ;
HELP8 ;Help text for SEARCH prompt
+1 WRITE !!?5,"Press <ret> to continue with compare of the Progress"
+2 WRITE !?5,"Note Title File and the TIU Document Definition File."
+3 WRITE !?5,"Enter NO or ""^"" to stop this option."
+4 QUIT
+5 ;
