- ORCDFHO ;SLC/MKB-Utility functions for Outpt FH dialogs ;8/27/03 15:28
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
- ;
- EN ; -- entry action
- I $$INPT^ORCD W $C(7),!!,"This patient is not an outpatient!" S ORQUIT=1 H 2 Q
- I '$L($T(EN2^FHWOR8))!'$L($T(DIETLST^FHOMAPI)) W $C(7),!!,"Dietetics v5.5 must be installed to place outpatient diet orders!" S ORQUIT=1 H 2 Q
- N X S X=$S($G(OREVENT):$$LOC^OREVNTX(OREVENT),1:$G(ORL)) Q:X<1
- D EN1^FHWOR8(X,.ORPARAM) S ORCAT="O"
- I $G(ORPARAM(3))'["B" S ORPARAM(3)=$G(ORPARAM(3))_"B" ;bagged meal
- I $G(OREWRITE) D ;remove addl diets
- . N I,P1,P2 S P1=$$PTR("ADDL DIETS"),P2=$$PTR("MEAL DATE")
- . S I=0 F S I=$O(ORDIALOG(P1,I)) Q:I<1 K ORDIALOG(P1,I),ORDIALOG(P2,I)
- Q
- ;
- EX ; -- exit action
- K ORPARAM,ORNPO,ORTRAIL,ORDAY,ORDT,ORCAT
- Q
- ;
- PTR(X) ; -- Returns ptr value of prompt OR GTX X in Dialog file
- Q +$O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0))
- ;
- OPDIETS ; -- Get list of diets ok for outpatients
- Q:$G(ORDIALOG(PROMPT,"LIST")) N FHDIET,I,X,Y,CNT
- D DIETLST^FHOMAPI S CNT=0
- S I=0 F S I=$O(FHDIET(I)) Q:I<1 D
- . S Y=FHDIET(I),X=+Y,Y=$P(Y,U,2)
- . S X=+$O(^ORD(101.43,"ID",X_";99FHD",0))
- . I X S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=X_U_Y,ORDIALOG(PROMPT,"LIST","B",Y)=X
- S:CNT ORDIALOG(PROMPT,"LIST")=CNT_"^1"
- Q
- ;
- ONETIME() ; -- Condition for SCHEDULE
- N X,Y
- S Y=$$FTDCOMP^ORCD("END DATE","START DATE",">")
- S X=$G(ORDIALOG(PROMPT,INST))
- S:'Y ORDIALOG(PROMPT,INST)="ONCE" I Y,X="ONCE" K ORDIALOG(PROMPT,INST)
- Q 'Y
- ;
- TIMES ; -- get existing outpatient meal times
- Q:$G(ORDIALOG(PROMPT,"LIST")) D EN2^FHWOR8(+$G(ORVP),"",.ORDT)
- N I,CNT,X,Y,M S (I,CNT)=0 F S I=$O(ORDT(I)) Q:I<1 D
- . S X=ORDT(I),Y=$$FMTE^XLFDT(+X),M=$P(X,U,2)
- . S Y=Y_" "_$S(M="B":"Breakfast",M="N":"Noon",M="E":"Evening",1:"")
- . S X=$TR(X,"^",";"),CNT=CNT+1
- . S ORDIALOG(PROMPT,"LIST",I)=X_U_Y,ORDIALOG(PROMPT,"LIST","B",Y)=X
- S:CNT ORDIALOG(PROMPT,"LIST")=CNT_"^1"
- Q
- ;
- ENDT ; -- setup START
- ;S $P(ORDIALOG(PROMPT,0),":",3)="ETX" ;allow time
- D TIMES I FIRST,$G(ORDIALOG(PROMPT,"LIST")) D LIST^ORCD
- Q
- ;
- EXDT(X) ; -- populate E/L T values from START
- Q:X'[";" N DATE,MEAL
- S DATE=+X,MEAL=$P(X,";",2)
- S ORDIALOG(PROMPT,INST)=DATE,ORDIALOG($$PTR("STOP DATE"),1)=DATE
- S ORDIALOG($$PTR("MEAL"),1)=MEAL
- Q
- ;
- MEALTIME(IFN) ; -- gets meal time for order IFN [from STARTDT^ORCSAVE2]
- N ORPARAM,ORLOC,X,Y S IFN=+$G(IFN)
- S ORLOC=$S($G(ORL):ORL,1:$P($G(^OR(100,IFN,0)),U,10))
- D EN1^FHWOR8(ORLOC,.ORPARAM) S X=$$VALUE^ORCSAVE2(IFN,"MEAL")
- S:'$D(ORPARAM(2)) ORPARAM(2)="^^^^^^6:00A^12:00P^6:00P"
- S Y=$S(X="B":$P(ORPARAM(2),U,7),X="N":$P(ORPARAM(2),U,8),X="E":$P(ORPARAM(2),U,9),1:"")
- Q Y
- ;
- CKMEAL(Y,DAY,MEAL,LOC) ; -- Returns Y if valid mealtime or not
- ; Y = 0^msg if invalid
- ; 1 if valid
- ; 2 if valid, but latetray will be needed
- ; RPC = ORCDFHO CKMEAL
- ;
- N TIMES,NOW,BEGIN,LATE S Y=1 Q:$G(ORTYPE)="Z"
- S DAY=$$FMDATE($G(DAY)) I DAY<0 S Y="0^Invalid date." Q
- Q:DAY>DT I DAY<DT S Y="0^Cannot order for past days." Q
- I "^B^N^E^"'[(U_$G(MEAL)_U) S Y="0^Invalid meal." Q
- S TIMES=$G(ORPARAM(2)),NOW="."_$P($$NOW^XLFDT,".",2)
- I TIMES="" D Q:Y<1 ;get meal times for location
- . I '$G(LOC) S Y="0^Missing or invalid location." Q
- . N ORPARAM D EN1^FHWOR8(LOC,.ORPARAM)
- . S TIMES=$G(ORPARAM(2))
- I TIMES="" S Y="0^No meal times defined for this location." Q
- S BEGIN=$P(TIMES,U,$S(MEAL="B":7,MEAL="N":8,1:9)) Q:NOW<$$FMTIME(BEGIN)
- S LATE="."_$P(TIMES,U,$S(MEAL="B":2,MEAL="N":4,1:6)) ;late alarm end
- I NOW>LATE S Y="0^This meal can no longer be ordered today." Q
- S LATE="."_$P(TIMES,U,$S(MEAL="B":1,MEAL="N":3,1:5)) ;late alarm start
- S:NOW>LATE Y=2 ;within alarm window for late tray, else ok
- Q
- ;
- FMDATE(X) ; -- Ensure X is in FM date format, return day only
- N Y,%DT S %DT="TX" D ^%DT
- Q $P(Y,".")
- ;
- FMTIME(X) ; -- Returns FM format of time
- N Y,%DT S %DT="TX" D ^%DT
- Q "."_$P(Y,".",2)
- ;
- LATETRAY ; -- Check if latetray is needed, if so place order [from VALID^ORCSIGN]
- ; Expects ORIFN, ORL, ORVP
- ; Returns ORES(orifn;1)="" of new latetray order
- Q:'$G(ORIFN) Q:$E($$VALUE^ORX8(ORIFN,"ORDERABLE",1,"E"),1,3)="NPO"
- N X,Y,%DT,ORDATE,ORNP
- S X=$O(^OR(100,ORIFN,4.5,"ID","START",0)),X=$G(^OR(100,ORIFN,4.5,+X,1))
- Q:X="" S %DT="TX" D ^%DT Q:Y'>0 Q:$P(Y,".")>DT ;invalid or future
- S ORDATE=$P(Y,"."),ORNP=$P(^OR(100,ORIFN,0),U,4)
- LTRAY ; -- enter here w/ORDATE,ORNP,ORL [reinstated diet after dc'ing NPO]
- N ORPARAM,ORMEAL,ORTRAY,ORTIME,ORSTRT,Y,I
- D EN1^FHWOR8(ORL,.ORPARAM) Q:'$D(ORPARAM(2))
- S I=$O(^OR(100,ORIFN,4.5,"ID","MEAL",0)),ORMEAL=$G(^OR(100,ORIFN,4.5,+I,1))
- D CKMEAL(.Y,ORDATE,ORMEAL) Q:Y'=2 ;no late tray needed
- S ORTRAY=+$O(^ORD(101.43,"S.E/L T","LATE TRAY",0))
- S ORSTRT=+$E($P($$NOW^XLFDT,".",2)_"0000",1,4) D EN2^ORCDFH
- F I=1:1:3 S Z=$G(ORTIME(ORTRAY,ORMEAL,I)) I Z S Z=$$FMTIME($P(Z,U)),Z=+$E($P(Z,".",2)_"0000",1,4) I Z>ORSTRT S OK=1 Q
- Q:'$G(OK) Q:'$$ORDTRAY^ORCDFH(ORMEAL) ;Else, cont w/late tray order
- LT1 N ORIFN,ORDIALOG,ORDG,ORTYPE,ORCHECK,ORQUIT,ORDUZ,ORLOG,ORCAT,SEQ,DA,FIRST
- S ORDIALOG=$O(^ORD(101.41,"AB","FHW2",0)) Q:'ORDIALOG
- S ORTYPE="D",FIRST=1,ORDUZ=DUZ,ORLOG=+$E($$NOW^XLFDT,1,12),ORCAT="O"
- D GETDLG^ORCD(ORDIALOG) S ORDIALOG($$PTR^ORCD("OR GTX MEAL"),1)=ORMEAL
- S ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=ORTRAY
- S ORDIALOG($$PTR^ORCD("OR GTX START DATE"),1)=ORDATE,ORDIALOG($$PTR^ORCD("OR GTX STOP DATE"),1)=ORDATE
- F SEQ=6,7 S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,0)) Q:'DA D EN^ORCDLG1(DA) Q:$G(ORQUIT) ; prompt for meal time, bagged meal
- I $G(ORQUIT) W $C(7),!!,"No late tray ordered!",! H 2 Q
- D EN^ORCSAVE Q:'$G(ORIFN) S ORES(ORIFN_";1")=""
- W !?10,"... order placed.",!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDFHO 5761 printed Dec 13, 2024@02:27:58 Page 2
- ORCDFHO ;SLC/MKB-Utility functions for Outpt FH dialogs ;8/27/03 15:28
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
- +2 ;
- EN ; -- entry action
- +1 IF $$INPT^ORCD
- WRITE $CHAR(7),!!,"This patient is not an outpatient!"
- SET ORQUIT=1
- HANG 2
- QUIT
- +2 IF '$LENGTH($TEXT(EN2^FHWOR8))!'$LENGTH($TEXT(DIETLST^FHOMAPI))
- WRITE $CHAR(7),!!,"Dietetics v5.5 must be installed to place outpatient diet orders!"
- SET ORQUIT=1
- HANG 2
- QUIT
- +3 NEW X
- SET X=$SELECT($GET(OREVENT):$$LOC^OREVNTX(OREVENT),1:$GET(ORL))
- if X<1
- QUIT
- +4 DO EN1^FHWOR8(X,.ORPARAM)
- SET ORCAT="O"
- +5 ;bagged meal
- IF $GET(ORPARAM(3))'["B"
- SET ORPARAM(3)=$GET(ORPARAM(3))_"B"
- +6 ;remove addl diets
- IF $GET(OREWRITE)
- Begin DoDot:1
- +7 NEW I,P1,P2
- SET P1=$$PTR("ADDL DIETS")
- SET P2=$$PTR("MEAL DATE")
- +8 SET I=0
- FOR
- SET I=$ORDER(ORDIALOG(P1,I))
- if I<1
- QUIT
- KILL ORDIALOG(P1,I),ORDIALOG(P2,I)
- End DoDot:1
- +9 QUIT
- +10 ;
- EX ; -- exit action
- +1 KILL ORPARAM,ORNPO,ORTRAIL,ORDAY,ORDT,ORCAT
- +2 QUIT
- +3 ;
- PTR(X) ; -- Returns ptr value of prompt OR GTX X in Dialog file
- +1 QUIT +$ORDER(^ORD(101.41,"AB",$EXTRACT("OR GTX "_X,1,63),0))
- +2 ;
- OPDIETS ; -- Get list of diets ok for outpatients
- +1 if $GET(ORDIALOG(PROMPT,"LIST"))
- QUIT
- NEW FHDIET,I,X,Y,CNT
- +2 DO DIETLST^FHOMAPI
- SET CNT=0
- +3 SET I=0
- FOR
- SET I=$ORDER(FHDIET(I))
- if I<1
- QUIT
- Begin DoDot:1
- +4 SET Y=FHDIET(I)
- SET X=+Y
- SET Y=$PIECE(Y,U,2)
- +5 SET X=+$ORDER(^ORD(101.43,"ID",X_";99FHD",0))
- +6 IF X
- SET CNT=CNT+1
- SET ORDIALOG(PROMPT,"LIST",CNT)=X_U_Y
- SET ORDIALOG(PROMPT,"LIST","B",Y)=X
- End DoDot:1
- +7 if CNT
- SET ORDIALOG(PROMPT,"LIST")=CNT_"^1"
- +8 QUIT
- +9 ;
- ONETIME() ; -- Condition for SCHEDULE
- +1 NEW X,Y
- +2 SET Y=$$FTDCOMP^ORCD("END DATE","START DATE",">")
- +3 SET X=$GET(ORDIALOG(PROMPT,INST))
- +4 if 'Y
- SET ORDIALOG(PROMPT,INST)="ONCE"
- IF Y
- IF X="ONCE"
- KILL ORDIALOG(PROMPT,INST)
- +5 QUIT 'Y
- +6 ;
- TIMES ; -- get existing outpatient meal times
- +1 if $GET(ORDIALOG(PROMPT,"LIST"))
- QUIT
- DO EN2^FHWOR8(+$GET(ORVP),"",.ORDT)
- +2 NEW I,CNT,X,Y,M
- 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)
- SET M=$PIECE(X,U,2)
- +4 SET Y=Y_" "_$SELECT(M="B":"Breakfast",M="N":"Noon",M="E":"Evening",1:"")
- +5 SET X=$TRANSLATE(X,"^",";")
- SET CNT=CNT+1
- +6 SET ORDIALOG(PROMPT,"LIST",I)=X_U_Y
- SET ORDIALOG(PROMPT,"LIST","B",Y)=X
- End DoDot:1
- +7 if CNT
- SET ORDIALOG(PROMPT,"LIST")=CNT_"^1"
- +8 QUIT
- +9 ;
- ENDT ; -- setup START
- +1 ;S $P(ORDIALOG(PROMPT,0),":",3)="ETX" ;allow time
- +2 DO TIMES
- IF FIRST
- IF $GET(ORDIALOG(PROMPT,"LIST"))
- DO LIST^ORCD
- +3 QUIT
- +4 ;
- EXDT(X) ; -- populate E/L T values from START
- +1 if X'[";"
- QUIT
- NEW DATE,MEAL
- +2 SET DATE=+X
- SET MEAL=$PIECE(X,";",2)
- +3 SET ORDIALOG(PROMPT,INST)=DATE
- SET ORDIALOG($$PTR("STOP DATE"),1)=DATE
- +4 SET ORDIALOG($$PTR("MEAL"),1)=MEAL
- +5 QUIT
- +6 ;
- MEALTIME(IFN) ; -- gets meal time for order IFN [from STARTDT^ORCSAVE2]
- +1 NEW ORPARAM,ORLOC,X,Y
- SET IFN=+$GET(IFN)
- +2 SET ORLOC=$SELECT($GET(ORL):ORL,1:$PIECE($GET(^OR(100,IFN,0)),U,10))
- +3 DO EN1^FHWOR8(ORLOC,.ORPARAM)
- SET X=$$VALUE^ORCSAVE2(IFN,"MEAL")
- +4 if '$DATA(ORPARAM(2))
- SET ORPARAM(2)="^^^^^^6:00A^12:00P^6:00P"
- +5 SET Y=$SELECT(X="B":$PIECE(ORPARAM(2),U,7),X="N":$PIECE(ORPARAM(2),U,8),X="E":$PIECE(ORPARAM(2),U,9),1:"")
- +6 QUIT Y
- +7 ;
- CKMEAL(Y,DAY,MEAL,LOC) ; -- Returns Y if valid mealtime or not
- +1 ; Y = 0^msg if invalid
- +2 ; 1 if valid
- +3 ; 2 if valid, but latetray will be needed
- +4 ; RPC = ORCDFHO CKMEAL
- +5 ;
- +6 NEW TIMES,NOW,BEGIN,LATE
- SET Y=1
- if $GET(ORTYPE)="Z"
- QUIT
- +7 SET DAY=$$FMDATE($GET(DAY))
- IF DAY<0
- SET Y="0^Invalid date."
- QUIT
- +8 if DAY>DT
- QUIT
- IF DAY<DT
- SET Y="0^Cannot order for past days."
- QUIT
- +9 IF "^B^N^E^"'[(U_$GET(MEAL)_U)
- SET Y="0^Invalid meal."
- QUIT
- +10 SET TIMES=$GET(ORPARAM(2))
- SET NOW="."_$PIECE($$NOW^XLFDT,".",2)
- +11 ;get meal times for location
- IF TIMES=""
- Begin DoDot:1
- +12 IF '$GET(LOC)
- SET Y="0^Missing or invalid location."
- QUIT
- +13 NEW ORPARAM
- DO EN1^FHWOR8(LOC,.ORPARAM)
- +14 SET TIMES=$GET(ORPARAM(2))
- End DoDot:1
- if Y<1
- QUIT
- +15 IF TIMES=""
- SET Y="0^No meal times defined for this location."
- QUIT
- +16 SET BEGIN=$PIECE(TIMES,U,$SELECT(MEAL="B":7,MEAL="N":8,1:9))
- if NOW<$$FMTIME(BEGIN)
- QUIT
- +17 ;late alarm end
- SET LATE="."_$PIECE(TIMES,U,$SELECT(MEAL="B":2,MEAL="N":4,1:6))
- +18 IF NOW>LATE
- SET Y="0^This meal can no longer be ordered today."
- QUIT
- +19 ;late alarm start
- SET LATE="."_$PIECE(TIMES,U,$SELECT(MEAL="B":1,MEAL="N":3,1:5))
- +20 ;within alarm window for late tray, else ok
- if NOW>LATE
- SET Y=2
- +21 QUIT
- +22 ;
- FMDATE(X) ; -- Ensure X is in FM date format, return day only
- +1 NEW Y,%DT
- SET %DT="TX"
- DO ^%DT
- +2 QUIT $PIECE(Y,".")
- +3 ;
- FMTIME(X) ; -- Returns FM format of time
- +1 NEW Y,%DT
- SET %DT="TX"
- DO ^%DT
- +2 QUIT "."_$PIECE(Y,".",2)
- +3 ;
- LATETRAY ; -- Check if latetray is needed, if so place order [from VALID^ORCSIGN]
- +1 ; Expects ORIFN, ORL, ORVP
- +2 ; Returns ORES(orifn;1)="" of new latetray order
- +3 if '$GET(ORIFN)
- QUIT
- if $EXTRACT($$VALUE^ORX8(ORIFN,"ORDERABLE",1,"E"),1,3)="NPO"
- QUIT
- +4 NEW X,Y,%DT,ORDATE,ORNP
- +5 SET X=$ORDER(^OR(100,ORIFN,4.5,"ID","START",0))
- SET X=$GET(^OR(100,ORIFN,4.5,+X,1))
- +6 ;invalid or future
- if X=""
- QUIT
- SET %DT="TX"
- DO ^%DT
- if Y'>0
- QUIT
- if $PIECE(Y,".")>DT
- QUIT
- +7 SET ORDATE=$PIECE(Y,".")
- SET ORNP=$PIECE(^OR(100,ORIFN,0),U,4)
- LTRAY ; -- enter here w/ORDATE,ORNP,ORL [reinstated diet after dc'ing NPO]
- +1 NEW ORPARAM,ORMEAL,ORTRAY,ORTIME,ORSTRT,Y,I
- +2 DO EN1^FHWOR8(ORL,.ORPARAM)
- if '$DATA(ORPARAM(2))
- QUIT
- +3 SET I=$ORDER(^OR(100,ORIFN,4.5,"ID","MEAL",0))
- SET ORMEAL=$GET(^OR(100,ORIFN,4.5,+I,1))
- +4 ;no late tray needed
- DO CKMEAL(.Y,ORDATE,ORMEAL)
- if Y'=2
- QUIT
- +5 SET ORTRAY=+$ORDER(^ORD(101.43,"S.E/L T","LATE TRAY",0))
- +6 SET ORSTRT=+$EXTRACT($PIECE($$NOW^XLFDT,".",2)_"0000",1,4)
- DO EN2^ORCDFH
- +7 FOR I=1:1:3
- SET Z=$GET(ORTIME(ORTRAY,ORMEAL,I))
- IF Z
- SET Z=$$FMTIME($PIECE(Z,U))
- SET Z=+$EXTRACT($PIECE(Z,".",2)_"0000",1,4)
- IF Z>ORSTRT
- SET OK=1
- QUIT
- +8 ;Else, cont w/late tray order
- if '$GET(OK)
- QUIT
- if '$$ORDTRAY^ORCDFH(ORMEAL)
- QUIT
- LT1 NEW ORIFN,ORDIALOG,ORDG,ORTYPE,ORCHECK,ORQUIT,ORDUZ,ORLOG,ORCAT,SEQ,DA,FIRST
- +1 SET ORDIALOG=$ORDER(^ORD(101.41,"AB","FHW2",0))
- if 'ORDIALOG
- QUIT
- +2 SET ORTYPE="D"
- SET FIRST=1
- SET ORDUZ=DUZ
- SET ORLOG=+$EXTRACT($$NOW^XLFDT,1,12)
- SET ORCAT="O"
- +3 DO GETDLG^ORCD(ORDIALOG)
- SET ORDIALOG($$PTR^ORCD("OR GTX MEAL"),1)=ORMEAL
- +4 SET ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=ORTRAY
- +5 SET ORDIALOG($$PTR^ORCD("OR GTX START DATE"),1)=ORDATE
- SET ORDIALOG($$PTR^ORCD("OR GTX STOP DATE"),1)=ORDATE
- +6 ; prompt for meal time, bagged meal
- FOR SEQ=6,7
- SET DA=$ORDER(^ORD(101.41,+ORDIALOG,10,"B",SEQ,0))
- if 'DA
- QUIT
- DO EN^ORCDLG1(DA)
- if $GET(ORQUIT)
- QUIT
- +7 IF $GET(ORQUIT)
- WRITE $CHAR(7),!!,"No late tray ordered!",!
- HANG 2
- QUIT
- +8 DO EN^ORCSAVE
- if '$GET(ORIFN)
- QUIT
- SET ORES(ORIFN_";1")=""
- +9 WRITE !?10,"... order placed.",!
- +10 QUIT