- 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 Feb 18, 2025@23:54:32 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