138 lines
5.5 KiB
Mathematica
138 lines
5.5 KiB
Mathematica
ORCMGMCK ;SLC/JFR - FIND GMRC QO'S WITH INACTIVE CODES ;6/4/03 11:33
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**181**;Dec 17, 1997
|
|
;
|
|
; This routine invokes IA # 3990
|
|
;
|
|
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^ICDAPIU(ORCODEF,DT) D Q
|
|
.. S ^TMP("ORCMGMCK",$J,"I",ORDLG)=$P(^ORD(101.41,ORDLG,0),U)_U_ORCODEF
|
|
. S ORAPIVAL=$$HIST^ICDAPIU(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
|