1 | ORCMGMCK ;SLC/JFR - FIND GMRC QO'S WITH INACTIVE CODES ;6/4/03 11:33
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**181**;Dec 17, 1997
|
---|
3 | ;
|
---|
4 | ; This routine invokes IA # 3990
|
---|
5 | ;
|
---|
6 | Q
|
---|
7 | FINDQOS ; find cons/proc quick orders with a default Prov. DX code
|
---|
8 | N ORDLG,ORPDLG,ORDGC,ORDGP
|
---|
9 | K ^TMP("ORCMGMCK",$J)
|
---|
10 | S ORDGC=$$FIND1^DIC(100.98,,"QX","CONSULTS") ;find disp. group ien
|
---|
11 | S ORDGP=$$FIND1^DIC(100.98,,"QX","PROCEDURES") ;find disp. group ien
|
---|
12 | S ORPDLG=$$PTR^ORCD("OR GTX CODE")
|
---|
13 | S ORDLG=0
|
---|
14 | F S ORDLG=$O(^ORD(101.41,ORDLG)) Q:'ORDLG I $P(^(ORDLG,0),U,4)="Q" D
|
---|
15 | . N ORQDG,ORCODEF,ORPRMPT,ORAPIVAL,ACTDT
|
---|
16 | . S ORQDG=$P(^ORD(101.41,ORDLG,0),U,5)
|
---|
17 | . I ORQDG'=ORDGC&(ORQDG'=ORDGP) Q ;not in CONS or PROC display group
|
---|
18 | . S ORPRMPT=$O(^ORD(101.41,ORDLG,6,"D",ORPDLG,0))
|
---|
19 | . I 'ORPRMPT Q ;no PD prompt
|
---|
20 | . S ORCODEF=$G(^ORD(101.41,ORDLG,6,ORPRMPT,1))
|
---|
21 | . I '$L(ORPRMPT) Q ; no default CODE stored.
|
---|
22 | . I '$$STATCHK^ICDAPIU(ORCODEF,DT) D Q
|
---|
23 | .. S ^TMP("ORCMGMCK",$J,"I",ORDLG)=$P(^ORD(101.41,ORDLG,0),U)_U_ORCODEF
|
---|
24 | . S ORAPIVAL=$$HIST^ICDAPIU(ORCODEF,.ORAPIVAL)
|
---|
25 | . S ACTDT=$O(ORAPIVAL(DT))
|
---|
26 | . I ACTDT,'$G(ORAPIVAL(ACTDT)) D ; future inactivation
|
---|
27 | .. S ^TMP("ORCMGMCK",$J,"F",ORDLG)=$P(^ORD(101.41,ORDLG,0),U)_U_ORCODEF_U_$$FMTE^XLFDT(ACTDT)
|
---|
28 | Q
|
---|
29 | ;
|
---|
30 | CSVPEP ; protocol event point called upon CSV install
|
---|
31 | ; Called by Protocol - ??
|
---|
32 | ;
|
---|
33 | N LN,XMSUB,XMTEXT,XMDUZ,XMY
|
---|
34 | D FINDQOS
|
---|
35 | K ^TMP("ORCMMSG",$J)
|
---|
36 | S LN=1
|
---|
37 | I $D(^TMP("ORCMGMCK",$J,"I")) D
|
---|
38 | . S ^TMP("ORCMMSG",$J,LN)="The following Consult or Procedure quick orders were found that currently",LN=LN+1
|
---|
39 | . S ^TMP("ORCMMSG",$J,LN)="have a provisional diagnosis code that is inactive. These should be edited",LN=LN+1
|
---|
40 | . S ^TMP("ORCMMSG",$J,LN)="as soon as possible to reduce interruption of ordering these quick orders.",LN=LN+1
|
---|
41 | . S ^TMP("ORCMMSG",$J,LN)=" ",LN=LN+1
|
---|
42 | . S IREC=0
|
---|
43 | . F S IREC=$O(^TMP("ORCMGMCK",$J,"I",IREC)) Q:'IREC D
|
---|
44 | .. S ^TMP("ORCMMSG",$J,LN)="Quick order name: "_$P(^TMP("ORCMGMCK",$J,"I",IREC),U)_" IEN: "_IREC,LN=LN+1
|
---|
45 | .. S ^TMP("ORCMMSG",$J,LN)="Provisional Diagnosis code: "_$P(^TMP("ORCMGMCK",$J,"I",IREC),U,2),LN=LN+1
|
---|
46 | .. S ^TMP("ORCMMSG",$J,LN)=" ",LN=LN+1
|
---|
47 | . Q
|
---|
48 | ;
|
---|
49 | I $D(^TMP("ORCMGMCK",$J,"F")) D
|
---|
50 | . S ^TMP("ORCMMSG",$J,LN)="The following Consult or Procedure quick orders were found to have a",LN=LN+1
|
---|
51 | . S ^TMP("ORCMMSG",$J,LN)="provisional diagnosis code that will become inactive in the future.",LN=LN+1
|
---|
52 | . S ^TMP("ORCMMSG",$J,LN)="These should be edited as soon as possible after the inactivation date to",LN=LN+1
|
---|
53 | . S ^TMP("ORCMMSG",$J,LN)="reduce interruption in ordering these quick orders.",LN=LN+1
|
---|
54 | . S ^TMP("ORCMMSG",$J,LN)=" ",LN=LN+1
|
---|
55 | . S FREC=0
|
---|
56 | . F S FREC=$O(^TMP("ORCMGMCK",$J,"F",FREC)) Q:'FREC D
|
---|
57 | .. S ^TMP("ORCMMSG",$J,LN)="Quick order name: "_$P(^TMP("ORCMGMCK",$J,"F",FREC),U)_" IEN: "_FREC,LN=LN+1
|
---|
58 | .. 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)
|
---|
59 | .. S LN=LN+1
|
---|
60 | . Q
|
---|
61 | I '$D(^TMP("ORCMMSG",$J)) D
|
---|
62 | . S ^TMP("ORCMMSG",$J,LN)="There were no problem quick orders found."
|
---|
63 | . S LN=LN+1
|
---|
64 | S XMY("G.ORCM CSV EVENT")=""
|
---|
65 | S XMSUB="DX Code check of Consult/Procedure QO's"
|
---|
66 | S XMDUZ="Code Set Version Install"
|
---|
67 | S XMTEXT="^TMP(""ORCMMSG"",$J,"
|
---|
68 | D ^XMD
|
---|
69 | K ^TMP("ORCMGMCK",$J),^TMP("ORCMMSG",$J)
|
---|
70 | Q
|
---|
71 | ;
|
---|
72 | CSVOPT ; report of CSV affected quick orders from option ORCM ...
|
---|
73 | N %ZIS,POP
|
---|
74 | S %ZIS="QM" D ^%ZIS Q:POP
|
---|
75 | I $D(IO("Q")) D D ^%ZISC,HOME^%ZIS Q
|
---|
76 | . N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
|
---|
77 | . S ZTDESC="Review of OR Quick orders for CSV"
|
---|
78 | . S ZTRTN="QUEUE^ORCMGMCK",ZTIO=ION,ZTDTH=$H
|
---|
79 | . D ^%ZTLOAD
|
---|
80 | . I '$G(ZTSK) W !,"Unable to task report"
|
---|
81 | . Q
|
---|
82 | ;
|
---|
83 | QUEUE ; entry point for tasked report
|
---|
84 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
85 | N PG
|
---|
86 | U IO
|
---|
87 | D FINDQOS ;will return ^TMP("ORCMGMCK",$J) with list of quick orders
|
---|
88 | S PG=1 D PAGE(.PG)
|
---|
89 | I $D(^TMP("ORCMGMCK",$J,"I")) D
|
---|
90 | . N IREC
|
---|
91 | . W !,"The following Consult or Procedure quick orders were found that currently"
|
---|
92 | . W !,"have a provisional diagnosis code that is inactive. These should be edited"
|
---|
93 | . W !,"as soon as possible to reduce interruption of ordering these quick orders.",!
|
---|
94 | . S IREC=0
|
---|
95 | . F S IREC=$O(^TMP("ORCMGMCK",$J,"I",IREC)) Q:'IREC!(PG<1) D
|
---|
96 | .. I IOSL-$Y<4 D PAGE(.PG) Q:'PG
|
---|
97 | .. W !,"Quick order name: ",$P(^TMP("ORCMGMCK",$J,"I",IREC),U)," IEN: ",IREC
|
---|
98 | .. W !,"Provisional Diagnosis code: ",$P(^TMP("ORCMGMCK",$J,"I",IREC),U,2)
|
---|
99 | .. W !," "
|
---|
100 | . Q
|
---|
101 | ;
|
---|
102 | I $D(^TMP("ORCMGMCK",$J,"F")) D
|
---|
103 | . I IOSL=$Y<8 D PAGE(.PG) Q:'PG
|
---|
104 | . W !,"The following Consult or Procedure quick orders were found to have a"
|
---|
105 | . W !,"provisional diagnosis code that will become inactive in the future."
|
---|
106 | . W !,"These should be edited as soon as possible after the inactivation date to"
|
---|
107 | . W !,"reduce interruption in ordering these quick orders."
|
---|
108 | . W !," "
|
---|
109 | . N FREC
|
---|
110 | . S FREC=0
|
---|
111 | . F S FREC=$O(^TMP("ORCMGMCK",$J,"F",FREC)) Q:'FREC!(PG<1) D
|
---|
112 | .. I IOSL-$Y<4 D PAGE(.PG) Q:'PG
|
---|
113 | .. W !,"Quick order name: ",$P(^TMP("ORCMGMCK",$J,"F",FREC),U)," IEN: ",FREC
|
---|
114 | .. W !,"Provisional Diagnosis code: ",$P(^TMP("ORCMGMCK",$J,"F",FREC),U,2)," Inactivation Date: ",$$FMTE^XLFDT($P(^(FREC),U,3),2)
|
---|
115 | . Q
|
---|
116 | I '$D(^TMP("ORCMGMCK",$J)) D
|
---|
117 | . W !,"There were no problem quick orders found.",!
|
---|
118 | . I $E(IOST,1,2)="C-" D
|
---|
119 | .. N DIR,DTOUT,DIRUT,DUOUT,X,Y
|
---|
120 | .. S DIR(0)="E" D ^DIR
|
---|
121 | . Q
|
---|
122 | D:$E(IOST,1,2)'="C-" ^%ZISC
|
---|
123 | D HOME^%ZIS
|
---|
124 | K ^TMP("ORCMGMCK",$J)
|
---|
125 | Q
|
---|
126 | ;
|
---|
127 | PAGE(NUM) ;print header and raise page number
|
---|
128 | I NUM'=1,$E(IOST,1,2)="C-" D Q:'NUM
|
---|
129 | . N DIR,DTOUT,DIRUT,DUOUT,X,Y
|
---|
130 | . S DIR(0)="E" D ^DIR
|
---|
131 | . I $D(DUOUT)!($D(DTOUT)) S NUM=0
|
---|
132 | W @IOF
|
---|
133 | W "Code Set Version review of Consult/Procedure Quick Orders"
|
---|
134 | W ?70,"Page: ",NUM
|
---|
135 | W !,$$REPEAT^XLFSTR("-",78)
|
---|
136 | S NUM=NUM+1
|
---|
137 | Q
|
---|