ORCMGMCK ;SLC/JFR - FIND GMRC QO'S WITH INACTIVE CODES ;12/04/12 10:02
;;3.0;ORDER ENTRY/RESULTS REPORTING;**181,361**;Dec 17, 1997;Build 39
;
; This routine invokes IA # 3990
; Other external references:
; $$FIND1^DIC ICR #2051
; $$STATCHK^ICDXCODE ICR #5699
; $$FMTE^XLFDT ICR #10103
; $$REPEAT^XLFSTR ICR #10104
;
Q
FINDQOS ; find cons/proc quick orders with a default Prov. DX code
N ORDLG,ORPDLG,ORDGC,ORDGP
K ^TMP("ORCMGMCK",$J)
S ORDGC=$$FIND1^DIC(100.98,,"QX","CONSULTS") ;find disp. group ien
S ORDGP=$$FIND1^DIC(100.98,,"QX","PROCEDURES") ;find disp. group ien
S ORPDLG=$$PTR^ORCD("OR GTX CODE")
S ORDLG=0
F S ORDLG=$O(^ORD(101.41,ORDLG)) Q:'ORDLG I $P(^(ORDLG,0),U,4)="Q" D
. N ORQDG,ORCODEF,ORPRMPT,ORAPIVAL,ACTDT
. S ORQDG=$P(^ORD(101.41,ORDLG,0),U,5)
. I ORQDG'=ORDGC&(ORQDG'=ORDGP) Q ;not in CONS or PROC display group
. S ORPRMPT=$O(^ORD(101.41,ORDLG,6,"D",ORPDLG,0))
. I 'ORPRMPT Q ;no PD prompt
. S ORCODEF=$G(^ORD(101.41,ORDLG,6,ORPRMPT,1))
. I '$L(ORPRMPT) Q ; no default CODE stored.
. I '$$STATCHK^ICDXCODE("DIAGNOSIS",ORCODEF,DT) D Q
.. S ^TMP("ORCMGMCK",$J,"I",ORDLG)=$P(^ORD(101.41,ORDLG,0),U)_U_ORCODEF
. D HIST^ICDXCODE("DIAGNOSIS",ORCODEF,.ORAPIVAL)
. S ACTDT=$O(ORAPIVAL(DT))
. I ACTDT,'$G(ORAPIVAL(ACTDT)) D ; future inactivation
.. S ^TMP("ORCMGMCK",$J,"F",ORDLG)=$P(^ORD(101.41,ORDLG,0),U)_U_ORCODEF_U_$$FMTE^XLFDT(ACTDT)
Q
;
CSVPEP ; protocol event point called upon CSV install
; Called by Protocol - ??
;
N LN,XMSUB,XMTEXT,XMDUZ,XMY
D FINDQOS
K ^TMP("ORCMMSG",$J)
S LN=1
I $D(^TMP("ORCMGMCK",$J,"I")) D
. S ^TMP("ORCMMSG",$J,LN)="The following Consult or Procedure quick orders were found that currently",LN=LN+1
. S ^TMP("ORCMMSG",$J,LN)="have a provisional diagnosis code that is inactive. These should be edited",LN=LN+1
. S ^TMP("ORCMMSG",$J,LN)="as soon as possible to reduce interruption of ordering these quick orders.",LN=LN+1
. S ^TMP("ORCMMSG",$J,LN)=" ",LN=LN+1
. S IREC=0
. F S IREC=$O(^TMP("ORCMGMCK",$J,"I",IREC)) Q:'IREC D
.. S ^TMP("ORCMMSG",$J,LN)="Quick order name: "_$P(^TMP("ORCMGMCK",$J,"I",IREC),U)_" IEN: "_IREC,LN=LN+1
.. S ^TMP("ORCMMSG",$J,LN)="Provisional Diagnosis code: "_$P(^TMP("ORCMGMCK",$J,"I",IREC),U,2),LN=LN+1
.. S ^TMP("ORCMMSG",$J,LN)=" ",LN=LN+1
. Q
;
I $D(^TMP("ORCMGMCK",$J,"F")) D
. S ^TMP("ORCMMSG",$J,LN)="The following Consult or Procedure quick orders were found to have a",LN=LN+1
. S ^TMP("ORCMMSG",$J,LN)="provisional diagnosis code that will become inactive in the future.",LN=LN+1
. S ^TMP("ORCMMSG",$J,LN)="These should be edited as soon as possible after the inactivation date to",LN=LN+1
. S ^TMP("ORCMMSG",$J,LN)="reduce interruption in ordering these quick orders.",LN=LN+1
. S ^TMP("ORCMMSG",$J,LN)=" ",LN=LN+1
. S FREC=0
. F S FREC=$O(^TMP("ORCMGMCK",$J,"F",FREC)) Q:'FREC D
.. S ^TMP("ORCMMSG",$J,LN)="Quick order name: "_$P(^TMP("ORCMGMCK",$J,"F",FREC),U)_" IEN: "_FREC,LN=LN+1
.. S ^TMP("ORCMMSG",$J,LN)="Provisional Diagnosis code: "_$P(^TMP("ORCMGMCK",$J,"F",FREC),U,2)_" Inactivation Date: "_$$FMTE^XLFDT($P(^(FREC),U,3),2)
.. S LN=LN+1
. Q
I '$D(^TMP("ORCMMSG",$J)) D
. S ^TMP("ORCMMSG",$J,LN)="There were no problem quick orders found."
. S LN=LN+1
S XMY("G.ORCM CSV EVENT")=""
S XMSUB="DX Code check of Consult/Procedure QO's"
S XMDUZ="Code Set Version Install"
S XMTEXT="^TMP(""ORCMMSG"",$J,"
D ^XMD
K ^TMP("ORCMGMCK",$J),^TMP("ORCMMSG",$J)
Q
;
CSVOPT ; report of CSV affected quick orders from option ORCM ...
N %ZIS,POP
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) D D ^%ZISC,HOME^%ZIS Q
. N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
. S ZTDESC="Review of OR Quick orders for CSV"
. S ZTRTN="QUEUE^ORCMGMCK",ZTIO=ION,ZTDTH=$H
. D ^%ZTLOAD
. I '$G(ZTSK) W !,"Unable to task report"
. Q
;
QUEUE ; entry point for tasked report
I $D(ZTQUEUED) S ZTREQ="@"
N PG
U IO
D FINDQOS ;will return ^TMP("ORCMGMCK",$J) with list of quick orders
S PG=1 D PAGE(.PG)
I $D(^TMP("ORCMGMCK",$J,"I")) D
. N IREC
. W !,"The following Consult or Procedure quick orders were found that currently"
. W !,"have a provisional diagnosis code that is inactive. These should be edited"
. W !,"as soon as possible to reduce interruption of ordering these quick orders.",!
. S IREC=0
. F S IREC=$O(^TMP("ORCMGMCK",$J,"I",IREC)) Q:'IREC!(PG<1) D
.. I IOSL-$Y<4 D PAGE(.PG) Q:'PG
.. W !,"Quick order name: ",$P(^TMP("ORCMGMCK",$J,"I",IREC),U)," IEN: ",IREC
.. W !,"Provisional Diagnosis code: ",$P(^TMP("ORCMGMCK",$J,"I",IREC),U,2)
.. W !," "
. Q
;
I $D(^TMP("ORCMGMCK",$J,"F")) D
. I IOSL=$Y<8 D PAGE(.PG) Q:'PG
. W !,"The following Consult or Procedure quick orders were found to have a"
. W !,"provisional diagnosis code that will become inactive in the future."
. W !,"These should be edited as soon as possible after the inactivation date to"
. W !,"reduce interruption in ordering these quick orders."
. W !," "
. N FREC
. S FREC=0
. F S FREC=$O(^TMP("ORCMGMCK",$J,"F",FREC)) Q:'FREC!(PG<1) D
.. I IOSL-$Y<4 D PAGE(.PG) Q:'PG
.. W !,"Quick order name: ",$P(^TMP("ORCMGMCK",$J,"F",FREC),U)," IEN: ",FREC
.. W !,"Provisional Diagnosis code: ",$P(^TMP("ORCMGMCK",$J,"F",FREC),U,2)," Inactivation Date: ",$$FMTE^XLFDT($P(^(FREC),U,3),2)
. Q
I '$D(^TMP("ORCMGMCK",$J)) D
. W !,"There were no problem quick orders found.",!
. I $E(IOST,1,2)="C-" D
.. N DIR,DTOUT,DIRUT,DUOUT,X,Y
.. S DIR(0)="E" D ^DIR
. Q
D:$E(IOST,1,2)'="C-" ^%ZISC
D HOME^%ZIS
K ^TMP("ORCMGMCK",$J)
Q
;
PAGE(NUM) ;print header and raise page number
I NUM'=1,$E(IOST,1,2)="C-" D Q:'NUM
. N DIR,DTOUT,DIRUT,DUOUT,X,Y
. S DIR(0)="E" D ^DIR
. I $D(DUOUT)!($D(DTOUT)) S NUM=0
W @IOF
W "Code Set Version review of Consult/Procedure Quick Orders"
W ?70,"Page: ",NUM
W !,$$REPEAT^XLFSTR("-",78)
S NUM=NUM+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCMGMCK 5972 printed Dec 13, 2024@02:28:47 Page 2
ORCMGMCK ;SLC/JFR - FIND GMRC QO'S WITH INACTIVE CODES ;12/04/12 10:02
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**181,361**;Dec 17, 1997;Build 39
+2 ;
+3 ; This routine invokes IA # 3990
+4 ; Other external references:
+5 ; $$FIND1^DIC ICR #2051
+6 ; $$STATCHK^ICDXCODE ICR #5699
+7 ; $$FMTE^XLFDT ICR #10103
+8 ; $$REPEAT^XLFSTR ICR #10104
+9 ;
+10 QUIT
FINDQOS ; find cons/proc quick orders with a default Prov. DX code
+1 NEW ORDLG,ORPDLG,ORDGC,ORDGP
+2 KILL ^TMP("ORCMGMCK",$JOB)
+3 ;find disp. group ien
SET ORDGC=$$FIND1^DIC(100.98,,"QX","CONSULTS")
+4 ;find disp. group ien
SET ORDGP=$$FIND1^DIC(100.98,,"QX","PROCEDURES")
+5 SET ORPDLG=$$PTR^ORCD("OR GTX CODE")
+6 SET ORDLG=0
+7 FOR
SET ORDLG=$ORDER(^ORD(101.41,ORDLG))
if 'ORDLG
QUIT
IF $PIECE(^(ORDLG,0),U,4)="Q"
Begin DoDot:1
+8 NEW ORQDG,ORCODEF,ORPRMPT,ORAPIVAL,ACTDT
+9 SET ORQDG=$PIECE(^ORD(101.41,ORDLG,0),U,5)
+10 ;not in CONS or PROC display group
IF ORQDG'=ORDGC&(ORQDG'=ORDGP)
QUIT
+11 SET ORPRMPT=$ORDER(^ORD(101.41,ORDLG,6,"D",ORPDLG,0))
+12 ;no PD prompt
IF 'ORPRMPT
QUIT
+13 SET ORCODEF=$GET(^ORD(101.41,ORDLG,6,ORPRMPT,1))
+14 ; no default CODE stored.
IF '$LENGTH(ORPRMPT)
QUIT
+15 IF '$$STATCHK^ICDXCODE("DIAGNOSIS",ORCODEF,DT)
Begin DoDot:2
+16 SET ^TMP("ORCMGMCK",$JOB,"I",ORDLG)=$PIECE(^ORD(101.41,ORDLG,0),U)_U_ORCODEF
End DoDot:2
QUIT
+17 DO HIST^ICDXCODE("DIAGNOSIS",ORCODEF,.ORAPIVAL)
+18 SET ACTDT=$ORDER(ORAPIVAL(DT))
+19 ; future inactivation
IF ACTDT
IF '$GET(ORAPIVAL(ACTDT))
Begin DoDot:2
+20 SET ^TMP("ORCMGMCK",$JOB,"F",ORDLG)=$PIECE(^ORD(101.41,ORDLG,0),U)_U_ORCODEF_U_$$FMTE^XLFDT(ACTDT)
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
CSVPEP ; protocol event point called upon CSV install
+1 ; Called by Protocol - ??
+2 ;
+3 NEW LN,XMSUB,XMTEXT,XMDUZ,XMY
+4 DO FINDQOS
+5 KILL ^TMP("ORCMMSG",$JOB)
+6 SET LN=1
+7 IF $DATA(^TMP("ORCMGMCK",$JOB,"I"))
Begin DoDot:1
+8 SET ^TMP("ORCMMSG",$JOB,LN)="The following Consult or Procedure quick orders were found that currently"
SET LN=LN+1
+9 SET ^TMP("ORCMMSG",$JOB,LN)="have a provisional diagnosis code that is inactive. These should be edited"
SET LN=LN+1
+10 SET ^TMP("ORCMMSG",$JOB,LN)="as soon as possible to reduce interruption of ordering these quick orders."
SET LN=LN+1
+11 SET ^TMP("ORCMMSG",$JOB,LN)=" "
SET LN=LN+1
+12 SET IREC=0
+13 FOR
SET IREC=$ORDER(^TMP("ORCMGMCK",$JOB,"I",IREC))
if 'IREC
QUIT
Begin DoDot:2
+14 SET ^TMP("ORCMMSG",$JOB,LN)="Quick order name: "_$PIECE(^TMP("ORCMGMCK",$JOB,"I",IREC),U)_" IEN: "_IREC
SET LN=LN+1
+15 SET ^TMP("ORCMMSG",$JOB,LN)="Provisional Diagnosis code: "_$PIECE(^TMP("ORCMGMCK",$JOB,"I",IREC),U,2)
SET LN=LN+1
+16 SET ^TMP("ORCMMSG",$JOB,LN)=" "
SET LN=LN+1
End DoDot:2
+17 QUIT
End DoDot:1
+18 ;
+19 IF $DATA(^TMP("ORCMGMCK",$JOB,"F"))
Begin DoDot:1
+20 SET ^TMP("ORCMMSG",$JOB,LN)="The following Consult or Procedure quick orders were found to have a"
SET LN=LN+1
+21 SET ^TMP("ORCMMSG",$JOB,LN)="provisional diagnosis code that will become inactive in the future."
SET LN=LN+1
+22 SET ^TMP("ORCMMSG",$JOB,LN)="These should be edited as soon as possible after the inactivation date to"
SET LN=LN+1
+23 SET ^TMP("ORCMMSG",$JOB,LN)="reduce interruption in ordering these quick orders."
SET LN=LN+1
+24 SET ^TMP("ORCMMSG",$JOB,LN)=" "
SET LN=LN+1
+25 SET FREC=0
+26 FOR
SET FREC=$ORDER(^TMP("ORCMGMCK",$JOB,"F",FREC))
if 'FREC
QUIT
Begin DoDot:2
+27 SET ^TMP("ORCMMSG",$JOB,LN)="Quick order name: "_$PIECE(^TMP("ORCMGMCK",$JOB,"F",FREC),U)_" IEN: "_FREC
SET LN=LN+1
+28 SET ^TMP("ORCMMSG",$JOB,LN)="Provisional Diagnosis code: "_$PIECE(^TMP("ORCMGMCK",$JOB,"F",FREC),U,2)_" Inactivation Date: "_$$FMTE^XLFDT($PIECE(^(FREC),U,3),2)
+29 SET LN=LN+1
End DoDot:2
+30 QUIT
End DoDot:1
+31 IF '$DATA(^TMP("ORCMMSG",$JOB))
Begin DoDot:1
+32 SET ^TMP("ORCMMSG",$JOB,LN)="There were no problem quick orders found."
+33 SET LN=LN+1
End DoDot:1
+34 SET XMY("G.ORCM CSV EVENT")=""
+35 SET XMSUB="DX Code check of Consult/Procedure QO's"
+36 SET XMDUZ="Code Set Version Install"
+37 SET XMTEXT="^TMP(""ORCMMSG"",$J,"
+38 DO ^XMD
+39 KILL ^TMP("ORCMGMCK",$JOB),^TMP("ORCMMSG",$JOB)
+40 QUIT
+41 ;
CSVOPT ; report of CSV affected quick orders from option ORCM ...
+1 NEW %ZIS,POP
+2 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
+5 SET ZTDESC="Review of OR Quick orders for CSV"
+6 SET ZTRTN="QUEUE^ORCMGMCK"
SET ZTIO=ION
SET ZTDTH=$HOROLOG
+7 DO ^%ZTLOAD
+8 IF '$GET(ZTSK)
WRITE !,"Unable to task report"
+9 QUIT
End DoDot:1
DO ^%ZISC
DO HOME^%ZIS
QUIT
+10 ;
QUEUE ; entry point for tasked report
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 NEW PG
+3 USE IO
+4 ;will return ^TMP("ORCMGMCK",$J) with list of quick orders
DO FINDQOS
+5 SET PG=1
DO PAGE(.PG)
+6 IF $DATA(^TMP("ORCMGMCK",$JOB,"I"))
Begin DoDot:1
+7 NEW IREC
+8 WRITE !,"The following Consult or Procedure quick orders were found that currently"
+9 WRITE !,"have a provisional diagnosis code that is inactive. These should be edited"
+10 WRITE !,"as soon as possible to reduce interruption of ordering these quick orders.",!
+11 SET IREC=0
+12 FOR
SET IREC=$ORDER(^TMP("ORCMGMCK",$JOB,"I",IREC))
if 'IREC!(PG<1)
QUIT
Begin DoDot:2
+13 IF IOSL-$Y<4
DO PAGE(.PG)
if 'PG
QUIT
+14 WRITE !,"Quick order name: ",$PIECE(^TMP("ORCMGMCK",$JOB,"I",IREC),U)," IEN: ",IREC
+15 WRITE !,"Provisional Diagnosis code: ",$PIECE(^TMP("ORCMGMCK",$JOB,"I",IREC),U,2)
+16 WRITE !," "
End DoDot:2
+17 QUIT
End DoDot:1
+18 ;
+19 IF $DATA(^TMP("ORCMGMCK",$JOB,"F"))
Begin DoDot:1
+20 IF IOSL=$Y<8
DO PAGE(.PG)
if 'PG
QUIT
+21 WRITE !,"The following Consult or Procedure quick orders were found to have a"
+22 WRITE !,"provisional diagnosis code that will become inactive in the future."
+23 WRITE !,"These should be edited as soon as possible after the inactivation date to"
+24 WRITE !,"reduce interruption in ordering these quick orders."
+25 WRITE !," "
+26 NEW FREC
+27 SET FREC=0
+28 FOR
SET FREC=$ORDER(^TMP("ORCMGMCK",$JOB,"F",FREC))
if 'FREC!(PG<1)
QUIT
Begin DoDot:2
+29 IF IOSL-$Y<4
DO PAGE(.PG)
if 'PG
QUIT
+30 WRITE !,"Quick order name: ",$PIECE(^TMP("ORCMGMCK",$JOB,"F",FREC),U)," IEN: ",FREC
+31 WRITE !,"Provisional Diagnosis code: ",$PIECE(^TMP("ORCMGMCK",$JOB,"F",FREC),U,2)," Inactivation Date: ",$$FMTE^XLFDT($PIECE(^(FREC),U,3),2)
End DoDot:2
+32 QUIT
End DoDot:1
+33 IF '$DATA(^TMP("ORCMGMCK",$JOB))
Begin DoDot:1
+34 WRITE !,"There were no problem quick orders found.",!
+35 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:2
+36 NEW DIR,DTOUT,DIRUT,DUOUT,X,Y
+37 SET DIR(0)="E"
DO ^DIR
End DoDot:2
+38 QUIT
End DoDot:1
+39 if $EXTRACT(IOST,1,2)'="C-"
DO ^%ZISC
+40 DO HOME^%ZIS
+41 KILL ^TMP("ORCMGMCK",$JOB)
+42 QUIT
+43 ;
PAGE(NUM) ;print header and raise page number
+1 IF NUM'=1
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+2 NEW DIR,DTOUT,DIRUT,DUOUT,X,Y
+3 SET DIR(0)="E"
DO ^DIR
+4 IF $DATA(DUOUT)!($DATA(DTOUT))
SET NUM=0
End DoDot:1
if 'NUM
QUIT
+5 WRITE @IOF
+6 WRITE "Code Set Version review of Consult/Procedure Quick Orders"
+7 WRITE ?70,"Page: ",NUM
+8 WRITE !,$$REPEAT^XLFSTR("-",78)
+9 SET NUM=NUM+1
+10 QUIT
