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