Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORCMGMCK

ORCMGMCK.m

Go to the documentation of this file.
  1. ORCMGMCK ;SLC/JFR - FIND GMRC QO'S WITH INACTIVE CODES ;12/04/12 10:02
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**181,361**;Dec 17, 1997;Build 39
  1. ;
  1. ; This routine invokes IA # 3990
  1. ; Other external references:
  1. ; $$FIND1^DIC ICR #2051
  1. ; $$STATCHK^ICDXCODE ICR #5699
  1. ; $$FMTE^XLFDT ICR #10103
  1. ; $$REPEAT^XLFSTR ICR #10104
  1. ;
  1. Q
  1. FINDQOS ; find cons/proc quick orders with a default Prov. DX code
  1. N ORDLG,ORPDLG,ORDGC,ORDGP
  1. K ^TMP("ORCMGMCK",$J)
  1. S ORDGC=$$FIND1^DIC(100.98,,"QX","CONSULTS") ;find disp. group ien
  1. S ORDGP=$$FIND1^DIC(100.98,,"QX","PROCEDURES") ;find disp. group ien
  1. S ORPDLG=$$PTR^ORCD("OR GTX CODE")
  1. S ORDLG=0
  1. F S ORDLG=$O(^ORD(101.41,ORDLG)) Q:'ORDLG I $P(^(ORDLG,0),U,4)="Q" D
  1. . N ORQDG,ORCODEF,ORPRMPT,ORAPIVAL,ACTDT
  1. . S ORQDG=$P(^ORD(101.41,ORDLG,0),U,5)
  1. . I ORQDG'=ORDGC&(ORQDG'=ORDGP) Q ;not in CONS or PROC display group
  1. . S ORPRMPT=$O(^ORD(101.41,ORDLG,6,"D",ORPDLG,0))
  1. . I 'ORPRMPT Q ;no PD prompt
  1. . S ORCODEF=$G(^ORD(101.41,ORDLG,6,ORPRMPT,1))
  1. . I '$L(ORPRMPT) Q ; no default CODE stored.
  1. . I '$$STATCHK^ICDXCODE("DIAGNOSIS",ORCODEF,DT) D Q
  1. .. S ^TMP("ORCMGMCK",$J,"I",ORDLG)=$P(^ORD(101.41,ORDLG,0),U)_U_ORCODEF
  1. . D HIST^ICDXCODE("DIAGNOSIS",ORCODEF,.ORAPIVAL)
  1. . S ACTDT=$O(ORAPIVAL(DT))
  1. . I ACTDT,'$G(ORAPIVAL(ACTDT)) D ; future inactivation
  1. .. S ^TMP("ORCMGMCK",$J,"F",ORDLG)=$P(^ORD(101.41,ORDLG,0),U)_U_ORCODEF_U_$$FMTE^XLFDT(ACTDT)
  1. Q
  1. ;
  1. CSVPEP ; protocol event point called upon CSV install
  1. ; Called by Protocol - ??
  1. ;
  1. N LN,XMSUB,XMTEXT,XMDUZ,XMY
  1. D FINDQOS
  1. K ^TMP("ORCMMSG",$J)
  1. S LN=1
  1. I $D(^TMP("ORCMGMCK",$J,"I")) D
  1. . S ^TMP("ORCMMSG",$J,LN)="The following Consult or Procedure quick orders were found that currently",LN=LN+1
  1. . S ^TMP("ORCMMSG",$J,LN)="have a provisional diagnosis code that is inactive. These should be edited",LN=LN+1
  1. . S ^TMP("ORCMMSG",$J,LN)="as soon as possible to reduce interruption of ordering these quick orders.",LN=LN+1
  1. . S ^TMP("ORCMMSG",$J,LN)=" ",LN=LN+1
  1. . S IREC=0
  1. . F S IREC=$O(^TMP("ORCMGMCK",$J,"I",IREC)) Q:'IREC D
  1. .. S ^TMP("ORCMMSG",$J,LN)="Quick order name: "_$P(^TMP("ORCMGMCK",$J,"I",IREC),U)_" IEN: "_IREC,LN=LN+1
  1. .. S ^TMP("ORCMMSG",$J,LN)="Provisional Diagnosis code: "_$P(^TMP("ORCMGMCK",$J,"I",IREC),U,2),LN=LN+1
  1. .. S ^TMP("ORCMMSG",$J,LN)=" ",LN=LN+1
  1. . Q
  1. ;
  1. I $D(^TMP("ORCMGMCK",$J,"F")) D
  1. . S ^TMP("ORCMMSG",$J,LN)="The following Consult or Procedure quick orders were found to have a",LN=LN+1
  1. . S ^TMP("ORCMMSG",$J,LN)="provisional diagnosis code that will become inactive in the future.",LN=LN+1
  1. . S ^TMP("ORCMMSG",$J,LN)="These should be edited as soon as possible after the inactivation date to",LN=LN+1
  1. . S ^TMP("ORCMMSG",$J,LN)="reduce interruption in ordering these quick orders.",LN=LN+1
  1. . S ^TMP("ORCMMSG",$J,LN)=" ",LN=LN+1
  1. . S FREC=0
  1. . F S FREC=$O(^TMP("ORCMGMCK",$J,"F",FREC)) Q:'FREC D
  1. .. S ^TMP("ORCMMSG",$J,LN)="Quick order name: "_$P(^TMP("ORCMGMCK",$J,"F",FREC),U)_" IEN: "_FREC,LN=LN+1
  1. .. 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)
  1. .. S LN=LN+1
  1. . Q
  1. I '$D(^TMP("ORCMMSG",$J)) D
  1. . S ^TMP("ORCMMSG",$J,LN)="There were no problem quick orders found."
  1. . S LN=LN+1
  1. S XMY("G.ORCM CSV EVENT")=""
  1. S XMSUB="DX Code check of Consult/Procedure QO's"
  1. S XMDUZ="Code Set Version Install"
  1. S XMTEXT="^TMP(""ORCMMSG"",$J,"
  1. D ^XMD
  1. K ^TMP("ORCMGMCK",$J),^TMP("ORCMMSG",$J)
  1. Q
  1. ;
  1. CSVOPT ; report of CSV affected quick orders from option ORCM ...
  1. N %ZIS,POP
  1. S %ZIS="QM" D ^%ZIS Q:POP
  1. I $D(IO("Q")) D D ^%ZISC,HOME^%ZIS Q
  1. . N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
  1. . S ZTDESC="Review of OR Quick orders for CSV"
  1. . S ZTRTN="QUEUE^ORCMGMCK",ZTIO=ION,ZTDTH=$H
  1. . D ^%ZTLOAD
  1. . I '$G(ZTSK) W !,"Unable to task report"
  1. . Q
  1. ;
  1. QUEUE ; entry point for tasked report
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. N PG
  1. U IO
  1. D FINDQOS ;will return ^TMP("ORCMGMCK",$J) with list of quick orders
  1. S PG=1 D PAGE(.PG)
  1. I $D(^TMP("ORCMGMCK",$J,"I")) D
  1. . N IREC
  1. . W !,"The following Consult or Procedure quick orders were found that currently"
  1. . W !,"have a provisional diagnosis code that is inactive. These should be edited"
  1. . W !,"as soon as possible to reduce interruption of ordering these quick orders.",!
  1. . S IREC=0
  1. . F S IREC=$O(^TMP("ORCMGMCK",$J,"I",IREC)) Q:'IREC!(PG<1) D
  1. .. I IOSL-$Y<4 D PAGE(.PG) Q:'PG
  1. .. W !,"Quick order name: ",$P(^TMP("ORCMGMCK",$J,"I",IREC),U)," IEN: ",IREC
  1. .. W !,"Provisional Diagnosis code: ",$P(^TMP("ORCMGMCK",$J,"I",IREC),U,2)
  1. .. W !," "
  1. . Q
  1. ;
  1. I $D(^TMP("ORCMGMCK",$J,"F")) D
  1. . I IOSL=$Y<8 D PAGE(.PG) Q:'PG
  1. . W !,"The following Consult or Procedure quick orders were found to have a"
  1. . W !,"provisional diagnosis code that will become inactive in the future."
  1. . W !,"These should be edited as soon as possible after the inactivation date to"
  1. . W !,"reduce interruption in ordering these quick orders."
  1. . W !," "
  1. . N FREC
  1. . S FREC=0
  1. . F S FREC=$O(^TMP("ORCMGMCK",$J,"F",FREC)) Q:'FREC!(PG<1) D
  1. .. I IOSL-$Y<4 D PAGE(.PG) Q:'PG
  1. .. W !,"Quick order name: ",$P(^TMP("ORCMGMCK",$J,"F",FREC),U)," IEN: ",FREC
  1. .. W !,"Provisional Diagnosis code: ",$P(^TMP("ORCMGMCK",$J,"F",FREC),U,2)," Inactivation Date: ",$$FMTE^XLFDT($P(^(FREC),U,3),2)
  1. . Q
  1. I '$D(^TMP("ORCMGMCK",$J)) D
  1. . W !,"There were no problem quick orders found.",!
  1. . I $E(IOST,1,2)="C-" D
  1. .. N DIR,DTOUT,DIRUT,DUOUT,X,Y
  1. .. S DIR(0)="E" D ^DIR
  1. . Q
  1. D:$E(IOST,1,2)'="C-" ^%ZISC
  1. D HOME^%ZIS
  1. K ^TMP("ORCMGMCK",$J)
  1. Q
  1. ;
  1. PAGE(NUM) ;print header and raise page number
  1. I NUM'=1,$E(IOST,1,2)="C-" D Q:'NUM
  1. . N DIR,DTOUT,DIRUT,DUOUT,X,Y
  1. . S DIR(0)="E" D ^DIR
  1. . I $D(DUOUT)!($D(DTOUT)) S NUM=0
  1. W @IOF
  1. W "Code Set Version review of Consult/Procedure Quick Orders"
  1. W ?70,"Page: ",NUM
  1. W !,$$REPEAT^XLFSTR("-",78)
  1. S NUM=NUM+1
  1. Q