source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDFHTF.m@ 1270

Last change on this file since 1270 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.0 KB
RevLine 
[613]1ORCDFHTF ; SLC/MKB - Utility functions for FH Tubefeeding dialog ; 08 May 2002 2:12 PM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,141,215**;Dec 17, 1997
3 ;
4EN ; -- entry action
5 S ORCAT=$S($$INPT^ORCD:"I",1:"O")
6 ;I '$$INPT^ORCD W $C(7),!!,"This patient is not an inpatient!" S ORQUIT=1 H 2 Q
7 ;D:'$G(OREVENT) EN^FHWOR8(+ORVP,.ORPARAM) I $G(OREVENT) D
8 ;. N X S X=$$LOC^OREVNTX(OREVENT) Q:X<1
9 ;. S X=+$G(^SC(+X,42)) I X,$T(EN1^FHWOR8) D EN1^FHWOR8(X,.ORPARAM)
10 ;S:'$L($G(ORPARAM(3))) ORPARAM(3)="T" ; for now
11 ; -- show current TF order
12 N ORTF,ORTX,I S ORTF=$$CURRENT^ORCDFH("TF") Q:ORTF'>0
13 W !!,"An ACTIVE TUBEFEEDING ORDER exists for this patient:",!
14 D TEXT^ORQ12(.ORTX,ORTF,80) F I=1:1:ORTX W !,ORTX(I)
15 W !,"Total Quantity: "_$$TOTALQTY(ORTF)_" ml",!
16 Q
17 ;
18EX ; -- exit action
19 K ORPARAM,ORTIME,ORCAT
20 Q
21 ;
22QUANTITY ; -- Validation code for TF quantity
23 N X,ORQTY,I,TOT S X=ORDIALOG(PROMPT,ORI)
24 S ORQTY=$$VALIDQTY(X) I '$L(ORQTY) K DONE,ORDIALOG(PROMPT,ORI) Q
25 S ORDIALOG(PROMPT,ORI)=ORQTY
26 W " (Amount: "_$$CC(ORI)_"ml)"
27 S (I,TOT)=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 S TOT=TOT+$$CC(I)
28 I TOT>5000 W $C(7),!!,"WARNING: Total quantity ordered is "_TOT_"ml which exceeds the limit of 5000ml!",!
29 Q
30 ;
31VALIDQTY(X) ; -- Validates quantity X=amt units/freq X times
32 N X1,X2,AMT,N,UNITS,F,D,FREQ,DUR
33 S X=$$UP^XLFSTR(X),X=$$STRIP^XLFSTR(X," ") ; uppercase, no spaces
34 S AMT=+X,X1=$P(X,"/"),X2=$P(X,"/",2) Q:'AMT ""
35 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
36 Q:'$L(UNITS) "" S F=$P(X2,"X"),D=$P(X2,"X",2) S:'$L(F) F="QD"
37 S FREQ="" F X="^QD^DAY^","^QH^HOUR^HR^","^BID^","^TID^","^QID^","^Q2H^","^Q3H^","^Q4H^","^Q6H^" I X[(U_F_U) S FREQ=$P(X,U,2) Q
38 Q:'$L(FREQ) "" S DUR="" S:D DUR=+D_$S(D'["F":"HR",1:"")
39 Q AMT_" "_UNITS_"/"_FREQ_$S(DUR:" X "_DUR,1:"")
40 ;
41CC(INST) ; -- Returns #cc ordered for INSTance
42 N X,X1,X2,DUR
43 S X=ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),INST)
44 S X1=ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),INST)
45 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)
46 I $L(DUR) S DUR=$S(DUR["H":"H",1:"X")_+DUR,X2=X2_U_DUR
47 S X=$$QUAN^FHWOR5R(X1,X2)
48 Q X
49 ;
50QUANHELP ; -- ??-help for Quantity
51 W !!,"Units may be K for Kcals, M for ml, C for cc's, O For oz. or U for units (e.g. cans)."
52 W !,"Frequency may be DAY, HOUR, QD, QH, BID, TID, QID, Q2H, Q3H, Q4H, or Q6H."
53 W !,"May also input 100ML/HR X 16 for 16 hours. Valid quantity for powder form"
54 W !,"product can be ""# GRAMS"" as 20 G, GRAMS, or GMS, or as 1 PKG or 1 U, and the"
55 W !,"frequency (e.g. 20 GRAMS/DAY or 1 PKG/TID)."
56 Q
57 ;
58TOTALQTY(ORDER) ; -- Returns total cc's for ORDER
59 N ORDIALOG,ORIT,ORTOTAL,ORI
60 S ORDIALOG=+$P($G(^OR(100,+ORDER,0)),U,5) D GETDLG1^ORCD(ORDIALOG)
61 S ORIT=$$PTR^ORCD("OR GTX ORDERABLE ITEM")
62 D GETORDER^ORCD(+ORDER) S (ORTOTAL,ORI)=0
63 F S ORI=$O(ORDIALOG(ORIT,ORI)) Q:ORI'>0 S ORTOTAL=ORTOTAL+$$CC(ORI)
64 Q ORTOTAL
65 ;
66CANCEL ; -- Cancel active TF with new diet? [Called from FHW1 Exit Action]
67 N ORTF,ORTX,DIR,X,Y,ORDA,OREASON,ORNATR,I
68 S ORTF=$$CURRENT^ORCDFH("TF") Q:'ORTF ;no active tubefeeding order
69 Q:$$FUTURE^ORCDFH("EFFECTIVE DATE/TIME") ;future diet order
70 W !!,"An active tubefeeding order exists for this patient:"
71 D TEXT^ORQ12(.ORTX,+ORTF,80) F I=1:1:ORTX W !,ORTX(I)
72 S DIR(0)="YA",DIR("A")="Do you wish to cancel this order? "
73 S DIR("?")="Enter YES to place a DC order for this tubefeeding"
74 W ! D ^DIR Q:Y'=1 ;quit if not YES
75 S ORDA=$$ACTION^ORCSAVE("DC",ORTF,ORNP),^TMP("ORNEW",$J,ORTF,ORDA)=""
76 S OREASON=+$O(^ORD(100.03,"C","ORREQ",0)),ORNATR=$S(ORNP=DUZ:"E",1:"W")
77 D SET^ORCACT2(+ORTF,ORNATR,OREASON) ;set ^(6) node
78 Q
79 ;
80DATES ; -- get existing outpatient meal dates
81 Q:$G(ORDIALOG(PROMPT,"LIST")) D EN2^FHWOR8(+$G(ORVP),"",.ORDT)
82 N I,CNT,X,Y S (I,CNT)=0 F S I=$O(ORDT(I)) Q:I<1 D
83 . S X=+ORDT(I),Y=$$FMTE^XLFDT(X)
84 . Q:$G(ORDIALOG(PROMPT,"LIST","B",Y)) S CNT=CNT+1
85 . S ORDIALOG(PROMPT,"LIST",CNT)=X_U_Y,ORDIALOG(PROMPT,"LIST","B",Y)=X
86 S:CNT ORDIALOG(PROMPT,"LIST")=CNT_"^1"
87 Q
Note: See TracBrowser for help on using the repository browser.