[613] | 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
|
---|