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