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

ORWOD.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; DBIA 5133: reading ^PXRMD file #801.41
  1. ;
  1. Q
  1. ;
  1. INSTALL ;Post-install entry point for OR*3*243
  1. D MAIN
  1. Q
  1. ;
  1. ATWILL ;Entry point for ORDER MENU MANAGEMENT menu - ORCM MGMT opt MR
  1. W !,"This option generates two Quick Order (QO) reports to assist in the"
  1. W !,"evaluation of Med QOs that may need to be updated to accommodate the"
  1. W !,"three new fields exported in CPRS GUI v27: Route, IV Type and Schedule."
  1. W !,"One report lists Med QOs that are contained in another entry such as an"
  1. W !,"order menu, order set or reminder dialog. The other report lists Med QOs"
  1. W !,"that are stand alone and are not included in another entry. These reports"
  1. W !,"will be sent to you via Mailman.",!
  1. S DIR(0)="FAO",DIR("A")="Do you wish to continue? " D ^DIR Q:X=""!(X="^")
  1. S ORCDD=$TR(X,"yn","YN") I ORCDD'="Y",ORCDD'="N" W " Enter Y or N",! G ATWILL
  1. I ORCDD="N" W "...report not compiled" Q ;DJE/VM *322 X changed to ORCDD
  1. W !,"Compiling Med Quick Order check report..."
  1. D MAIN
  1. W !,"...QO check report compiled and mailed to ",$P(^VA(200,DUZ,0),U)
  1. Q
  1. ;
  1. MAIN ;Main calls for QO Reports
  1. N ANCSTR,I,PSJNOPC,XMDUN,XMSUB
  1. D NTRY
  1. ; ANCSTR='ancestors', i.e., QO being used on a menu/Reminder Dialogs
  1. F ANCSTR="Y","N" D
  1. . D MAILSU
  1. . D SEND(XMSUB,DUZ)
  1. D CLEANUP
  1. Q
  1. ;
  1. ANCSTR ;Determine QO usage - called by XSET and MM
  1. S ANCSTR="N"
  1. I $O(^ORD(101.41,"AD",ODIENXT,0))!($D(^TMP("OR",$J,"RD",ODIENXT))=0) S ANCSTR="Y"
  1. Q
  1. ;
  1. XSET ;Set QO record for display
  1. D ANCSTR
  1. 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)
  1. Q
  1. ;
  1. NTRY ;Compiling report
  1. N AFIND,DIEN,DOSE,DSPLGRP,DSPLGPTR,GETXT,HIT,NODE3,ODALIMIT,ODARATE,ODAROUTE,ODASCHD,ODATYPE,ODIEN,ODIENXT,ORDIALOG,PTEXT,PTYPE,RC,REC,TYPE,XSET
  1. K ^TMP("OR",$J)
  1. S (DSPLGRP,DSPLGPTR,ODIEN,ODIENXT,TYPE)=""
  1. 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)"
  1. S DOSE=+$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0)) ;use for MM tag
  1. ;
  1. ; Order Dialogs Structure, Menus - orig code by A.Puleo
  1. ; Reminder Dialog Type: (PTYPE) E=Dialog Element, G=Dialog Group
  1. F PTYPE="G","E" S DIEN="" D
  1. . F S DIEN=$O(^PXRMD(801.41,"TYPE",PTYPE,DIEN)) Q:DIEN'>0 D ;DBIA 5133
  1. .. ; PTEXT is 'FINDING ITEM' where 101.41 refers to ^ORD(101.41)
  1. .. ; Example: ^PXRMD(801.41,2515,1)="^^3^^51;ORD(101.41,"
  1. .. S PTEXT=$P($G(^PXRMD(801.41,DIEN,1)),U,5),AFIND=""
  1. .. I PTEXT[101.41 S ^TMP("OR",$J,"RD",$P(PTEXT,";"))=DIEN
  1. .. F S AFIND=$O(^PXRMD(801.41,DIEN,3,"B",AFIND)) Q:AFIND="" D
  1. ... I AFIND[101.41 S ^TMP("OR",$J,"RD",$P(AFIND,";"))=DIEN
  1. ;
  1. ; find IEN for the 'PSJI OR PAT FLUID OE' entry in Order Dialog File
  1. S ODIEN=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
  1. ;
  1. ; loop thru Display Group File, file # 100.98 & store all
  1. ; Display Group entries that have a pointer to 'PSJI OR PAT FLUID OE'
  1. ; in field # 4 or Default Dialog field
  1. F S DSPLGRP=$O(^ORD(100.98,DSPLGRP)) Q:DSPLGRP'?1N.N D
  1. . I ODIEN=$P($G(^ORD(100.98,DSPLGRP,0)),U,4) S ^TMP("OR",$J,"DG",DSPLGRP)=ODIEN
  1. ;
  1. ; loop though Order Dialog file to
  1. ; find each entry that is an IV Quick Order. Do this by checking
  1. ; field #4 or TYPE field for a 'Q' & then check field #5 or
  1. ; DISPLAY GROUP field for a pointer to one of the display groups found
  1. ; above. If both conditions are true then continue to next step,
  1. ; if not, continue looping.
  1. F S ODIENXT=$O(^ORD(101.41,ODIENXT)) Q:ODIENXT'?1N.N D
  1. . D MM
  1. . S TYPE=$P($G(^ORD(101.41,ODIENXT,0)),U,4) Q:TYPE'="Q"
  1. . S DSPLGPTR=$P($G(^ORD(101.41,ODIENXT,0)),U,5) Q:$G(DSPLGPTR)="" ;no display group pointer in QO
  1. . Q:'$G(^TMP("OR",$J,"DG",DSPLGPTR)) ;no such display group in compiled data
  1. . S REC=^ORD(101.41,ODIENXT,0)
  1. . ;
  1. . K ORDIALOG
  1. . ; call GETQDLG^ORCD to build the Order dialog array (ORDIALOG())
  1. . D GETQDLG^ORCD(ODIENXT) S (HIT)=0
  1. . ;
  1. . ;ZW ORDIALOG("B") ;ORDIALOG() listing
  1. . ; set variables for 'TYPE' (IV TYPE), 'ROUTE', 'SCHEDULE', 'RATE', 'LIMITATION'
  1. . 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))
  1. . ;
  1. . ; Quick Orders to be displayed to end user in First List Message follow:
  1. . ;
  1. . ; IV TYPE is null or ROUTE is null
  1. . I (ODATYPE=""!(ODAROUTE="")) D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),1,1,0)=RC,HIT=1
  1. . ;
  1. . ; IV TYPE is 'I' and SCHEDULE is null
  1. . I ODATYPE="I"&(ODASCHD="") D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),2,1,0)=RC,HIT=1
  1. . ;
  1. . ; IV TYPE is not 'C' or null or RATE is not 1-4#.1#, integer or '@'
  1. . I ODATYPE="C"!(ODATYPE="") D
  1. .. Q:ODARATE["@"
  1. .. Q:ODARATE?1.4N!(ODARATE?1.4N1".".1N) ;integers alone OK
  1. .. S GETXT=$$GETXT(ODARATE," ml/hr")
  1. .. Q:GETXT?1.4N!(GETXT?1.4N1".".1N) ;# ml/hr & #.# ml/hr Rate OK
  1. .. D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),3,1,0)=RC,HIT=1
  1. . ;
  1. . ; IV TYPE is 'I' but RATE not an integer minute or hour or null
  1. . I ODATYPE="I"&(ODARATE'?1.N)&(ODARATE'="") D ;integer alone OK
  1. .. S GETXT=$$GETXT(ODARATE," Minutes| Hours")
  1. .. Q:GETXT?1.3N ;integer # Minutes & # Hours Rate OK
  1. .. D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),4,1,0)=RC,HIT=1
  1. . ;
  1. . ; IV LIMIT or Duration (LIMITATION) was not integer or null
  1. . I ODALIMIT'?.N,ODALIMIT'="" D
  1. .. 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
  1. .. 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
  1. .. Q:ODALIMIT?1"for "1.2N1" days" ;for # days OK
  1. .. Q:ODALIMIT?1.5N1"DOSES"!(ODALIMIT?1"for a total of "1.5N1" doses") ;for a total of # doses OK
  1. .. Q:ODALIMIT?1"with total volume "1.2N1"L"!(ODALIMIT?1"with total volume "1.4N1"ml")
  1. .. Q:ODALIMIT?1"for "1.2N1" hours"
  1. .. D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),5,1,0)=RC,HIT=1
  1. . ;
  1. . ;AGP If IV TYPE="C" and the numbers Additive Frequency do not match the number
  1. . ;of additives
  1. . I ODATYPE="C",$$IVADFCHK^ORWDXM3(.ORDIALOG)=0 D
  1. ..D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),8,1,0)=RC,HIT=1
  1. . ;
  1. . ; Go get next Order Dialog entry if no problems
  1. . I 'HIT Q
  1. . ;
  1. . ; If Quick Order is in First List message then check
  1. . ; the Order Dialog file #101.41, field #58 or AUTO-ACCEPT QUICK ORDER
  1. . ; field. If field #58 is set to 'Y'es then set the field to 'N'o and
  1. . ; then display this Quick Order in the Second List.
  1. . I +$P($G(^ORD(101.41,ODIENXT,5)),U,8) D
  1. .. S $P(^ORD(101.41,ODIENXT,5),U,8)="" ;uncommented, sets AUTO-ACCEPT QUICK ORDER field
  1. .. D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),7,1,0)=RC
  1. Q
  1. ;
  1. GETXT(LOOKIN,SUFFIX) ;Return text occuring prior to suffix
  1. ; e.g. LOOKIN="INFUSE OVER 30 MINUTES",SUFFIX=" MINUTES" returns '30'
  1. N I,ISUFFIX,RSTRG,RTXT,STRG
  1. S I=0,RTXT=""
  1. F S I=I+1,ISUFFIX=$P(SUFFIX,"|",I) Q:ISUFFIX="" D:$F(LOOKIN,ISUFFIX) Q:$G(RTXT)'=""
  1. . S RSTRG=$RE($E(LOOKIN,1,$F(LOOKIN,ISUFFIX)-$L(ISUFFIX)-1))
  1. . S RTXT=$P(RSTRG," ")
  1. Q $RE(RTXT)
  1. ;
  1. MM ;Looks for 'MM' in Order Dialog / original code logic by James Hartin
  1. N ANCSTR,MMREC,NEXT,NODE3,PROMPT,VALUE
  1. S NEXT=1,VALUE=""
  1. F S NEXT=$O(^ORD(101.41,ODIENXT,6,NEXT)) Q:NEXT'?1N.N D
  1. . S VALUE=$G(^ORD(101.41,ODIENXT,6,NEXT,1)),PROMPT=+$P($G(^(0)),U,2)
  1. . S MMREC=^ORD(101.41,ODIENXT,0)
  1. . ; ODIEN^NAME^DISPLAY TEXT^VALUE
  1. . I PROMPT=DOSE,(VALUE["MM ") D
  1. .. D ANCSTR
  1. .. S ^TMP("OR",$J,"QO",ANCSTR,$P(MMREC,U),6,1,0)=ODIENXT_U_$P(MMREC,U)_U_$P(MMREC,U,2)_U_VALUE
  1. Q
  1. ;
  1. MAILSU ;Set-up MAILMAN variables and format ^TMP("OR",$J,"MAIL")
  1. N DASH,DISPNAME,HDRLINE,LEGEND,LEGENDS,NEXT,NUM,NXTLINE,ODIENXT,ODQONAME,ORLEGEND,OROUT,QONAM,QOTOT,QORECORD,SPC
  1. K ^TMP("OR",$J,"MAIL")
  1. ;
  1. ;Title of emails
  1. S:ANCSTR="Y" XMSUB="QOs ON ORDER MENUS/SETS OR REMINDER DIALOGS: "
  1. S:ANCSTR="N" XMSUB="QOs NOT ON ORDER MENUS/SETS OR REMINDER DIALOGS: "
  1. S XMSUB=XMSUB_$$HTE^XLFDT($H)
  1. ;
  1. ;Group 1/A="IV TYPE IS NULL OR ROUTE IS NULL"
  1. ;Group 2/B="IV TYPE IS 'I' AND SCHEDULE IS NULL"
  1. ;Group 3/C="IV TYPE IS NOT 'C' OR NULL OR RATE IS NOT 1-4#.1#, INTERGER OR '@'"
  1. ;Group 4/D="IV TYPE IS 'I' BUT RATE NOT AN INTEGER MINUTE OR HOUR"
  1. ;Group 5/E="IV LIMIT OR DURATION (LIMITATION) WAS NOT NULL OR INTEGER"
  1. ;Group 6/F="ORDER DIALOGS WITH 'MM' IN THE DISPLAY TEXT"
  1. ;Group 7/G="AUTO-ACCEPT QUICK ORDER WAS 'Y'es, NOW SET TO 'N'o"
  1. ;Group 8/H="Number of IV Bags and additives do not matches"
  1. ;
  1. D NTRY^ORWOD1
  1. S ODQONAME="@",SPC=" ",QOTOT=0
  1. F S ODQONAME=$O(^TMP("OR",$J,"QO",ANCSTR,ODQONAME)) Q:ODQONAME="" D
  1. . S (LEGENDS,ORLEGEND,QORECORD)=""
  1. . F S ORLEGEND=$O(^TMP("OR",$J,"QO",ANCSTR,ODQONAME,ORLEGEND)) D Q:ORLEGEND=""
  1. .. I ORLEGEND'="" S LEGENDS=LEGENDS_$C(ORLEGEND+64) S:$G(QORECORD)="" QORECORD=^TMP("OR",$J,"QO",ANCSTR,ODQONAME,ORLEGEND,1,0) Q
  1. .. S NXTLINE=NXTLINE+1,QONAM=$P(QORECORD,U,2),DISPNAME=$P(QORECORD,U,3) S:DISPNAME="" DISPNAME=SPC
  1. .. 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)
  1. .. S ^TMP("OR",$J,"MAIL",NXTLINE,0)=OROUT,QOTOT=QOTOT+1
  1. S NXTLINE=NXTLINE+1,^TMP("OR",$J,"MAIL",NXTLINE,0)=""
  1. S NXTLINE=NXTLINE+1,^TMP("OR",$J,"MAIL",NXTLINE,0)=QOTOT_" = Med Quick Orders"
  1. Q
  1. ;
  1. SEND(XMSUB,USER) ;Send MailMan message to USER
  1. ; Text of message is located in ^TMP("OR",$J,"MAIL",LineNumbers0-n)
  1. ; Subject is the string XMSUB.
  1. N MGIEN,MGROUP,NL,REF,XMDUZ,XMY,XMZ
  1. ;
  1. ;Subject '> 64 characters.
  1. S XMSUB=$E(XMSUB,1,64)
  1. ;Sender is Postmaster.
  1. S XMDUZ=0.5
  1. ;
  1. RETRY ;Get message number.
  1. D XMZ^XMA2
  1. I XMZ<1 G RETRY
  1. ;
  1. ;Load message
  1. M ^XMB(3.9,XMZ,2)=^TMP("OR",$J,"MAIL")
  1. S NL=$O(^XMB(3.9,XMZ,2,""),-1)
  1. S ^XMB(3.9,XMZ,2,0)="^3.92^"_+NL_U_+NL_U_DT
  1. ;
  1. ;Send message to USER
  1. I $G(USER)'="" S XMY(DUZ)="" D ENT1^XMD Q
  1. W !,"Error: No USER defined..message not sent!"
  1. Q
  1. ;
  1. CLEANUP ; Clean-up
  1. K ^TMP("OR",$J)
  1. Q