- ORCDFH1 ;SLC/MKB,DKM - Utility functions for FH dialogs cont ; 8/31/17 10:37am
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**73,95,243,462**;Dec 17, 1997;Build 6
- ;
- ; External References:
- ; ^DIR ICR #10026
- ; $$NOW^XLFDT ICR #10103
- ; $$UP^XLFSTR ICR #10104
- ;
- RECENT ; -- get 5 most recent diet orders
- N ORDT,ORIFN,ORIT,ORTXT,ORCURR,I,X,CNT,INDT S ORDT=$$NOW^XLFDT,CNT=0
- F S ORDT=$O(^OR(100,"AW",ORVP,ORDG,ORDT),-1) Q:ORDT'>0 S ORIFN=0 D Q:CNT'<5
- . F S ORIFN=$O(^OR(100,"AW",ORVP,ORDG,ORDT,ORIFN)) Q:ORIFN'>0 D Q:CNT'<5
- .. S (ORIT,ORTXT)="" K ORCURR
- .. S:$P($G(^OR(100,+ORIFN,3)),U,3)=6 ORCURR=1 Q:'$O(^(.1,0))
- .. S I=0 F S I=$O(^OR(100,ORIFN,.1,I)) Q:I'>0 S X=+$G(^(I,0)) I X D ;**95
- ... S INDT=$G(^ORD(101.43,X,.1)) S ORIT=ORIT_$S($L(ORIT):";",1:"")_X,ORTXT=ORTXT_$S($L(ORTXT):", ",1:"")_$P($G(^ORD(101.43,X,0)),U)_$S(INDT&(INDT<$$NOW^XLFDT):" (*INACTIVE*)",1:"") ;**95
- .. Q:'ORIT Q:'$L(ORTXT) Q:ORTXT="NPO"
- .. S ORDIALOG(PROMPT,"LIST","D",ORIT)=ORIFN ;link oi string to order#
- .. Q:$G(ORCURR) Q:+$G(ORDIALOG(PROMPT,"LIST","B",ORTXT))
- .. S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=ORIT_U_ORTXT
- .. S ORDIALOG(PROMPT,"LIST","B",ORTXT)=ORIT
- S ORDIALOG(PROMPT,"LIST")=CNT,ORDIALOG(PROMPT,"TOT")=0
- Q
- ;
- PTR(X) ; -- Return ptr to Order Dialog file #101.41 for prompt X
- Q +$O(^ORD(101.41,"B","OR GTX "_X,0))
- ;
- EXP ; -- Expand old order into instances
- N X,I,P,D S X=$G(ORDIALOG(PROMPT,ORI)) Q:'$L(X) Q:X'[";"
- S ORDIALOG(PROMPT,ORI)=+X,I=ORI ;1st mod only
- F P=2:1:$L(X,";") S D=$P(X,";",P),I=I+1,ORDIALOG(PROMPT,I)=D,ORDIALOG(PROMPT,"TOT")=+$G(ORDIALOG(PROMPT,"TOT"))+1
- ;S:FIRST MAX=$L(X,";")
- Q
- ;
- VALID() ; -- Returns 1 or 0, if selected diet modification is valid
- N Y,NUM,I,TOTAL,OI
- ; DRM - 462 - read total from current OI's in ORDIALOG because ORDIALOG(PROMPT,"TOT") doesn't always exist
- N ITEM S ITEM=0,TOTAL=0 F S ITEM=$O(ORDIALOG(PROMPT,ITEM)) Q:'ITEM S TOTAL=TOTAL+1
- I '$D(ORESET) S TOTAL=TOTAL-1
- ; DRM - 462 ---
- S OI=$G(ORDIALOG(PROMPT,ORI)) I OI[";" D Q Y
- .S Y=1 D EXP
- .I $$INACTIVE S Y=0 S ORDIALOG(PROMPT,"TOT")=ORDIALOG(PROMPT,"TOT")-($L(OI,";")-1) F I=0:1:($L(OI,";")-1) K ORDIALOG(PROMPT,(I+ORI)) ;**95
- ; DRM - 462 - see above comment
- ;S Y=1,TOTAL=+$G(ORDIALOG(PROMPT,"TOT")),ORDIALOG(PROMPT,"MAX")=5,MAX=5
- S Y=1,ORDIALOG(PROMPT,"MAX")=5,MAX=5
- ; DRM - 462 ---
- I $$INACTIVE Q 0 ;**95
- ;S:FIRST MAX=$S($G(ORDIALOG(PROMPT,"LIST","D",OI)):1,1:5)
- S OI=$P($G(^ORD(101.43,+OI,0)),U)
- I (OI="REGULAR")!(OI="NPO") D Q Y
- . I '$D(ORESET),TOTAL=0 S ORDIALOG(PROMPT,"MAX")=1,MAX=1 Q ; add first
- . I $G(ORESET),TOTAL'>1 S ORDIALOG(PROMPT,"MAX")=1,MAX=1 Q ; edit first
- . S Y=0 W $C(7),!,OI_" may not be ordered with other diets!"
- ;I $$DUP^ORCD(PROMPT,ORI) W $C(7),"This diet has already been selected!" Q 0 ;may delete after testing patch 95
- S NUM=$P($G(^ORD(101.43,+ORDIALOG(PROMPT,ORI),"FH")),U,2) ; precedence #
- S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D Q:Y'>0
- . ; DRM - 462 - 2017/7/24 - if Regular or NPO diet, do not allow other diets to be added
- . ;Q:I=ORI Q:$P($G(^ORD(101.43,+ORDIALOG(PROMPT,I),"FH")),U,2)'=NUM ;ok
- . Q:I=ORI Q:($P($G(^ORD(101.43,+ORDIALOG(PROMPT,I),"FH")),U,2)'=NUM)&($P($G(^ORD(101.43,+ORDIALOG(PROMPT,I),0)),U)'="REGULAR")&($P($G(^ORD(101.43,+ORDIALOG(PROMPT,I),0)),U)'="NPO")
- . ; DRM - 462 - 2017/7/24 ---
- . S Y=0 W $C(7),!,"This diet is not orderable with those already selected!",!
- Q Y
- ;
- PREV ; -- Ck if previous diet being reordered
- N I,OI,IFN S OI="",I=0
- F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 S OI=OI_$S(OI:";",1:"")_ORDIALOG(PROMPT,I)
- S IFN=$S(OI:$G(ORDIALOG(PROMPT,"LIST","D",OI)),1:"")
- S:IFN ORDIALOG("PREV")=IFN K:'IFN ORDIALOG("PREV")
- Q
- ;
- CNV ; -- Convert meal abbreviation to time in X [Input Xform]
- ; Expects X,PROMPT [also called from Entry Action, DO^ORWDXM2]
- N A1 S X=$$UP^XLFSTR(X),A1=$P(X,"@",2)
- I A1?1U,"BNE"[A1 D
- . I $G(ORTYPE)="Z" S DATATYPE="",Y=X Q ;editor - ok
- . N TIMES S TIMES=$S($D(ORPARAM(2)):$P(ORPARAM(2),U,7,9),1:"6:00A^12:00P^6:00P")
- . S A1=$S(A1="B":$P(TIMES,U),A1="N":$P(TIMES,U,2),A1="E":$P(TIMES,U,3),1:A1)
- . S $P(X,"@",2)=A1
- Q
- ;
- LKUP ; -- special lookup routine for diet modifications
- G:'$G(ORDIALOG(PROMPT,"LIST")) LKQ N OROOT,Z
- S:X=" " X=$$SPACE^ORCDLG2(DOMAIN) S OROOT=$NA(ORDIALOG(PROMPT,"LIST"))
- S Y=$$FIND^ORCDLG2(OROOT,X)
- I Y Q:X?1N Q:'$$MORE(X,Y) S Z=$$OK Q:Z I Z="^" S Y="^" Q
- LKQ D DIC^ORCDLG2
- Q
- ;
- MORE(XX,YY) ; -- Returns 1 or 0, if more matches exist
- Q:$P(YY,U)[";" 1 ;multiple mods
- N CNT,XP,NOW S CNT=0,XP=XX,NOW=+$$NOW^XLFDT
- F S XP=$O(^ORD(101.43,"S.DO",XP)) Q:$E(XP,1,$L(XX))'=XX D Q:CNT
- . N IFN S IFN=$O(^ORD(101.43,"S.DO",XP,0)) Q:IFN=+YY ;same mod
- . I $G(^ORD(101.43,IFN,.1)),$G(^(.1))'>NOW Q ;inactive
- . S CNT=CNT+1
- Q CNT
- ;
- OK() ; -- Verify multiple diet mod selection
- N X,Y,DIR S DIR(0)="YA",DIR("A")=" ... OK? ",DIR("B")="Yes"
- S DIR("?")="Enter YES if you wish to re-order this entire diet, or NO to search for another single diet modification"
- D ^DIR S:$D(DUOUT)!$D(DTOUT) Y="^"
- Q Y
- INACTIVE() ;Check for inactive/duplicate diets in single or multiple modifications ;**95
- N I,Y
- S Y=0
- S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:'+I D
- .I $G(^ORD(101.43,ORDIALOG(PROMPT,I),.1)),^(.1)<$$NOW^XLFDT S Y=1 W !,"The ",$P(^ORD(101.43,ORDIALOG(PROMPT,I),0),U)," diet is INACTIVE." Q ;Quit if inactive diet found in order
- F I=0:1:($L(OI,";")-1) I $$DUP^ORCD(PROMPT,(I+ORI)) S Y=1 W !,"The ",$P(^ORD(101.43,ORDIALOG(PROMPT,(I+ORI)),0),U)," diet has already been selected." ;check for duplicate orders
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDFH1 5610 printed Jan 18, 2025@03:29:07 Page 2
- ORCDFH1 ;SLC/MKB,DKM - Utility functions for FH dialogs cont ; 8/31/17 10:37am
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**73,95,243,462**;Dec 17, 1997;Build 6
- +2 ;
- +3 ; External References:
- +4 ; ^DIR ICR #10026
- +5 ; $$NOW^XLFDT ICR #10103
- +6 ; $$UP^XLFSTR ICR #10104
- +7 ;
- RECENT ; -- get 5 most recent diet orders
- +1 NEW ORDT,ORIFN,ORIT,ORTXT,ORCURR,I,X,CNT,INDT
- SET ORDT=$$NOW^XLFDT
- SET CNT=0
- +2 FOR
- SET ORDT=$ORDER(^OR(100,"AW",ORVP,ORDG,ORDT),-1)
- if ORDT'>0
- QUIT
- SET ORIFN=0
- Begin DoDot:1
- +3 FOR
- SET ORIFN=$ORDER(^OR(100,"AW",ORVP,ORDG,ORDT,ORIFN))
- if ORIFN'>0
- QUIT
- Begin DoDot:2
- +4 SET (ORIT,ORTXT)=""
- KILL ORCURR
- +5 if $PIECE($GET(^OR(100,+ORIFN,3)),U,3)=6
- SET ORCURR=1
- if '$ORDER(^(.1,0))
- QUIT
- +6 ;**95
- SET I=0
- FOR
- SET I=$ORDER(^OR(100,ORIFN,.1,I))
- if I'>0
- QUIT
- SET X=+$GET(^(I,0))
- IF X
- Begin DoDot:3
- +7 ;**95
- SET INDT=$GET(^ORD(101.43,X,.1))
- SET ORIT=ORIT_$SELECT($LENGTH(ORIT):";",1:"")_X
- SET ORTXT=ORTXT_$SELECT($LENGTH(ORTXT):", ",1:"")_$PIECE($GET(^ORD(101.43,X,0)),U)_$SELECT(INDT&(INDT<$$NOW^XLFDT):" (*INACTIVE*)",1:"")
- End DoDot:3
- +8 if 'ORIT
- QUIT
- if '$LENGTH(ORTXT)
- QUIT
- if ORTXT="NPO"
- QUIT
- +9 ;link oi string to order#
- SET ORDIALOG(PROMPT,"LIST","D",ORIT)=ORIFN
- +10 if $GET(ORCURR)
- QUIT
- if +$GET(ORDIALOG(PROMPT,"LIST","B",ORTXT))
- QUIT
- +11 SET CNT=CNT+1
- SET ORDIALOG(PROMPT,"LIST",CNT)=ORIT_U_ORTXT
- +12 SET ORDIALOG(PROMPT,"LIST","B",ORTXT)=ORIT
- End DoDot:2
- if CNT'<5
- QUIT
- End DoDot:1
- if CNT'<5
- QUIT
- +13 SET ORDIALOG(PROMPT,"LIST")=CNT
- SET ORDIALOG(PROMPT,"TOT")=0
- +14 QUIT
- +15 ;
- PTR(X) ; -- Return ptr to Order Dialog file #101.41 for prompt X
- +1 QUIT +$ORDER(^ORD(101.41,"B","OR GTX "_X,0))
- +2 ;
- EXP ; -- Expand old order into instances
- +1 NEW X,I,P,D
- SET X=$GET(ORDIALOG(PROMPT,ORI))
- if '$LENGTH(X)
- QUIT
- if X'[";"
- QUIT
- +2 ;1st mod only
- SET ORDIALOG(PROMPT,ORI)=+X
- SET I=ORI
- +3 FOR P=2:1:$LENGTH(X,";")
- SET D=$PIECE(X,";",P)
- SET I=I+1
- SET ORDIALOG(PROMPT,I)=D
- SET ORDIALOG(PROMPT,"TOT")=+$GET(ORDIALOG(PROMPT,"TOT"))+1
- +4 ;S:FIRST MAX=$L(X,";")
- +5 QUIT
- +6 ;
- VALID() ; -- Returns 1 or 0, if selected diet modification is valid
- +1 NEW Y,NUM,I,TOTAL,OI
- +2 ; DRM - 462 - read total from current OI's in ORDIALOG because ORDIALOG(PROMPT,"TOT") doesn't always exist
- +3 NEW ITEM
- SET ITEM=0
- SET TOTAL=0
- FOR
- SET ITEM=$ORDER(ORDIALOG(PROMPT,ITEM))
- if 'ITEM
- QUIT
- SET TOTAL=TOTAL+1
- +4 IF '$DATA(ORESET)
- SET TOTAL=TOTAL-1
- +5 ; DRM - 462 ---
- +6 SET OI=$GET(ORDIALOG(PROMPT,ORI))
- IF OI[";"
- Begin DoDot:1
- +7 SET Y=1
- DO EXP
- +8 ;**95
- IF $$INACTIVE
- SET Y=0
- SET ORDIALOG(PROMPT,"TOT")=ORDIALOG(PROMPT,"TOT")-($LENGTH(OI,";")-1)
- FOR I=0:1:($LENGTH(OI,";")-1)
- KILL ORDIALOG(PROMPT,(I+ORI))
- End DoDot:1
- QUIT Y
- +9 ; DRM - 462 - see above comment
- +10 ;S Y=1,TOTAL=+$G(ORDIALOG(PROMPT,"TOT")),ORDIALOG(PROMPT,"MAX")=5,MAX=5
- +11 SET Y=1
- SET ORDIALOG(PROMPT,"MAX")=5
- SET MAX=5
- +12 ; DRM - 462 ---
- +13 ;**95
- IF $$INACTIVE
- QUIT 0
- +14 ;S:FIRST MAX=$S($G(ORDIALOG(PROMPT,"LIST","D",OI)):1,1:5)
- +15 SET OI=$PIECE($GET(^ORD(101.43,+OI,0)),U)
- +16 IF (OI="REGULAR")!(OI="NPO")
- Begin DoDot:1
- +17 ; add first
- IF '$DATA(ORESET)
- IF TOTAL=0
- SET ORDIALOG(PROMPT,"MAX")=1
- SET MAX=1
- QUIT
- +18 ; edit first
- IF $GET(ORESET)
- IF TOTAL'>1
- SET ORDIALOG(PROMPT,"MAX")=1
- SET MAX=1
- QUIT
- +19 SET Y=0
- WRITE $CHAR(7),!,OI_" may not be ordered with other diets!"
- End DoDot:1
- QUIT Y
- +20 ;I $$DUP^ORCD(PROMPT,ORI) W $C(7),"This diet has already been selected!" Q 0 ;may delete after testing patch 95
- +21 ; precedence #
- SET NUM=$PIECE($GET(^ORD(101.43,+ORDIALOG(PROMPT,ORI),"FH")),U,2)
- +22 SET I=0
- FOR
- SET I=$ORDER(ORDIALOG(PROMPT,I))
- if I'>0
- QUIT
- Begin DoDot:1
- +23 ; DRM - 462 - 2017/7/24 - if Regular or NPO diet, do not allow other diets to be added
- +24 ;Q:I=ORI Q:$P($G(^ORD(101.43,+ORDIALOG(PROMPT,I),"FH")),U,2)'=NUM ;ok
- +25 if I=ORI
- QUIT
- if ($PIECE($GET(^ORD(101.43,+ORDIALOG(PROMPT,I),"FH")),U,2)'=NUM)&($PIECE($GET(^ORD(101.43,+ORDIALOG(PROMPT,I),0)),U)'="REGULAR")&($PIECE($GET(^ORD(101.43,+ORDIALOG(PROMPT,I),0)),U)'="NPO")
- QUIT
- +26 ; DRM - 462 - 2017/7/24 ---
- +27 SET Y=0
- WRITE $CHAR(7),!,"This diet is not orderable with those already selected!",!
- End DoDot:1
- if Y'>0
- QUIT
- +28 QUIT Y
- +29 ;
- PREV ; -- Ck if previous diet being reordered
- +1 NEW I,OI,IFN
- SET OI=""
- SET I=0
- +2 FOR
- SET I=$ORDER(ORDIALOG(PROMPT,I))
- if I'>0
- QUIT
- SET OI=OI_$SELECT(OI:";",1:"")_ORDIALOG(PROMPT,I)
- +3 SET IFN=$SELECT(OI:$GET(ORDIALOG(PROMPT,"LIST","D",OI)),1:"")
- +4 if IFN
- SET ORDIALOG("PREV")=IFN
- if 'IFN
- KILL ORDIALOG("PREV")
- +5 QUIT
- +6 ;
- CNV ; -- Convert meal abbreviation to time in X [Input Xform]
- +1 ; Expects X,PROMPT [also called from Entry Action, DO^ORWDXM2]
- +2 NEW A1
- SET X=$$UP^XLFSTR(X)
- SET A1=$PIECE(X,"@",2)
- +3 IF A1?1U
- IF "BNE"[A1
- Begin DoDot:1
- +4 ;editor - ok
- IF $GET(ORTYPE)="Z"
- SET DATATYPE=""
- SET Y=X
- QUIT
- +5 NEW TIMES
- SET TIMES=$SELECT($DATA(ORPARAM(2)):$PIECE(ORPARAM(2),U,7,9),1:"6:00A^12:00P^6:00P")
- +6 SET A1=$SELECT(A1="B":$PIECE(TIMES,U),A1="N":$PIECE(TIMES,U,2),A1="E":$PIECE(TIMES,U,3),1:A1)
- +7 SET $PIECE(X,"@",2)=A1
- End DoDot:1
- +8 QUIT
- +9 ;
- LKUP ; -- special lookup routine for diet modifications
- +1 if '$GET(ORDIALOG(PROMPT,"LIST"))
- GOTO LKQ
- NEW OROOT,Z
- +2 if X=" "
- SET X=$$SPACE^ORCDLG2(DOMAIN)
- SET OROOT=$NAME(ORDIALOG(PROMPT,"LIST"))
- +3 SET Y=$$FIND^ORCDLG2(OROOT,X)
- +4 IF Y
- if X?1N
- QUIT
- if '$$MORE(X,Y)
- QUIT
- SET Z=$$OK
- if Z
- QUIT
- IF Z="^"
- SET Y="^"
- QUIT
- LKQ DO DIC^ORCDLG2
- +1 QUIT
- +2 ;
- MORE(XX,YY) ; -- Returns 1 or 0, if more matches exist
- +1 ;multiple mods
- if $PIECE(YY,U)[";"
- QUIT 1
- +2 NEW CNT,XP,NOW
- SET CNT=0
- SET XP=XX
- SET NOW=+$$NOW^XLFDT
- +3 FOR
- SET XP=$ORDER(^ORD(101.43,"S.DO",XP))
- if $EXTRACT(XP,1,$LENGTH(XX))'=XX
- QUIT
- Begin DoDot:1
- +4 ;same mod
- NEW IFN
- SET IFN=$ORDER(^ORD(101.43,"S.DO",XP,0))
- if IFN=+YY
- QUIT
- +5 ;inactive
- IF $GET(^ORD(101.43,IFN,.1))
- IF $GET(^(.1))'>NOW
- QUIT
- +6 SET CNT=CNT+1
- End DoDot:1
- if CNT
- QUIT
- +7 QUIT CNT
- +8 ;
- OK() ; -- Verify multiple diet mod selection
- +1 NEW X,Y,DIR
- SET DIR(0)="YA"
- SET DIR("A")=" ... OK? "
- SET DIR("B")="Yes"
- +2 SET DIR("?")="Enter YES if you wish to re-order this entire diet, or NO to search for another single diet modification"
- +3 DO ^DIR
- if $DATA(DUOUT)!$DATA(DTOUT)
- SET Y="^"
- +4 QUIT Y
- INACTIVE() ;Check for inactive/duplicate diets in single or multiple modifications ;**95
- +1 NEW I,Y
- +2 SET Y=0
- +3 SET I=0
- FOR
- SET I=$ORDER(ORDIALOG(PROMPT,I))
- if '+I
- QUIT
- Begin DoDot:1
- +4 ;Quit if inactive diet found in order
- IF $GET(^ORD(101.43,ORDIALOG(PROMPT,I),.1))
- IF ^(.1)<$$NOW^XLFDT
- SET Y=1
- WRITE !,"The ",$PIECE(^ORD(101.43,ORDIALOG(PROMPT,I),0),U)," diet is INACTIVE."
- QUIT
- End DoDot:1
- +5 ;check for duplicate orders
- FOR I=0:1:($LENGTH(OI,";")-1)
- IF $$DUP^ORCD(PROMPT,(I+ORI))
- SET Y=1
- WRITE !,"The ",$PIECE(^ORD(101.43,ORDIALOG(PROMPT,(I+ORI)),0),U)," diet has already been selected."
- +6 QUIT Y