source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCMGMCK.m@ 1476

Last change on this file since 1476 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.5 KB
Line 
1ORCMGMCK ;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
7FINDQOS ; 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 ;
30CSVPEP ; 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 ;
72CSVOPT ; 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 ;
83QUEUE ; 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 ;
127PAGE(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
Note: See TracBrowser for help on using the repository browser.