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

ORCDLG.m

Go to the documentation of this file.
  1. ORCDLG ;SLC/MKB-Order dialogs ; 08 May 2002 2:12 PM
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,7,46,60,79,94,141**;Dec 17, 1997
  1. ;
  1. EN(ORDIALOG) ; -- process ORDIALOG
  1. Q:'ORDIALOG N TITLE,TYPE,MSG K ^TMP("ORWORD",$J)
  1. S TITLE=$G(^ORD(101.41,ORDIALOG,0)),TYPE=$P(TITLE,U,4),MSG=$P(TITLE,U,3),TITLE=$P(TITLE,U,2)
  1. W !!,?(36-($L(TITLE)\2)),"-- "_TITLE_" --"
  1. I $L(MSG) W $C(7),!!,MSG H 2 Q ;disabled
  1. D SET:TYPE="O",MENU:TYPE="M",ADD:(TYPE="D")!(TYPE="Q")!(TYPE="A")
  1. K ^TMP("ORWORD",$J)
  1. Q
  1. ;
  1. SET ; -- prompt for new order set
  1. N ORSET,ORSEQ,ORSITM,ORSTOP,ORPARENT,ORCHLD,ORS0,ORSIFN,ORPIFN,ORLAST,ORSLOG,X,OREV0
  1. S ORSET=+ORDIALOG Q:'ORSET Q:'$D(^ORD(101.41,ORSET))
  1. I $G(OREVENT) S X=+$P($G(^ORE(100.2,OREVENT,0)),U,2),OREV0=$G(^ORD(100.5,X,0))
  1. X:$D(^ORD(101.41,ORSET,3)) ^(3) ; Entry action
  1. S ORPARENT=$P($G(^ORD(101.41,ORSET,5)),U,6) ;,ORHDR=$P($G(^(5)),U,7)
  1. S ORSLOG=+$E($$NOW^XLFDT,1,12) D:ORPARENT SET^ORCSAVE(+ORDIALOG) ;Parent
  1. S1 S ORSEQ=0 F S ORSEQ=$O(^ORD(101.41,ORSET,10,"B",ORSEQ)) Q:ORSEQ'>0!($G(ORSTOP)) S ORSITM=0 F S ORSITM=$O(^ORD(101.41,ORSET,10,"B",ORSEQ,ORSITM)) Q:'ORSITM D Q:$G(ORSTOP)
  1. . S ORS0=$G(^ORD(101.41,ORSET,10,ORSITM,0)) K ORSIFN
  1. . I $G(OREVENT),$G(ORDSET),+$P(ORS0,U,2)=+$P(OREV0,U,4) Q ;Evt Ord Dlg
  1. . D:$P(ORS0,U,2) EN(+$P(ORS0,U,2))
  1. . I $G(ORSTOP) Q:$G(DIROUT) K:$$CONT ORSTOP Q
  1. . I ORPARENT,$G(ORSIFN) S ORCHLD=+$G(ORCHLD)+1,ORCHLD(ORSIFN,0)=ORSIFN,ORLAST=ORSIFN
  1. S2 I $G(ORSTOP) D G SQ ; delete orders
  1. . N DA,DIK
  1. . S DA=0 F S DA=$O(ORCHLD(DA)) Q:DA'>0 S DIK="^OR(100," D ^DIK
  1. . W !?10,"... orders cancelled.",! H 1
  1. I ORPARENT,$G(ORCHLD) M ^OR(100,ORPIFN,2)=ORCHLD S ^OR(100,ORPIFN,2,0)="^100.002PA^"_ORLAST_U_ORCHLD
  1. ;W !?10,"... orders placed.",! H 1
  1. SQ X:$D(^ORD(101.41,ORSET,4)) ^(4) ; Exit action
  1. Q
  1. ;
  1. N ORI,ORY,XQORM
  1. S ORI=$$LOCK^ORDD41(ORDIALOG) I 'ORI W !!,$P(ORI,U,2) H 2 Q
  1. X:$D(^ORD(101.41,ORDIALOG,3)) ^(3) G:$G(ORQUIT) MNQ ;Entry action
  1. S XQORM("W")="W $S($P(X,U,5)=""H"":IOUON,1:"""")_$P(X,U,3)_IOUOFF"
  1. S ORI=$G(^ORD(101.41,ORDIALOG,5)) S:$P(ORI,U,2) XQORM("M")=$P(ORI,U,2)
  1. S XQORM=ORDIALOG_";ORD(101.41,",XQORM(0)="AD" D EN^XQORM
  1. I Y'>0 S:$G(ORSET)&(X["^") ORSTOP=1 G MNQ
  1. M ORY=Y S ORI=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D EN(+$P(ORY(ORI),U,2))
  1. MNQ X:$D(^ORD(101.41,ORDIALOG,4)) ^(4) ;Exit action
  1. D UNLOCK^ORDD41(ORDIALOG)
  1. Q
  1. ;
  1. ORDER(ORDIALOG) ; -- Execute ORDIALOG, return ORIFN or ^ if unsuccessful
  1. K ^TMP("ORWORD",$J) Q:'$G(ORDIALOG) "^"
  1. N TITLE,TYPE,MSG,NODE0,FIRST,ORDG,ORQUIT,VERIFY,ACTION,ASK,AUTO,ORIFN,ORTYPE,ORCHECK,ORNMSP,ORDUZ,ORLOG
  1. S TITLE=$G(^ORD(101.41,ORDIALOG,0)),TYPE=$P(TITLE,U,4),MSG=$P(TITLE,U,3),TITLE=$P(TITLE,U,2)
  1. W !!,?(36-($L(TITLE)\2)),"-- "_TITLE_" --"
  1. I $L(MSG) W $C(7),!!,MSG H 2 Q "^" ;disabled
  1. I TYPE'="D",TYPE'="Q" W $C(7),!!,"Invalid order dialog!" H 2 Q "^"
  1. D ADD0 S:'$G(ORIFN) ORIFN="^"
  1. K ^TMP("ORWORD",$J)
  1. Q ORIFN
  1. ;
  1. ADD ; -- prompt for new order
  1. ; Requires: ORDIALOG = Order Dialog ifn
  1. ; ORNP = Ordering Provider (ifn in #200)
  1. ; ORVP = Patient (vptr to #2)
  1. ; Optional: ORL = Patient Location (vptr to #44)
  1. ; ORTS = Treating Specialty (ifn in #45.7)
  1. ; ORSET = Order Set (ifn in #101.41, from SET)
  1. ; $$ORDER enters at ADD0 to be able to return ORIFN
  1. ;
  1. N NODE0,FIRST,ORDG,ORQUIT,VERIFY,ACTION,ASK,AUTO,ORIFN,ORTYPE,ORCHECK,ORNMSP,ORDUZ,ORLOG
  1. ADD0 S VALMBCK="R",FIRST=1 Q:'ORDIALOG
  1. S NODE0=$G(^ORD(101.41,ORDIALOG,0)),AUTO=$P($G(^(5)),U,8)
  1. S ORTYPE=$P(NODE0,U,4),ORDG=+$P(NODE0,U,5),ORDUZ=DUZ
  1. S ORLOG=+$$NOW,VERIFY=$P(NODE0,U,8),ASK=$P(NODE0,U,9)
  1. D @("GET"_$S(ORTYPE="Q":"Q",1:"")_"DLG^ORCD(+ORDIALOG)")
  1. I ORDIALOG'>0 W $C(7),!!,"Invalid dialog - cannot place order!" H 1 Q
  1. S ORNMSP=$P($G(^ORD(101.41,ORDIALOG,0)),U,7),ORNMSP=$$NMSP^ORCD(ORNMSP)
  1. I '$$ACTIVE W $C(7),!!,"Inactive orderable item(s) - cannot place order!" H 1 Q
  1. X:$D(^ORD(101.41,+ORDIALOG,3)) ^(3) G:$G(ORQUIT) ADDQ ; entry action
  1. G:ORTYPE="A" ADDQ ; action only
  1. D DISPLAY^ORCHECK ; pkg order check
  1. ADD1 D DIALOG ; Loop thru prompts or components
  1. I $G(ORQUIT) S:$G(ORSET) ORSTOP=1 G:$G(ORSTOP)!$G(DIROUT)!FIRST ADDQ K ORQUIT
  1. D ACCEPT^ORCHECK() S ACTION="P"
  1. I $G(OREVENT),$G(^ORE(100.2,+OREVENT,1)) D ;event occurred
  1. . W !!,"This release event has occurred since you started writing delayed orders."
  1. . W !,"The orders that were signed have now been released; this and any other"
  1. . W !,"unsigned orders will be released immediately upon signature. The Orders"
  1. . W !,"tab will be refreshed in the Active Orders view when finished."
  1. . K OREVENT S $P(^TMP("OR",$J,"ORDERS",0),U,3,4)="^1" ;default view
  1. . N X W !!,"Press <return> to continue ..." R X:DTIME
  1. I VERIFY!$G(ORCHECK) D DISPLAY S ACTION=$$OK G:ACTION="^" ADDQ
  1. I ACTION="E" S FIRST=0 K ORCHECK G ADD1
  1. I ACTION="C" W !?10,"... order cancelled.",! ;G ADDQ
  1. I ACTION="P" D EN^ORCSAVE D
  1. . I '$G(ORIFN) W !?10,"... ERROR - unable to place order.",! H 1 Q
  1. . S ^TMP("ORNEW",$J,ORIFN,1)="" S:$G(ORSET) ORSIFN=ORIFN
  1. . I '$D(^TMP("ORECALL",$J,ORDIALOG)) M ^(ORDIALOG)=ORDIALOG M:$D(^TMP("ORWORD",$J)) ^TMP("ORECALL",$J,ORDIALOG)=^TMP("ORWORD",$J) ;1st values
  1. . W !?10,"... order placed.",!
  1. I ASK,$$ANOTHER D KVALUES S FIRST=1,ORLOG=+$$NOW G ADD1
  1. ADDQ X:$D(^ORD(101.41,+ORDIALOG,4)) ^(4) ; exit action
  1. Q
  1. ;
  1. DIALOG ; -- loop through prompts in dialog
  1. N SEQ,DA K ORQUIT
  1. I $G(ORTYPE)'="A" S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0!($G(ORQUIT)) S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D Q:$G(ORQUIT)
  1. . Q:$P(^ORD(101.41,+ORDIALOG,10,DA,0),U,11) ; child
  1. . D EN^ORCDLG1(DA)
  1. Q
  1. ;
  1. ANOTHER() ; -- Add another order?
  1. I ASK>1 Q 1 ; Don't ask, go right to another order
  1. N X,Y,DIR
  1. S DIR("A")="Add another "_$P(^ORD(101.41,+ORDIALOG,0),U,2)_" order? "
  1. S DIR(0)="YA",DIR("B")="NO" D ^DIR
  1. Q +Y
  1. ;
  1. CONT() ; -- continue w/set?
  1. N X,Y,DIR
  1. S DIR(0)="YA",DIR("A")="Do you want to continue with this order set? "
  1. S DIR("?")="Enter NO if you wish to cancel the entire order set; YES will cancel only this one order."
  1. S DIR("B")="YES" D ^DIR
  1. Q +Y
  1. ;
  1. DISPLAY ; -- Display new order on screen
  1. N SEQ,DA,X,PROMPT,MULT,I,TITLE
  1. W !!,$$REPEAT^XLFSTR("-",79)
  1. S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0 S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D
  1. . S X=$G(^ORD(101.41,+ORDIALOG,10,DA,0)) Q:$P(X,U,11) ;child
  1. . S PROMPT=$P(X,U,2),MULT=$P(X,U,7) Q:$P(X,U,9)["*" ;hide
  1. . Q:'PROMPT S I=$O(ORDIALOG(PROMPT,0)) Q:'I ; no values
  1. . S TITLE=$S($L($G(ORDIALOG(PROMPT,"TTL"))):ORDIALOG(PROMPT,"TTL"),1:ORDIALOG(PROMPT,"A"))
  1. . W !,$J(TITLE,30)
  1. . I $E(ORDIALOG(PROMPT,0))="W" W $E($G(^TMP("ORWORD",$J,PROMPT,I,1,0)),1,40)_$S($L($G(^(0)))>40:" ...",$O(^TMP("ORWORD",$J,PROMPT,I,1)):" ...",1:"") Q
  1. . W $$ITEM(PROMPT,I) Q:'MULT Q:'$O(ORDIALOG(PROMPT,I)) ; done
  1. . F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 W !?30,$$ITEM(PROMPT,I)
  1. W !,$$REPEAT^XLFSTR("-",79),!
  1. I $G(ORCHECK) W "Order Checks:" D LIST^ORCHECK("NEW")
  1. Q
  1. ;
  1. ITEM(P,I) ; -- Display each item in dialog
  1. N ITEM,SEQ,DA,IFN,X,ORDTXT
  1. S ITEM=$$EXT^ORCD(P,I) I $E(ORDIALOG(P,0))="R",$G(ORTYPE)'="Z",'$G(OREVENT) S X=ORDIALOG(P,I) S:'X ITEM=ITEM_$$DATE(X)
  1. I $D(^ORD(101.41,+ORDIALOG,10,"DAD",P)) S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",P,SEQ)) Q:SEQ'>0 S DA=$O(^(SEQ,0)) D
  1. . S IFN=$P(^ORD(101.41,+ORDIALOG,10,DA,0),U,2),ORDTXT=$G(^(2)) Q:$P(^(0),U,9)["*"
  1. . Q:'$D(ORDIALOG(IFN,I)) Q:$E(ORDIALOG(IFN,0))="W"
  1. . S X=$$EXT^ORCD(IFN,I) Q:'$L(X)
  1. . S:$L($P(ORDTXT,U,4)) X=$$GETXT^ORCSAVE1($P(ORDTXT,U,4))_" "_X
  1. . S:$L($P(ORDTXT,U,5)) X=X_" "_$$GETXT^ORCSAVE1($P(ORDTXT,U,5))
  1. . S ITEM=ITEM_" "_X
  1. Q ITEM
  1. ;
  1. DATE(X) ; -- Returns resolved date
  1. N Y,%DT S %DT="T"
  1. D AM^ORCSAVE2:X="AM",NEXT^ORCSAVE2:X="NEXT"
  1. D ADMIN^ORCSAVE2("NEXT"):X="NEXTA",ADMIN^ORCSAVE2("CLOSEST"):X="CLOSEST"
  1. D ^%DT S:Y'>0 Y="" I Y>0 S Y=" ("_$$FMTE^XLFDT(Y,2)_")"
  1. Q Y
  1. ;
  1. OK() ; -- Ready to save?
  1. N X,Y,DIR
  1. S DIR(0)="SA^P:PLACE;E:EDIT;C:CANCEL;",DIR("A")="(P)lace, (E)dit, or (C)ancel this order? ",DIR("B")="PLACE"
  1. S DIR("?")="Enter P to place this order, or E to change any of the displayed values; enter C to quit without placing this order"
  1. D ^DIR S:$D(DTOUT) Y="^"
  1. Q Y
  1. ;
  1. KVALUES ; -- kill ORDIALOG("ORDERABLE ITEM",#) value nodes
  1. N PTR,INST K ORIFN,ORCHECK,^TMP("ORWORD",$J)
  1. S PTR=0 F S PTR=$O(ORDIALOG(PTR)) Q:PTR'>0 D
  1. . K ORDIALOG(PTR,"LIST") S INST=0
  1. . F S INST=$O(ORDIALOG(PTR,INST)) Q:INST'>0 K ORDIALOG(PTR,INST)
  1. Q
  1. ;
  1. NOW() ; -- Returns current Date Ordered for new order
  1. N Y I $G(ORSLOG) S Y=ORSLOG ; timestamp for order set
  1. E S Y=+$E($$NOW^XLFDT,1,12)
  1. Q Y
  1. ;
  1. ACTIVE() ; -- Returns 1 or 0, if orderable item(s) are active
  1. ; [Uses ORDIALOG(),ORDG,ORNMSP]
  1. N OI,NOW,I,ITM,X,Y
  1. S OI=+$$PTR^ORCD("OR GTX ORDERABLE ITEM"),NOW=$$NOW^XLFDT,Y=1
  1. S I=0 F S I=+$O(ORDIALOG(OI,I)) Q:I'>0 D Q:'Y
  1. . S ITM=+$G(ORDIALOG(OI,I)) Q:ITM'>0
  1. . S X=$G(^ORD(101.43,ITM,.1)) I X,X<NOW S Y=0 Q ;inactive
  1. I 'Y,ORNMSP?1"PS".E D ;ck for new OI, if PS
  1. . Q:$P($G(^ORD(100.98,+$G(ORDG),0)),U,3)="IV RX" ;skip fluids
  1. . Q:$G(ORCAT)="I"&$G(ORENEW) ;skip Inpt renewals
  1. . N DD,J,DRUG,PSOI S DD=+$$PTR^ORCD("OR GTX DISPENSE DRUG")
  1. . S J=+$O(ORDIALOG(DD,0)),DRUG=+$G(ORDIALOG(DD,J)) ;first one
  1. . S PSOI=+$P($G(^ORD(101.43,+$G(ORDIALOG(OI,1)),0)),U,2)
  1. . S X=$$ITEM^PSSUTIL1(PSOI,DRUG) Q:X'>0
  1. . S ITM=+$O(^ORD(101.43,"ID",+$P(X,U,2)_";99PSP",0)) Q:ITM'>0
  1. . S X=$G(^ORD(101.43,ITM,.1)) I X,X<NOW Q ;just checking
  1. . S ORDIALOG(OI,1)=ITM,Y=1
  1. Q Y