| 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 | 
|---|