ORY608 ;SLC/JLC - PRE/POST INSTALL OR*3.0*608 ;May 21, 2024@14:09:12
;;3.0;ORDER ENTRY/RESULTS REPORTING;**608**;Dec 17, 1997;Build 15
;
;
Q
;
POST ;
D RPT
D SETPARAMS
D DLGBULL
D TASK("DDCIDQO^ORY608","OR*3.0*608 Quick Order Search")
Q
;
RPT ;Update ORCV VITALS report
N ORRIEN
S ORRIEN=$$FIND1^DIC(8994,,"X","ORQQVI SWPVIT")
I ORRIEN="" D MES^XPDUTL("Error updating the ORCV VITALS report. It must be corrected for the Vitals display on the cover sheet to function.") Q
I $P(^ORD(101.24,34,0),"^",13)=ORRIEN Q
S $P(^ORD(101.24,34,0),"^",13)=ORRIEN
D MES^XPDUTL("ORCV VITALS report remote procedure call updated.")
Q
;
SETPARAM(LEVEL,PARAM,VALUE) ;
N ERR
D EN^XPAR(LEVEL,PARAM,1,VALUE,.ERR)
I +ERR>0 D
.D BMES^XPDUTL(" Problem setting "_PARAM_" parameter to "_VALUE)
Q
;
SETPARAMS ; Set package level settings of exported parameters
D SETPARAM("PKG","OR CPRS EXCEPTION MODULE INFO",1)
D SETPARAM("PKG","OR CPRS ACTIVITY LOG SIZE",0)
D SETPARAM("PKG","OR CPRS WIN MESSAGE LOG SIZE",0)
D SETPARAM("PKG","OR CPRS RPC EXCEPTION LOG SIZE",25)
D SETPARAM("PKG","ORCDGMRC FUTURE DATE LIMIT",390)
D SETPARAM("PKG","ORCDRA FUTURE DATE LIMIT",390)
D SETPARAM("SYS","OR CPRS EXCEPTION EMAIL","CPRSDevsOnly@DVAGOV.onmicrosoft.com")
D SETPARAM("SYS","OR CPRS EXCEPTION LOGGER","YES")
Q
;
SENDDLG(ANAME) ;Return true if the current order dialog should be sent
I ANAME="GMRCOR CONSULT" Q 1
I ANAME="RA OERR EXAM" Q 1
Q 0
;
DLGBULL ;Send bulletin about modified dialogs
N ORD
S ORD("GMRCOR CONSULT")=""
S ORD("RA OERR EXAM")=""
D EN^ORYDLG(608,.ORD)
Q
;
TASK(ZTRTN,ZTDESC) ;
N ZTDTH,ZTSAVE,ZTIO,TEXT,ZTSK
S TEXT=" "_ZTDESC_" has been queued, task number "
S ZTIO=""
S ZTDTH=$$NOW^XLFDT
D ^%ZTLOAD
I $D(ZTSK) S TEXT=TEXT_ZTSK D MES^XPDUTL(.TEXT)
Q
;
DDCIDQO ;search for QOs
N RESULT,INPUT,SUB,RETMENU,RETSTRCT,SPINNER,SKIPDIS,ORGTXCLININD,ORGTXSDTM
S ORGTXCLININD="",ORGTXCLININD=$O(^ORD(101.41,"B","OR GTX CLINICALLY INDICATED DATE",""))
S ORGTXSDTM="",ORGTXSDTM=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",""))
S INPUT("GMRCOR CONSULT")=""
S INPUT("RA OERR EXAM")=""
S RETMENU=1,RETSTRCT=0,SPINNER=0,SKIPDIS=0
S SUB="OR608 QO SEARCH"
D FINDQO^ORQOUTL(.RESULT,.INPUT,SUB,RETMENU,RETSTRCT,SPINNER,SKIPDIS)
D GETVALS,REPORT
Q
;
GETVALS ; get date values for report display
Q:'$D(^TMP($J,SUB))
N INDEX S INDEX=""
N NAME,ODIEN,DSGRP,DSGPAR
F NAME="GMRCOR CONSULT","RA OERR EXAM" D
. S ODIEN=$O(^ORD(101.41,"AB",NAME,"")) Q:ODIEN=""
. S DSGRP=0 F S DSGRP=$O(^ORD(100.98,DSGRP)) Q:DSGRP'>0 D
. . I $P(^ORD(100.98,DSGRP,0),U,4)=ODIEN S DSGPAR(NAME,DSGRP)=DSGRP
F S INDEX=$O(^TMP($J,SUB,INDEX)) Q:INDEX="" D
. I $D(DSGPAR("GMRCOR CONSULT",$P(^ORD(101.41,INDEX,0),U,5))) D CONS
. I $D(DSGPAR("RA OERR EXAM",$P(^ORD(101.41,INDEX,0),U,5))) D RAD
Q
;
PAD(X,WIDTH,CHAR) ; -- returns X padded with CHAR to total WIDTH
N Y S:$G(CHAR)="" CHAR=" "
S Y=X_$$REPEAT^XLFSTR(CHAR,WIDTH-$L(X))
Q Y
;
REPORT ; show data
K ^TMP("OR MSG",$J),XMY
N CNT,INDEX,ITEM,XMDUZ,XMSUB,XMTEXT,DIFROM
S CNT=0,XMDUZ="OR*3.0*608 SEARCH",XMSUB="DATE DESIRED & CID QO DEFAULTS",XMTEXT="^TMP(""OR MSG"",$J,",XMY(DUZ)="",XMY("G.OR CACS")=""
S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="This report lists Imaging and Consult Quick Orders with a default date"
S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="value in Date Desired or Clinically Indicated Date."
S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=$$PAD("=",78,"=")
S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=$$PAD("QO NAME",63," ")_" QO DATE VALUE"
S INDEX=""
F S INDEX=$O(^TMP($J,SUB,INDEX)) Q:INDEX="" D
. S ITEM=^TMP($J,SUB,INDEX)
. S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=$$PAD($P(ITEM,U,1),63," ")_" "_$P(ITEM,U,5)
. I $D(^TMP($J,"OR608 QO SEARCH",INDEX,"ORDER MENUS")) D
. . S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=" Used on the following order menu(s):"
. . N OM S OM="" F S OM=$O(^TMP($J,"OR608 QO SEARCH",INDEX,"ORDER MENUS",OM)) Q:OM="" D
. . . S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=" "_$P(^TMP($J,"OR608 QO SEARCH",INDEX,"ORDER MENUS",OM),U)
. I $D(^TMP($J,"OR608 QO SEARCH",INDEX,"REMINDER DIALOGS")) D
. . S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=" Used on the following reminder dialog(s):"
. . N DM,DM1 S DM="" F S DM=$O(^TMP($J,"OR608 QO SEARCH",INDEX,"REMINDER DIALOGS",DM)) Q:DM="" D
. . . S DM1="" F S DM1=$O(^TMP($J,"OR608 QO SEARCH",INDEX,"REMINDER DIALOGS",DM,DM1)) Q:DM1="" D
. . . . S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=" "_$P(^TMP($J,"OR608 QO SEARCH",INDEX,"REMINDER DIALOGS",DM,DM1),U)
I CNT=4 S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="None Found"
D ^XMD
Q
;
CONS ; consult
N CID
S CID=+$O(^ORD(101.41,INDEX,6,"D",ORGTXCLININD,""))
I $G(CID)>0 D
. S CID=^ORD(101.41,INDEX,6,CID,1)
. I $G(CID)="" D Q
. . S CID=0 ;don't report empty values for CID
. S $P(^TMP($J,SUB,INDEX),U,5)=CID
I $G(CID)=0 K ^TMP($J,SUB,INDEX)
Q
;
RAD ; radiology
N DD
S DD=+$O(^ORD(101.41,INDEX,6,"D",ORGTXSDTM,""))
I $G(DD)>0 D
. S DD=^ORD(101.41,INDEX,6,DD,1)
. I $G(DD)="" D Q ;don't report empty values for date desired
. . S DD=0
. S $P(^TMP($J,SUB,INDEX),U,5)=DD
I $G(DD)=0 K ^TMP($J,SUB,INDEX)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY608 5233 printed Nov 22, 2024@17:53:03 Page 2
ORY608 ;SLC/JLC - PRE/POST INSTALL OR*3.0*608 ;May 21, 2024@14:09:12
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**608**;Dec 17, 1997;Build 15
+2 ;
+3 ;
+4 QUIT
+5 ;
POST ;
+1 DO RPT
+2 DO SETPARAMS
+3 DO DLGBULL
+4 DO TASK("DDCIDQO^ORY608","OR*3.0*608 Quick Order Search")
+5 QUIT
+6 ;
RPT ;Update ORCV VITALS report
+1 NEW ORRIEN
+2 SET ORRIEN=$$FIND1^DIC(8994,,"X","ORQQVI SWPVIT")
+3 IF ORRIEN=""
DO MES^XPDUTL("Error updating the ORCV VITALS report. It must be corrected for the Vitals display on the cover sheet to function.")
QUIT
+4 IF $PIECE(^ORD(101.24,34,0),"^",13)=ORRIEN
QUIT
+5 SET $PIECE(^ORD(101.24,34,0),"^",13)=ORRIEN
+6 DO MES^XPDUTL("ORCV VITALS report remote procedure call updated.")
+7 QUIT
+8 ;
SETPARAM(LEVEL,PARAM,VALUE) ;
+1 NEW ERR
+2 DO EN^XPAR(LEVEL,PARAM,1,VALUE,.ERR)
+3 IF +ERR>0
Begin DoDot:1
+4 DO BMES^XPDUTL(" Problem setting "_PARAM_" parameter to "_VALUE)
End DoDot:1
+5 QUIT
+6 ;
SETPARAMS ; Set package level settings of exported parameters
+1 DO SETPARAM("PKG","OR CPRS EXCEPTION MODULE INFO",1)
+2 DO SETPARAM("PKG","OR CPRS ACTIVITY LOG SIZE",0)
+3 DO SETPARAM("PKG","OR CPRS WIN MESSAGE LOG SIZE",0)
+4 DO SETPARAM("PKG","OR CPRS RPC EXCEPTION LOG SIZE",25)
+5 DO SETPARAM("PKG","ORCDGMRC FUTURE DATE LIMIT",390)
+6 DO SETPARAM("PKG","ORCDRA FUTURE DATE LIMIT",390)
+7 DO SETPARAM("SYS","OR CPRS EXCEPTION EMAIL","CPRSDevsOnly@DVAGOV.onmicrosoft.com")
+8 DO SETPARAM("SYS","OR CPRS EXCEPTION LOGGER","YES")
+9 QUIT
+10 ;
SENDDLG(ANAME) ;Return true if the current order dialog should be sent
+1 IF ANAME="GMRCOR CONSULT"
QUIT 1
+2 IF ANAME="RA OERR EXAM"
QUIT 1
+3 QUIT 0
+4 ;
DLGBULL ;Send bulletin about modified dialogs
+1 NEW ORD
+2 SET ORD("GMRCOR CONSULT")=""
+3 SET ORD("RA OERR EXAM")=""
+4 DO EN^ORYDLG(608,.ORD)
+5 QUIT
+6 ;
TASK(ZTRTN,ZTDESC) ;
+1 NEW ZTDTH,ZTSAVE,ZTIO,TEXT,ZTSK
+2 SET TEXT=" "_ZTDESC_" has been queued, task number "
+3 SET ZTIO=""
+4 SET ZTDTH=$$NOW^XLFDT
+5 DO ^%ZTLOAD
+6 IF $DATA(ZTSK)
SET TEXT=TEXT_ZTSK
DO MES^XPDUTL(.TEXT)
+7 QUIT
+8 ;
DDCIDQO ;search for QOs
+1 NEW RESULT,INPUT,SUB,RETMENU,RETSTRCT,SPINNER,SKIPDIS,ORGTXCLININD,ORGTXSDTM
+2 SET ORGTXCLININD=""
SET ORGTXCLININD=$ORDER(^ORD(101.41,"B","OR GTX CLINICALLY INDICATED DATE",""))
+3 SET ORGTXSDTM=""
SET ORGTXSDTM=$ORDER(^ORD(101.41,"B","OR GTX START DATE/TIME",""))
+4 SET INPUT("GMRCOR CONSULT")=""
+5 SET INPUT("RA OERR EXAM")=""
+6 SET RETMENU=1
SET RETSTRCT=0
SET SPINNER=0
SET SKIPDIS=0
+7 SET SUB="OR608 QO SEARCH"
+8 DO FINDQO^ORQOUTL(.RESULT,.INPUT,SUB,RETMENU,RETSTRCT,SPINNER,SKIPDIS)
+9 DO GETVALS
DO REPORT
+10 QUIT
+11 ;
GETVALS ; get date values for report display
+1 if '$DATA(^TMP($JOB,SUB))
QUIT
+2 NEW INDEX
SET INDEX=""
+3 NEW NAME,ODIEN,DSGRP,DSGPAR
+4 FOR NAME="GMRCOR CONSULT","RA OERR EXAM"
Begin DoDot:1
+5 SET ODIEN=$ORDER(^ORD(101.41,"AB",NAME,""))
if ODIEN=""
QUIT
+6 SET DSGRP=0
FOR
SET DSGRP=$ORDER(^ORD(100.98,DSGRP))
if DSGRP'>0
QUIT
Begin DoDot:2
+7 IF $PIECE(^ORD(100.98,DSGRP,0),U,4)=ODIEN
SET DSGPAR(NAME,DSGRP)=DSGRP
End DoDot:2
End DoDot:1
+8 FOR
SET INDEX=$ORDER(^TMP($JOB,SUB,INDEX))
if INDEX=""
QUIT
Begin DoDot:1
+9 IF $DATA(DSGPAR("GMRCOR CONSULT",$PIECE(^ORD(101.41,INDEX,0),U,5)))
DO CONS
+10 IF $DATA(DSGPAR("RA OERR EXAM",$PIECE(^ORD(101.41,INDEX,0),U,5)))
DO RAD
End DoDot:1
+11 QUIT
+12 ;
PAD(X,WIDTH,CHAR) ; -- returns X padded with CHAR to total WIDTH
+1 NEW Y
if $GET(CHAR)=""
SET CHAR=" "
+2 SET Y=X_$$REPEAT^XLFSTR(CHAR,WIDTH-$LENGTH(X))
+3 QUIT Y
+4 ;
REPORT ; show data
+1 KILL ^TMP("OR MSG",$JOB),XMY
+2 NEW CNT,INDEX,ITEM,XMDUZ,XMSUB,XMTEXT,DIFROM
+3 SET CNT=0
SET XMDUZ="OR*3.0*608 SEARCH"
SET XMSUB="DATE DESIRED & CID QO DEFAULTS"
SET XMTEXT="^TMP(""OR MSG"",$J,"
SET XMY(DUZ)=""
SET XMY("G.OR CACS")=""
+4 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="This report lists Imaging and Consult Quick Orders with a default date"
+5 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="value in Date Desired or Clinically Indicated Date."
+6 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=$$PAD("=",78,"=")
+7 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=$$PAD("QO NAME",63," ")_" QO DATE VALUE"
+8 SET INDEX=""
+9 FOR
SET INDEX=$ORDER(^TMP($JOB,SUB,INDEX))
if INDEX=""
QUIT
Begin DoDot:1
+10 SET ITEM=^TMP($JOB,SUB,INDEX)
+11 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=$$PAD($PIECE(ITEM,U,1),63," ")_" "_$PIECE(ITEM,U,5)
+12 IF $DATA(^TMP($JOB,"OR608 QO SEARCH",INDEX,"ORDER MENUS"))
Begin DoDot:2
+13 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=" Used on the following order menu(s):"
+14 NEW OM
SET OM=""
FOR
SET OM=$ORDER(^TMP($JOB,"OR608 QO SEARCH",INDEX,"ORDER MENUS",OM))
if OM=""
QUIT
Begin DoDot:3
+15 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=" "_$PIECE(^TMP($JOB,"OR608 QO SEARCH",INDEX,"ORDER MENUS",OM),U)
End DoDot:3
End DoDot:2
+16 IF $DATA(^TMP($JOB,"OR608 QO SEARCH",INDEX,"REMINDER DIALOGS"))
Begin DoDot:2
+17 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=" Used on the following reminder dialog(s):"
+18 NEW DM,DM1
SET DM=""
FOR
SET DM=$ORDER(^TMP($JOB,"OR608 QO SEARCH",INDEX,"REMINDER DIALOGS",DM))
if DM=""
QUIT
Begin DoDot:3
+19 SET DM1=""
FOR
SET DM1=$ORDER(^TMP($JOB,"OR608 QO SEARCH",INDEX,"REMINDER DIALOGS",DM,DM1))
if DM1=""
QUIT
Begin DoDot:4
+20 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=" "_$PIECE(^TMP($JOB,"OR608 QO SEARCH",INDEX,"REMINDER DIALOGS",DM,DM1),U)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 IF CNT=4
SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="None Found"
+22 DO ^XMD
+23 QUIT
+24 ;
CONS ; consult
+1 NEW CID
+2 SET CID=+$ORDER(^ORD(101.41,INDEX,6,"D",ORGTXCLININD,""))
+3 IF $GET(CID)>0
Begin DoDot:1
+4 SET CID=^ORD(101.41,INDEX,6,CID,1)
+5 IF $GET(CID)=""
Begin DoDot:2
+6 ;don't report empty values for CID
SET CID=0
End DoDot:2
QUIT
+7 SET $PIECE(^TMP($JOB,SUB,INDEX),U,5)=CID
End DoDot:1
+8 IF $GET(CID)=0
KILL ^TMP($JOB,SUB,INDEX)
+9 QUIT
+10 ;
RAD ; radiology
+1 NEW DD
+2 SET DD=+$ORDER(^ORD(101.41,INDEX,6,"D",ORGTXSDTM,""))
+3 IF $GET(DD)>0
Begin DoDot:1
+4 SET DD=^ORD(101.41,INDEX,6,DD,1)
+5 ;don't report empty values for date desired
IF $GET(DD)=""
Begin DoDot:2
+6 SET DD=0
End DoDot:2
QUIT
+7 SET $PIECE(^TMP($JOB,SUB,INDEX),U,5)=DD
End DoDot:1
+8 IF $GET(DD)=0
KILL ^TMP($JOB,SUB,INDEX)
+9 QUIT
