ORWOD ; SLC/GSS - Utility for Order Dialogs ; 7/24/09 9:55am
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,296,280,322**;DEC 17, 1997;Build 15
;
; DBIA 5133: reading ^PXRMD file #801.41
;
Q
;
INSTALL ;Post-install entry point for OR*3*243
D MAIN
Q
;
ATWILL ;Entry point for ORDER MENU MANAGEMENT menu - ORCM MGMT opt MR
W !,"This option generates two Quick Order (QO) reports to assist in the"
W !,"evaluation of Med QOs that may need to be updated to accommodate the"
W !,"three new fields exported in CPRS GUI v27: Route, IV Type and Schedule."
W !,"One report lists Med QOs that are contained in another entry such as an"
W !,"order menu, order set or reminder dialog. The other report lists Med QOs"
W !,"that are stand alone and are not included in another entry. These reports"
W !,"will be sent to you via Mailman.",!
S DIR(0)="FAO",DIR("A")="Do you wish to continue? " D ^DIR Q:X=""!(X="^")
S ORCDD=$TR(X,"yn","YN") I ORCDD'="Y",ORCDD'="N" W " Enter Y or N",! G ATWILL
I ORCDD="N" W "...report not compiled" Q ;DJE/VM *322 X changed to ORCDD
W !,"Compiling Med Quick Order check report..."
D MAIN
W !,"...QO check report compiled and mailed to ",$P(^VA(200,DUZ,0),U)
Q
;
MAIN ;Main calls for QO Reports
N ANCSTR,I,PSJNOPC,XMDUN,XMSUB
D NTRY
; ANCSTR='ancestors', i.e., QO being used on a menu/Reminder Dialogs
F ANCSTR="Y","N" D
. D MAILSU
. D SEND(XMSUB,DUZ)
D CLEANUP
Q
;
ANCSTR ;Determine QO usage - called by XSET and MM
S ANCSTR="N"
I $O(^ORD(101.41,"AD",ODIENXT,0))!($D(^TMP("OR",$J,"RD",ODIENXT))=0) S ANCSTR="Y"
Q
;
XSET ;Set QO record for display
D ANCSTR
S RC=ODIENXT_U_$P(REC,U)_U_$P(REC,U,2)_U_$G(ODATYPE)_U_$G(ODAROUTE)_U_$G(ODASCHD)_U_$G(ODARATE)_U_$G(ODALIMIT)
Q
;
NTRY ;Compiling report
N AFIND,DIEN,DOSE,DSPLGRP,DSPLGPTR,GETXT,HIT,NODE3,ODALIMIT,ODARATE,ODAROUTE,ODASCHD,ODATYPE,ODIEN,ODIENXT,ORDIALOG,PTEXT,PTYPE,RC,REC,TYPE,XSET
K ^TMP("OR",$J)
S (DSPLGRP,DSPLGPTR,ODIEN,ODIENXT,TYPE)=""
S XSET="S RC=ODIENXT_U_$P(REC,U)_U_$P(REC,U,2)_U_$G(ODATYPE)_U_$G(ODAROUTE)_U_$G(ODASCHD)_U_$G(ODARATE)_U_$G(ODALIMIT)"
S DOSE=+$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0)) ;use for MM tag
;
; Order Dialogs Structure, Menus - orig code by A.Puleo
; Reminder Dialog Type: (PTYPE) E=Dialog Element, G=Dialog Group
F PTYPE="G","E" S DIEN="" D
. F S DIEN=$O(^PXRMD(801.41,"TYPE",PTYPE,DIEN)) Q:DIEN'>0 D ;DBIA 5133
.. ; PTEXT is 'FINDING ITEM' where 101.41 refers to ^ORD(101.41)
.. ; Example: ^PXRMD(801.41,2515,1)="^^3^^51;ORD(101.41,"
.. S PTEXT=$P($G(^PXRMD(801.41,DIEN,1)),U,5),AFIND=""
.. I PTEXT[101.41 S ^TMP("OR",$J,"RD",$P(PTEXT,";"))=DIEN
.. F S AFIND=$O(^PXRMD(801.41,DIEN,3,"B",AFIND)) Q:AFIND="" D
... I AFIND[101.41 S ^TMP("OR",$J,"RD",$P(AFIND,";"))=DIEN
;
; find IEN for the 'PSJI OR PAT FLUID OE' entry in Order Dialog File
S ODIEN=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
;
; loop thru Display Group File, file # 100.98 & store all
; Display Group entries that have a pointer to 'PSJI OR PAT FLUID OE'
; in field # 4 or Default Dialog field
F S DSPLGRP=$O(^ORD(100.98,DSPLGRP)) Q:DSPLGRP'?1N.N D
. I ODIEN=$P($G(^ORD(100.98,DSPLGRP,0)),U,4) S ^TMP("OR",$J,"DG",DSPLGRP)=ODIEN
;
; loop though Order Dialog file to
; find each entry that is an IV Quick Order. Do this by checking
; field #4 or TYPE field for a 'Q' & then check field #5 or
; DISPLAY GROUP field for a pointer to one of the display groups found
; above. If both conditions are true then continue to next step,
; if not, continue looping.
F S ODIENXT=$O(^ORD(101.41,ODIENXT)) Q:ODIENXT'?1N.N D
. D MM
. S TYPE=$P($G(^ORD(101.41,ODIENXT,0)),U,4) Q:TYPE'="Q"
. S DSPLGPTR=$P($G(^ORD(101.41,ODIENXT,0)),U,5) Q:$G(DSPLGPTR)="" ;no display group pointer in QO
. Q:'$G(^TMP("OR",$J,"DG",DSPLGPTR)) ;no such display group in compiled data
. S REC=^ORD(101.41,ODIENXT,0)
. ;
. K ORDIALOG
. ; call GETQDLG^ORCD to build the Order dialog array (ORDIALOG())
. D GETQDLG^ORCD(ODIENXT) S (HIT)=0
. ;
. ;ZW ORDIALOG("B") ;ORDIALOG() listing
. ; set variables for 'TYPE' (IV TYPE), 'ROUTE', 'SCHEDULE', 'RATE', 'LIMITATION'
. F I=1:1:5 S @($P("ODATYPE,ODAROUTE,ODASCHD,ODARATE,ODALIMIT",",",I))=$G(ORDIALOG($P($G(ORDIALOG("B",$P("TYPE,ROUTE,SCHEDULE,INFUSION RATE,LIMITATION",",",I))),U,2),1))
. ;
. ; Quick Orders to be displayed to end user in First List Message follow:
. ;
. ; IV TYPE is null or ROUTE is null
. I (ODATYPE=""!(ODAROUTE="")) D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),1,1,0)=RC,HIT=1
. ;
. ; IV TYPE is 'I' and SCHEDULE is null
. I ODATYPE="I"&(ODASCHD="") D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),2,1,0)=RC,HIT=1
. ;
. ; IV TYPE is not 'C' or null or RATE is not 1-4#.1#, integer or '@'
. I ODATYPE="C"!(ODATYPE="") D
.. Q:ODARATE["@"
.. Q:ODARATE?1.4N!(ODARATE?1.4N1".".1N) ;integers alone OK
.. S GETXT=$$GETXT(ODARATE," ml/hr")
.. Q:GETXT?1.4N!(GETXT?1.4N1".".1N) ;# ml/hr & #.# ml/hr Rate OK
.. D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),3,1,0)=RC,HIT=1
. ;
. ; IV TYPE is 'I' but RATE not an integer minute or hour or null
. I ODATYPE="I"&(ODARATE'?1.N)&(ODARATE'="") D ;integer alone OK
.. S GETXT=$$GETXT(ODARATE," Minutes| Hours")
.. Q:GETXT?1.3N ;integer # Minutes & # Hours Rate OK
.. D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),4,1,0)=RC,HIT=1
. ;
. ; IV LIMIT or Duration (LIMITATION) was not integer or null
. I ODALIMIT'?.N,ODALIMIT'="" D
.. Q:ODALIMIT?1.2N1"D"!(ODALIMIT?1.3N1"H")!(ODALIMIT?1.4N1"ML")!(ODALIMIT?1.4N1" ML")!(ODALIMIT?1.2N1"L")!(ODALIMIT?1.4N1"CC")!(ODALIMIT?1.4N1" CC") ;#D, #H, #ML, #L, #CC Limit OK
.. Q:ODALIMIT?1.2N1"d"!(ODALIMIT?1.3N1"h")!(ODALIMIT?1.4N1"ml")!(ODALIMIT?1.4n1" ml")!(ODALIMIT?1.2N1"l")!(ODALIMIT?1.4N1"cc")!(ODALIMIT?1.4N1" cc") ;#d, #h, #ml, #l, #cc Limit OK
.. Q:ODALIMIT?1"for "1.2N1" days" ;for # days OK
.. Q:ODALIMIT?1.5N1"DOSES"!(ODALIMIT?1"for a total of "1.5N1" doses") ;for a total of # doses OK
.. Q:ODALIMIT?1"with total volume "1.2N1"L"!(ODALIMIT?1"with total volume "1.4N1"ml")
.. Q:ODALIMIT?1"for "1.2N1" hours"
.. D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),5,1,0)=RC,HIT=1
. ;
. ;AGP If IV TYPE="C" and the numbers Additive Frequency do not match the number
. ;of additives
. I ODATYPE="C",$$IVADFCHK^ORWDXM3(.ORDIALOG)=0 D
..D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),8,1,0)=RC,HIT=1
. ;
. ; Go get next Order Dialog entry if no problems
. I 'HIT Q
. ;
. ; If Quick Order is in First List message then check
. ; the Order Dialog file #101.41, field #58 or AUTO-ACCEPT QUICK ORDER
. ; field. If field #58 is set to 'Y'es then set the field to 'N'o and
. ; then display this Quick Order in the Second List.
. I +$P($G(^ORD(101.41,ODIENXT,5)),U,8) D
.. S $P(^ORD(101.41,ODIENXT,5),U,8)="" ;uncommented, sets AUTO-ACCEPT QUICK ORDER field
.. D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),7,1,0)=RC
Q
;
GETXT(LOOKIN,SUFFIX) ;Return text occuring prior to suffix
; e.g. LOOKIN="INFUSE OVER 30 MINUTES",SUFFIX=" MINUTES" returns '30'
N I,ISUFFIX,RSTRG,RTXT,STRG
S I=0,RTXT=""
F S I=I+1,ISUFFIX=$P(SUFFIX,"|",I) Q:ISUFFIX="" D:$F(LOOKIN,ISUFFIX) Q:$G(RTXT)'=""
. S RSTRG=$RE($E(LOOKIN,1,$F(LOOKIN,ISUFFIX)-$L(ISUFFIX)-1))
. S RTXT=$P(RSTRG," ")
Q $RE(RTXT)
;
MM ;Looks for 'MM' in Order Dialog / original code logic by James Hartin
N ANCSTR,MMREC,NEXT,NODE3,PROMPT,VALUE
S NEXT=1,VALUE=""
F S NEXT=$O(^ORD(101.41,ODIENXT,6,NEXT)) Q:NEXT'?1N.N D
. S VALUE=$G(^ORD(101.41,ODIENXT,6,NEXT,1)),PROMPT=+$P($G(^(0)),U,2)
. S MMREC=^ORD(101.41,ODIENXT,0)
. ; ODIEN^NAME^DISPLAY TEXT^VALUE
. I PROMPT=DOSE,(VALUE["MM ") D
.. D ANCSTR
.. S ^TMP("OR",$J,"QO",ANCSTR,$P(MMREC,U),6,1,0)=ODIENXT_U_$P(MMREC,U)_U_$P(MMREC,U,2)_U_VALUE
Q
;
MAILSU ;Set-up MAILMAN variables and format ^TMP("OR",$J,"MAIL")
N DASH,DISPNAME,HDRLINE,LEGEND,LEGENDS,NEXT,NUM,NXTLINE,ODIENXT,ODQONAME,ORLEGEND,OROUT,QONAM,QOTOT,QORECORD,SPC
K ^TMP("OR",$J,"MAIL")
;
;Title of emails
S:ANCSTR="Y" XMSUB="QOs ON ORDER MENUS/SETS OR REMINDER DIALOGS: "
S:ANCSTR="N" XMSUB="QOs NOT ON ORDER MENUS/SETS OR REMINDER DIALOGS: "
S XMSUB=XMSUB_$$HTE^XLFDT($H)
;
;Group 1/A="IV TYPE IS NULL OR ROUTE IS NULL"
;Group 2/B="IV TYPE IS 'I' AND SCHEDULE IS NULL"
;Group 3/C="IV TYPE IS NOT 'C' OR NULL OR RATE IS NOT 1-4#.1#, INTERGER OR '@'"
;Group 4/D="IV TYPE IS 'I' BUT RATE NOT AN INTEGER MINUTE OR HOUR"
;Group 5/E="IV LIMIT OR DURATION (LIMITATION) WAS NOT NULL OR INTEGER"
;Group 6/F="ORDER DIALOGS WITH 'MM' IN THE DISPLAY TEXT"
;Group 7/G="AUTO-ACCEPT QUICK ORDER WAS 'Y'es, NOW SET TO 'N'o"
;Group 8/H="Number of IV Bags and additives do not matches"
;
D NTRY^ORWOD1
S ODQONAME="@",SPC=" ",QOTOT=0
F S ODQONAME=$O(^TMP("OR",$J,"QO",ANCSTR,ODQONAME)) Q:ODQONAME="" D
. S (LEGENDS,ORLEGEND,QORECORD)=""
. F S ORLEGEND=$O(^TMP("OR",$J,"QO",ANCSTR,ODQONAME,ORLEGEND)) D Q:ORLEGEND=""
.. I ORLEGEND'="" S LEGENDS=LEGENDS_$C(ORLEGEND+64) S:$G(QORECORD)="" QORECORD=^TMP("OR",$J,"QO",ANCSTR,ODQONAME,ORLEGEND,1,0) Q
.. S NXTLINE=NXTLINE+1,QONAM=$P(QORECORD,U,2),DISPNAME=$P(QORECORD,U,3) S:DISPNAME="" DISPNAME=SPC
.. S OROUT=$J($P(QORECORD,U,1),5)_" "_$E(QONAM,1,30)_$E(SPC,1,30-$L(QONAM))_" "_$E(DISPNAME,1,30)_$E(SPC,1,30-$L(DISPNAME))_" "_$J(LEGENDS,6)
.. S ^TMP("OR",$J,"MAIL",NXTLINE,0)=OROUT,QOTOT=QOTOT+1
S NXTLINE=NXTLINE+1,^TMP("OR",$J,"MAIL",NXTLINE,0)=""
S NXTLINE=NXTLINE+1,^TMP("OR",$J,"MAIL",NXTLINE,0)=QOTOT_" = Med Quick Orders"
Q
;
SEND(XMSUB,USER) ;Send MailMan message to USER
; Text of message is located in ^TMP("OR",$J,"MAIL",LineNumbers0-n)
; Subject is the string XMSUB.
N MGIEN,MGROUP,NL,REF,XMDUZ,XMY,XMZ
;
;Subject '> 64 characters.
S XMSUB=$E(XMSUB,1,64)
;Sender is Postmaster.
S XMDUZ=0.5
;
RETRY ;Get message number.
D XMZ^XMA2
I XMZ<1 G RETRY
;
;Load message
M ^XMB(3.9,XMZ,2)=^TMP("OR",$J,"MAIL")
S NL=$O(^XMB(3.9,XMZ,2,""),-1)
S ^XMB(3.9,XMZ,2,0)="^3.92^"_+NL_U_+NL_U_DT
;
;Send message to USER
I $G(USER)'="" S XMY(DUZ)="" D ENT1^XMD Q
W !,"Error: No USER defined..message not sent!"
Q
;
CLEANUP ; Clean-up
K ^TMP("OR",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWOD 10276 printed Apr 09, 2024@21:29:49 Page 2
ORWOD ; SLC/GSS - Utility for Order Dialogs ; 7/24/09 9:55am
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,296,280,322**;DEC 17, 1997;Build 15
+2 ;
+3 ; DBIA 5133: reading ^PXRMD file #801.41
+4 ;
+5 QUIT
+6 ;
INSTALL ;Post-install entry point for OR*3*243
+1 DO MAIN
+2 QUIT
+3 ;
ATWILL ;Entry point for ORDER MENU MANAGEMENT menu - ORCM MGMT opt MR
+1 WRITE !,"This option generates two Quick Order (QO) reports to assist in the"
+2 WRITE !,"evaluation of Med QOs that may need to be updated to accommodate the"
+3 WRITE !,"three new fields exported in CPRS GUI v27: Route, IV Type and Schedule."
+4 WRITE !,"One report lists Med QOs that are contained in another entry such as an"
+5 WRITE !,"order menu, order set or reminder dialog. The other report lists Med QOs"
+6 WRITE !,"that are stand alone and are not included in another entry. These reports"
+7 WRITE !,"will be sent to you via Mailman.",!
+8 SET DIR(0)="FAO"
SET DIR("A")="Do you wish to continue? "
DO ^DIR
if X=""!(X="^")
QUIT
+9 SET ORCDD=$TRANSLATE(X,"yn","YN")
IF ORCDD'="Y"
IF ORCDD'="N"
WRITE " Enter Y or N",!
GOTO ATWILL
+10 ;DJE/VM *322 X changed to ORCDD
IF ORCDD="N"
WRITE "...report not compiled"
QUIT
+11 WRITE !,"Compiling Med Quick Order check report..."
+12 DO MAIN
+13 WRITE !,"...QO check report compiled and mailed to ",$PIECE(^VA(200,DUZ,0),U)
+14 QUIT
+15 ;
MAIN ;Main calls for QO Reports
+1 NEW ANCSTR,I,PSJNOPC,XMDUN,XMSUB
+2 DO NTRY
+3 ; ANCSTR='ancestors', i.e., QO being used on a menu/Reminder Dialogs
+4 FOR ANCSTR="Y","N"
Begin DoDot:1
+5 DO MAILSU
+6 DO SEND(XMSUB,DUZ)
End DoDot:1
+7 DO CLEANUP
+8 QUIT
+9 ;
ANCSTR ;Determine QO usage - called by XSET and MM
+1 SET ANCSTR="N"
+2 IF $ORDER(^ORD(101.41,"AD",ODIENXT,0))!($DATA(^TMP("OR",$JOB,"RD",ODIENXT))=0)
SET ANCSTR="Y"
+3 QUIT
+4 ;
XSET ;Set QO record for display
+1 DO ANCSTR
+2 SET RC=ODIENXT_U_$PIECE(REC,U)_U_$PIECE(REC,U,2)_U_$GET(ODATYPE)_U_$GET(ODAROUTE)_U_$GET(ODASCHD)_U_$GET(ODARATE)_U_$GET(ODALIMIT)
+3 QUIT
+4 ;
NTRY ;Compiling report
+1 NEW AFIND,DIEN,DOSE,DSPLGRP,DSPLGPTR,GETXT,HIT,NODE3,ODALIMIT,ODARATE,ODAROUTE,ODASCHD,ODATYPE,ODIEN,ODIENXT,ORDIALOG,PTEXT,PTYPE,RC,REC,TYPE,XSET
+2 KILL ^TMP("OR",$JOB)
+3 SET (DSPLGRP,DSPLGPTR,ODIEN,ODIENXT,TYPE)=""
+4 SET XSET="S RC=ODIENXT_U_$P(REC,U)_U_$P(REC,U,2)_U_$G(ODATYPE)_U_$G(ODAROUTE)_U_$G(ODASCHD)_U_$G(ODARATE)_U_$G(ODALIMIT)"
+5 ;use for MM tag
SET DOSE=+$ORDER(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0))
+6 ;
+7 ; Order Dialogs Structure, Menus - orig code by A.Puleo
+8 ; Reminder Dialog Type: (PTYPE) E=Dialog Element, G=Dialog Group
+9 FOR PTYPE="G","E"
SET DIEN=""
Begin DoDot:1
+10 ;DBIA 5133
FOR
SET DIEN=$ORDER(^PXRMD(801.41,"TYPE",PTYPE,DIEN))
if DIEN'>0
QUIT
Begin DoDot:2
+11 ; PTEXT is 'FINDING ITEM' where 101.41 refers to ^ORD(101.41)
+12 ; Example: ^PXRMD(801.41,2515,1)="^^3^^51;ORD(101.41,"
+13 SET PTEXT=$PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5)
SET AFIND=""
+14 IF PTEXT[101.41
SET ^TMP("OR",$JOB,"RD",$PIECE(PTEXT,";"))=DIEN
+15 FOR
SET AFIND=$ORDER(^PXRMD(801.41,DIEN,3,"B",AFIND))
if AFIND=""
QUIT
Begin DoDot:3
+16 IF AFIND[101.41
SET ^TMP("OR",$JOB,"RD",$PIECE(AFIND,";"))=DIEN
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 ; find IEN for the 'PSJI OR PAT FLUID OE' entry in Order Dialog File
+19 SET ODIEN=$ORDER(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
+20 ;
+21 ; loop thru Display Group File, file # 100.98 & store all
+22 ; Display Group entries that have a pointer to 'PSJI OR PAT FLUID OE'
+23 ; in field # 4 or Default Dialog field
+24 FOR
SET DSPLGRP=$ORDER(^ORD(100.98,DSPLGRP))
if DSPLGRP'?1N.N
QUIT
Begin DoDot:1
+25 IF ODIEN=$PIECE($GET(^ORD(100.98,DSPLGRP,0)),U,4)
SET ^TMP("OR",$JOB,"DG",DSPLGRP)=ODIEN
End DoDot:1
+26 ;
+27 ; loop though Order Dialog file to
+28 ; find each entry that is an IV Quick Order. Do this by checking
+29 ; field #4 or TYPE field for a 'Q' & then check field #5 or
+30 ; DISPLAY GROUP field for a pointer to one of the display groups found
+31 ; above. If both conditions are true then continue to next step,
+32 ; if not, continue looping.
+33 FOR
SET ODIENXT=$ORDER(^ORD(101.41,ODIENXT))
if ODIENXT'?1N.N
QUIT
Begin DoDot:1
+34 DO MM
+35 SET TYPE=$PIECE($GET(^ORD(101.41,ODIENXT,0)),U,4)
if TYPE'="Q"
QUIT
+36 ;no display group pointer in QO
SET DSPLGPTR=$PIECE($GET(^ORD(101.41,ODIENXT,0)),U,5)
if $GET(DSPLGPTR)=""
QUIT
+37 ;no such display group in compiled data
if '$GET(^TMP("OR",$JOB,"DG",DSPLGPTR))
QUIT
+38 SET REC=^ORD(101.41,ODIENXT,0)
+39 ;
+40 KILL ORDIALOG
+41 ; call GETQDLG^ORCD to build the Order dialog array (ORDIALOG())
+42 DO GETQDLG^ORCD(ODIENXT)
SET (HIT)=0
+43 ;
+44 ;ZW ORDIALOG("B") ;ORDIALOG() listing
+45 ; set variables for 'TYPE' (IV TYPE), 'ROUTE', 'SCHEDULE', 'RATE', 'LIMITATION'
+46 FOR I=1:1:5
SET @($PIECE("ODATYPE,ODAROUTE,ODASCHD,ODARATE,ODALIMIT",",",I))=$GET(ORDIALOG($PIECE($GET(ORDIALOG("B",$PIECE("TYPE,ROUTE,SCHEDULE,INFUSION RATE,LIMITATION",",",I))),U,2),1))
+47 ;
+48 ; Quick Orders to be displayed to end user in First List Message follow:
+49 ;
+50 ; IV TYPE is null or ROUTE is null
+51 IF (ODATYPE=""!(ODAROUTE=""))
DO XSET
SET ^TMP("OR",$JOB,"QO",ANCSTR,$PIECE(REC,U),1,1,0)=RC
SET HIT=1
+52 ;
+53 ; IV TYPE is 'I' and SCHEDULE is null
+54 IF ODATYPE="I"&(ODASCHD="")
DO XSET
SET ^TMP("OR",$JOB,"QO",ANCSTR,$PIECE(REC,U),2,1,0)=RC
SET HIT=1
+55 ;
+56 ; IV TYPE is not 'C' or null or RATE is not 1-4#.1#, integer or '@'
+57 IF ODATYPE="C"!(ODATYPE="")
Begin DoDot:2
+58 if ODARATE["@"
QUIT
+59 ;integers alone OK
if ODARATE?1.4N!(ODARATE?1.4N1".".1N)
QUIT
+60 SET GETXT=$$GETXT(ODARATE," ml/hr")
+61 ;# ml/hr & #.# ml/hr Rate OK
if GETXT?1.4N!(GETXT?1.4N1".".1N)
QUIT
+62 DO XSET
SET ^TMP("OR",$JOB,"QO",ANCSTR,$PIECE(REC,U),3,1,0)=RC
SET HIT=1
End DoDot:2
+63 ;
+64 ; IV TYPE is 'I' but RATE not an integer minute or hour or null
+65 ;integer alone OK
IF ODATYPE="I"&(ODARATE'?1.N)&(ODARATE'="")
Begin DoDot:2
+66 SET GETXT=$$GETXT(ODARATE," Minutes| Hours")
+67 ;integer # Minutes & # Hours Rate OK
if GETXT?1.3N
QUIT
+68 DO XSET
SET ^TMP("OR",$JOB,"QO",ANCSTR,$PIECE(REC,U),4,1,0)=RC
SET HIT=1
End DoDot:2
+69 ;
+70 ; IV LIMIT or Duration (LIMITATION) was not integer or null
+71 IF ODALIMIT'?.N
IF ODALIMIT'=""
Begin DoDot:2
+72 ;#D, #H, #ML, #L, #CC Limit OK
if ODALIMIT?1.2N1"D"!(ODALIMIT?1.3N1"H")!(ODALIMIT?1.4N1"ML")!(ODALIMIT?1.4N1" ML")!(ODALIMIT?1.2N1"L")!(ODALIMIT?1.4N1"CC")!(ODALIMIT?1.4N1" CC")
QUIT
+73 ;#d, #h, #ml, #l, #cc Limit OK
if ODALIMIT?1.2N1"d"!(ODALIMIT?1.3N1"h")!(ODALIMIT?1.4N1"ml")!(ODALIMIT?1.4n1" ml")!(ODALIMIT?1.2N1"l")!(ODALIMIT?1.4N1"cc")!(ODALIMIT?1.4N1" cc")
QUIT
+74 ;for # days OK
if ODALIMIT?1"for "1.2N1" days"
QUIT
+75 ;for a total of # doses OK
if ODALIMIT?1.5N1"DOSES"!(ODALIMIT?1"for a total of "1.5N1" doses")
QUIT
+76 if ODALIMIT?1"with total volume "1.2N1"L"!(ODALIMIT?1"with total volume "1.4N1"ml")
QUIT
+77 if ODALIMIT?1"for "1.2N1" hours"
QUIT
+78 DO XSET
SET ^TMP("OR",$JOB,"QO",ANCSTR,$PIECE(REC,U),5,1,0)=RC
SET HIT=1
End DoDot:2
+79 ;
+80 ;AGP If IV TYPE="C" and the numbers Additive Frequency do not match the number
+81 ;of additives
+82 IF ODATYPE="C"
IF $$IVADFCHK^ORWDXM3(.ORDIALOG)=0
Begin DoDot:2
+83 DO XSET
SET ^TMP("OR",$JOB,"QO",ANCSTR,$PIECE(REC,U),8,1,0)=RC
SET HIT=1
End DoDot:2
+84 ;
+85 ; Go get next Order Dialog entry if no problems
+86 IF 'HIT
QUIT
+87 ;
+88 ; If Quick Order is in First List message then check
+89 ; the Order Dialog file #101.41, field #58 or AUTO-ACCEPT QUICK ORDER
+90 ; field. If field #58 is set to 'Y'es then set the field to 'N'o and
+91 ; then display this Quick Order in the Second List.
+92 IF +$PIECE($GET(^ORD(101.41,ODIENXT,5)),U,8)
Begin DoDot:2
+93 ;uncommented, sets AUTO-ACCEPT QUICK ORDER field
SET $PIECE(^ORD(101.41,ODIENXT,5),U,8)=""
+94 DO XSET
SET ^TMP("OR",$JOB,"QO",ANCSTR,$PIECE(REC,U),7,1,0)=RC
End DoDot:2
End DoDot:1
+95 QUIT
+96 ;
GETXT(LOOKIN,SUFFIX) ;Return text occuring prior to suffix
+1 ; e.g. LOOKIN="INFUSE OVER 30 MINUTES",SUFFIX=" MINUTES" returns '30'
+2 NEW I,ISUFFIX,RSTRG,RTXT,STRG
+3 SET I=0
SET RTXT=""
+4 FOR
SET I=I+1
SET ISUFFIX=$PIECE(SUFFIX,"|",I)
if ISUFFIX=""
QUIT
if $FIND(LOOKIN,ISUFFIX)
Begin DoDot:1
+5 SET RSTRG=$REVERSE($EXTRACT(LOOKIN,1,$FIND(LOOKIN,ISUFFIX)-$LENGTH(ISUFFIX)-1))
+6 SET RTXT=$PIECE(RSTRG," ")
End DoDot:1
if $GET(RTXT)'=""
QUIT
+7 QUIT $REVERSE(RTXT)
+8 ;
MM ;Looks for 'MM' in Order Dialog / original code logic by James Hartin
+1 NEW ANCSTR,MMREC,NEXT,NODE3,PROMPT,VALUE
+2 SET NEXT=1
SET VALUE=""
+3 FOR
SET NEXT=$ORDER(^ORD(101.41,ODIENXT,6,NEXT))
if NEXT'?1N.N
QUIT
Begin DoDot:1
+4 SET VALUE=$GET(^ORD(101.41,ODIENXT,6,NEXT,1))
SET PROMPT=+$PIECE($GET(^(0)),U,2)
+5 SET MMREC=^ORD(101.41,ODIENXT,0)
+6 ; ODIEN^NAME^DISPLAY TEXT^VALUE
+7 IF PROMPT=DOSE
IF (VALUE["MM ")
Begin DoDot:2
+8 DO ANCSTR
+9 SET ^TMP("OR",$JOB,"QO",ANCSTR,$PIECE(MMREC,U),6,1,0)=ODIENXT_U_$PIECE(MMREC,U)_U_$PIECE(MMREC,U,2)_U_VALUE
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
MAILSU ;Set-up MAILMAN variables and format ^TMP("OR",$J,"MAIL")
+1 NEW DASH,DISPNAME,HDRLINE,LEGEND,LEGENDS,NEXT,NUM,NXTLINE,ODIENXT,ODQONAME,ORLEGEND,OROUT,QONAM,QOTOT,QORECORD,SPC
+2 KILL ^TMP("OR",$JOB,"MAIL")
+3 ;
+4 ;Title of emails
+5 if ANCSTR="Y"
SET XMSUB="QOs ON ORDER MENUS/SETS OR REMINDER DIALOGS: "
+6 if ANCSTR="N"
SET XMSUB="QOs NOT ON ORDER MENUS/SETS OR REMINDER DIALOGS: "
+7 SET XMSUB=XMSUB_$$HTE^XLFDT($HOROLOG)
+8 ;
+9 ;Group 1/A="IV TYPE IS NULL OR ROUTE IS NULL"
+10 ;Group 2/B="IV TYPE IS 'I' AND SCHEDULE IS NULL"
+11 ;Group 3/C="IV TYPE IS NOT 'C' OR NULL OR RATE IS NOT 1-4#.1#, INTERGER OR '@'"
+12 ;Group 4/D="IV TYPE IS 'I' BUT RATE NOT AN INTEGER MINUTE OR HOUR"
+13 ;Group 5/E="IV LIMIT OR DURATION (LIMITATION) WAS NOT NULL OR INTEGER"
+14 ;Group 6/F="ORDER DIALOGS WITH 'MM' IN THE DISPLAY TEXT"
+15 ;Group 7/G="AUTO-ACCEPT QUICK ORDER WAS 'Y'es, NOW SET TO 'N'o"
+16 ;Group 8/H="Number of IV Bags and additives do not matches"
+17 ;
+18 DO NTRY^ORWOD1
+19 SET ODQONAME="@"
SET SPC=" "
SET QOTOT=0
+20 FOR
SET ODQONAME=$ORDER(^TMP("OR",$JOB,"QO",ANCSTR,ODQONAME))
if ODQONAME=""
QUIT
Begin DoDot:1
+21 SET (LEGENDS,ORLEGEND,QORECORD)=""
+22 FOR
SET ORLEGEND=$ORDER(^TMP("OR",$JOB,"QO",ANCSTR,ODQONAME,ORLEGEND))
Begin DoDot:2
+23 IF ORLEGEND'=""
SET LEGENDS=LEGENDS_$CHAR(ORLEGEND+64)
if $GET(QORECORD)=""
SET QORECORD=^TMP("OR",$JOB,"QO",ANCSTR,ODQONAME,ORLEGEND,1,0)
QUIT
+24 SET NXTLINE=NXTLINE+1
SET QONAM=$PIECE(QORECORD,U,2)
SET DISPNAME=$PIECE(QORECORD,U,3)
if DISPNAME=""
SET DISPNAME=SPC
+25 SET OROUT=$JUSTIFY($PIECE(QORECORD,U,1),5)_" "_$EXTRACT(QONAM,1,30)_$EXTRACT(SPC,1,30-$LENGTH(QONAM))_" "_$EXTRACT(DISPNAME,1,30)_$EXTRACT(SPC,1,30-$LENGTH(DISPNAME))_" "_$JUSTIFY(LEGENDS,6)
+26 SET ^TMP("OR",$JOB,"MAIL",NXTLINE,0)=OROUT
SET QOTOT=QOTOT+1
End DoDot:2
if ORLEGEND=""
QUIT
End DoDot:1
+27 SET NXTLINE=NXTLINE+1
SET ^TMP("OR",$JOB,"MAIL",NXTLINE,0)=""
+28 SET NXTLINE=NXTLINE+1
SET ^TMP("OR",$JOB,"MAIL",NXTLINE,0)=QOTOT_" = Med Quick Orders"
+29 QUIT
+30 ;
SEND(XMSUB,USER) ;Send MailMan message to USER
+1 ; Text of message is located in ^TMP("OR",$J,"MAIL",LineNumbers0-n)
+2 ; Subject is the string XMSUB.
+3 NEW MGIEN,MGROUP,NL,REF,XMDUZ,XMY,XMZ
+4 ;
+5 ;Subject '> 64 characters.
+6 SET XMSUB=$EXTRACT(XMSUB,1,64)
+7 ;Sender is Postmaster.
+8 SET XMDUZ=0.5
+9 ;
RETRY ;Get message number.
+1 DO XMZ^XMA2
+2 IF XMZ<1
GOTO RETRY
+3 ;
+4 ;Load message
+5 MERGE ^XMB(3.9,XMZ,2)=^TMP("OR",$JOB,"MAIL")
+6 SET NL=$ORDER(^XMB(3.9,XMZ,2,""),-1)
+7 SET ^XMB(3.9,XMZ,2,0)="^3.92^"_+NL_U_+NL_U_DT
+8 ;
+9 ;Send message to USER
+10 IF $GET(USER)'=""
SET XMY(DUZ)=""
DO ENT1^XMD
QUIT
+11 WRITE !,"Error: No USER defined..message not sent!"
+12 QUIT
+13 ;
CLEANUP ; Clean-up
+1 KILL ^TMP("OR",$JOB)
+2 QUIT
