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

ORCDFHTF.m

Go to the documentation of this file.
  1. ORCDFHTF ; SLC/MKB - Utility functions for FH Tubefeeding dialog ;07/16/15 11:07
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,141,215,350,377**;Dec 17, 1997;Build 582
  1. ;
  1. ;
  1. ;
  1. EN ; -- entry action
  1. S ORCAT=$S($$INPT^ORCD:"I",1:"O")
  1. ;I '$$INPT^ORCD W $C(7),!!,"This patient is not an inpatient!" S ORQUIT=1 H 2 Q
  1. ;D:'$G(OREVENT) EN^FHWOR8(+ORVP,.ORPARAM) I $G(OREVENT) D
  1. ;. N X S X=$$LOC^OREVNTX(OREVENT) Q:X<1
  1. ;. S X=+$G(^SC(+X,42)) I X,$T(EN1^FHWOR8) D EN1^FHWOR8(X,.ORPARAM)
  1. ;S:'$L($G(ORPARAM(3))) ORPARAM(3)="T" ; for now
  1. ; -- show current TF order
  1. N ORTF,ORTX,I S ORTF=$$CURRENT^ORCDFH("TF") Q:ORTF'>0
  1. W !!,"An ACTIVE TUBEFEEDING ORDER exists for this patient:",!
  1. D TEXT^ORQ12(.ORTX,ORTF,80) F I=1:1:ORTX W !,ORTX(I)
  1. W !,"Total Quantity: "_$$TOTALQTY(ORTF)_" ml",!
  1. Q
  1. ;
  1. EX ; -- exit action
  1. K ORPARAM,ORTIME,ORCAT
  1. Q
  1. ;
  1. QUANTITY ; -- Validation code for TF quantity
  1. N X,ORQTY,I,TOT S X=ORDIALOG(PROMPT,ORI)
  1. S ORQTY=$$VALIDQTY(X) I '$L(ORQTY) K DONE,ORDIALOG(PROMPT,ORI) Q
  1. S ORDIALOG(PROMPT,ORI)=ORQTY
  1. W " (Amount: "_$$CC(ORI)_"ml)"
  1. S (I,TOT)=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 S TOT=TOT+$$CC(I)
  1. I TOT>5000 W $C(7),!!,"WARNING: Total quantity ordered is "_TOT_"ml which exceeds the limit of 5000ml!",!
  1. Q
  1. ;
  1. VALIDQTY(X) ; -- Validates quantity X=amt units/freq X times
  1. N X1,X2,AMT,N,UNITS,F,D,FREQ,DUR
  1. S X=$$UP^XLFSTR(X),X=$$STRIP^XLFSTR(X," ") ; uppercase, no spaces
  1. S AMT=+X,X1=$P(X,"/"),X2=$P(X,"/",2) Q:'AMT ""
  1. S N=$P(X1,AMT,2),UNITS="" F X="^KCAL^K^","^ML^M^CC^C^","^OZ^O^","^UNITS^BOTTLES^CANS^PKG^U^","^TBSP^","^GM^GMS^GRAMS^G^" I X[(U_N_U) S UNITS=$P(X,U,2) Q
  1. Q:'$L(UNITS) "" S F=$P(X2,"X"),D=$P(X2,"X",2) S:'$L(F) F="DAY"
  1. S FREQ="" F X="^DAY^DAY","^QH^HOUR^HR^","^BID^","^TID^","^QID^","^Q2H^","^Q3H^","^Q4H^","^Q6H^" I X[(U_F_U) S FREQ=$P(X,U,2) Q
  1. Q:'$L(FREQ) "" S DUR="" S:D DUR=+D_$S(D'["F":"HR",1:"")
  1. Q AMT_" "_UNITS_"/"_FREQ_$S(DUR:" X "_DUR,1:"")
  1. ;
  1. CC(INST) ; -- Returns #cc ordered for INSTance
  1. N X,X1,X2,DUR
  1. S X=ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),INST)
  1. S X1=ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),INST)
  1. S X1=+$P($G(^ORD(101.43,+X1,0)),U,2)_"-"_ORDIALOG($$PTR^ORCD("OR GTX STRENGTH FH"),INST),X2=+X_"&"_$E($P(X," ",2))_U_$P($P(X,"/",2)," "),DUR=$P(X," X ",2)
  1. I $L(DUR) S DUR=$S(DUR["H":"H",1:"X")_+DUR,X2=X2_U_DUR
  1. S X=$$QUAN^FHWOR5R(X1,X2)
  1. Q X
  1. ;
  1. QUANHELP ; -- ??-help for Quantity
  1. W !!,"Units may be K for Kcals, M for ml, C for cc's, O For oz. or U for units (e.g. cans)."
  1. W !,"Frequency may be DAY, HOUR, QD, QH, BID, TID, QID, Q2H, Q3H, Q4H, or Q6H."
  1. W !,"May also input 100ML/HR X 16 for 16 hours. Valid quantity for powder form"
  1. W !,"product can be ""# GRAMS"" as 20 G, GRAMS, or GMS, or as 1 PKG or 1 U, and the"
  1. W !,"frequency (e.g. 20 GRAMS/DAY or 1 PKG/TID)."
  1. Q
  1. ;
  1. TOTALQTY(ORDER) ; -- Returns total cc's for ORDER
  1. N ORDIALOG,ORIT,ORTOTAL,ORI
  1. S ORDIALOG=+$P($G(^OR(100,+ORDER,0)),U,5) D GETDLG1^ORCD(ORDIALOG)
  1. S ORIT=$$PTR^ORCD("OR GTX ORDERABLE ITEM")
  1. D GETORDER^ORCD(+ORDER) S (ORTOTAL,ORI)=0
  1. F S ORI=$O(ORDIALOG(ORIT,ORI)) Q:ORI'>0 S ORTOTAL=ORTOTAL+$$CC(ORI)
  1. Q ORTOTAL
  1. ;
  1. CANCEL ; -- Cancel active TF with new diet? [Called from FHW1 Exit Action]
  1. N ORTF,ORTX,DIR,X,Y,ORDA,OREASON,ORNATR,I
  1. S ORTF=$$CURRENT^ORCDFH("TF") Q:'ORTF ;no active tubefeeding order
  1. Q:$$FUTURE^ORCDFH("EFFECTIVE DATE/TIME") ;future diet order
  1. W !!,"An active tubefeeding order exists for this patient:"
  1. D TEXT^ORQ12(.ORTX,+ORTF,80) F I=1:1:ORTX W !,ORTX(I)
  1. S DIR(0)="YA",DIR("A")="Do you wish to cancel this order? "
  1. S DIR("?")="Enter YES to place a DC order for this tubefeeding"
  1. W ! D ^DIR Q:Y'=1 ;quit if not YES
  1. S ORDA=$$ACTION^ORCSAVE("DC",ORTF,ORNP),^TMP("ORNEW",$J,ORTF,ORDA)=""
  1. S OREASON=+$O(^ORD(100.03,"C","ORREQ",0)),ORNATR=$S(ORNP=DUZ:"E",1:"W")
  1. D SET^ORCACT2(+ORTF,ORNATR,OREASON) ;set ^(6) node
  1. Q
  1. ;
  1. DATES ; -- get existing outpatient meal dates
  1. Q:$G(ORDIALOG(PROMPT,"LIST")) D EN2^FHWOR8(+$G(ORVP),"",.ORDT)
  1. N I,CNT,X,Y S (I,CNT)=0 F S I=$O(ORDT(I)) Q:I<1 D
  1. . S X=+ORDT(I),Y=$$FMTE^XLFDT(X)
  1. . Q:$G(ORDIALOG(PROMPT,"LIST","B",Y)) S CNT=CNT+1
  1. . S ORDIALOG(PROMPT,"LIST",CNT)=X_U_Y,ORDIALOG(PROMPT,"LIST","B",Y)=X
  1. S:CNT ORDIALOG(PROMPT,"LIST")=CNT_"^1"
  1. Q