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