- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDFH1.m
r613 r623 1 ORCDFH1 ;SLC/MKB,DKM - Utility functions for FH dialogs cont ;8/24/01 10:22 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**73,95,243**;Dec 17, 1997;Build 242 3 ; 4 RECENT ; -- get 5 most recent diet orders 5 N ORDT,ORIFN,ORIT,ORTXT,ORCURR,I,X,CNT,INDT S ORDT=$$NOW^XLFDT,CNT=0 6 F S ORDT=$O(^OR(100,"AW",ORVP,ORDG,ORDT),-1) Q:ORDT'>0 S ORIFN=0 D Q:CNT'<5 7 . F S ORIFN=$O(^OR(100,"AW",ORVP,ORDG,ORDT,ORIFN)) Q:ORIFN'>0 D Q:CNT'<5 8 .. S (ORIT,ORTXT)="" K ORCURR 9 .. S:$P($G(^OR(100,+ORIFN,3)),U,3)=6 ORCURR=1 Q:'$O(^(.1,0)) 10 .. S I=0 F S I=$O(^OR(100,ORIFN,.1,I)) Q:I'>0 S X=+$G(^(I,0)) I X D ;**95 11 ... 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 12 .. Q:'ORIT Q:'$L(ORTXT) Q:ORTXT="NPO" 13 .. S ORDIALOG(PROMPT,"LIST","D",ORIT)=ORIFN ;link oi string to order# 14 .. Q:$G(ORCURR) Q:+$G(ORDIALOG(PROMPT,"LIST","B",ORTXT)) 15 .. S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=ORIT_U_ORTXT 16 .. S ORDIALOG(PROMPT,"LIST","B",ORTXT)=ORIT 17 S ORDIALOG(PROMPT,"LIST")=CNT,ORDIALOG(PROMPT,"TOT")=0 18 Q 19 ; 20 PTR(X) ; -- Return ptr to Order Dialog file #101.41 for prompt X 21 Q +$O(^ORD(101.41,"B","OR GTX "_X,0)) 22 ; 23 EXP ; -- Expand old order into instances 24 N X,I,P,D S X=$G(ORDIALOG(PROMPT,ORI)) Q:'$L(X) Q:X'[";" 25 S ORDIALOG(PROMPT,ORI)=+X,I=ORI ;1st mod only 26 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 27 ;S:FIRST MAX=$L(X,";") 28 Q 29 ; 30 VALID() ; -- Returns 1 or 0, if selected diet modification is valid 31 N Y,NUM,I,TOTAL,OI 32 S OI=$G(ORDIALOG(PROMPT,ORI)) I OI[";" D Q Y 33 .S Y=1 D EXP 34 .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 35 S Y=1,TOTAL=+$G(ORDIALOG(PROMPT,"TOT")),ORDIALOG(PROMPT,"MAX")=5,MAX=5 36 I $$INACTIVE Q 0 ;**95 37 ;S:FIRST MAX=$S($G(ORDIALOG(PROMPT,"LIST","D",OI)):1,1:5) 38 S OI=$P($G(^ORD(101.43,+OI,0)),U) 39 I (OI="REGULAR")!(OI="NPO") D Q Y 40 . I '$D(ORESET),TOTAL=0 S ORDIALOG(PROMPT,"MAX")=1,MAX=1 Q ; add first 41 . I $G(ORESET),TOTAL'>1 S ORDIALOG(PROMPT,"MAX")=1,MAX=1 Q ; edit first 42 . S Y=0 W $C(7),!,OI_" may not be ordered with other diets!" 43 ;I $$DUP^ORCD(PROMPT,ORI) W $C(7),"This diet has already been selected!" Q 0 ;may delete after testing patch 95 44 S NUM=$P($G(^ORD(101.43,+ORDIALOG(PROMPT,ORI),"FH")),U,2) ; precedence # 45 S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D Q:Y'>0 46 . Q:I=ORI Q:$P($G(^ORD(101.43,+ORDIALOG(PROMPT,I),"FH")),U,2)'=NUM ;ok 47 . S Y=0 W $C(7),!,"This diet is not orderable with those already selected!",! 48 Q Y 49 ; 50 PREV ; -- Ck if previous diet being reordered 51 N I,OI,IFN S OI="",I=0 52 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 S OI=OI_$S(OI:";",1:"")_ORDIALOG(PROMPT,I) 53 S IFN=$S(OI:$G(ORDIALOG(PROMPT,"LIST","D",OI)),1:"") 54 S:IFN ORDIALOG("PREV")=IFN K:'IFN ORDIALOG("PREV") 55 Q 56 ; 57 CNV ; -- Convert meal abbreviation to time in X [Input Xform] 58 ; Expects X,PROMPT [also called from Entry Action, DO^ORWDXM2] 59 N A1 S X=$$UP^XLFSTR(X),A1=$P(X,"@",2) 60 I A1?1U,"BNE"[A1 D 61 . I $G(ORTYPE)="Z" S DATATYPE="",Y=X Q ;editor - ok 62 . N TIMES S TIMES=$S($D(ORPARAM(2)):$P(ORPARAM(2),U,7,9),1:"6:00A^12:00P^6:00P") 63 . S A1=$S(A1="B":$P(TIMES,U),A1="N":$P(TIMES,U,2),A1="E":$P(TIMES,U,3),1:A1) 64 . S $P(X,"@",2)=A1 65 Q 66 ; 67 LKUP ; -- special lookup routine for diet modifications 68 G:'$G(ORDIALOG(PROMPT,"LIST")) LKQ N OROOT,Z 69 S:X=" " X=$$SPACE^ORCDLG2(DOMAIN) S OROOT=$NA(ORDIALOG(PROMPT,"LIST")) 70 S Y=$$FIND^ORCDLG2(OROOT,X) 71 I Y Q:X?1N Q:'$$MORE(X,Y) S Z=$$OK Q:Z I Z="^" S Y="^" Q 72 LKQ D DIC^ORCDLG2 73 Q 74 ; 75 MORE(XX,YY) ; -- Returns 1 or 0, if more matches exist 76 Q:$P(YY,U)[";" 1 ;multiple mods 77 N CNT,XP,NOW S CNT=0,XP=XX,NOW=+$$NOW^XLFDT 78 F S XP=$O(^ORD(101.43,"S.DO",XP)) Q:$E(XP,1,$L(XX))'=XX D Q:CNT 79 . N IFN S IFN=$O(^ORD(101.43,"S.DO",XP,0)) Q:IFN=+YY ;same mod 80 . I $G(^ORD(101.43,IFN,.1)),$G(^(.1))'>NOW Q ;inactive 81 . S CNT=CNT+1 82 Q CNT 83 ; 84 OK() ; -- Verify multiple diet mod selection 85 N X,Y,DIR S DIR(0)="YA",DIR("A")=" ... OK? ",DIR("B")="Yes" 86 S DIR("?")="Enter YES if you wish to re-order this entire diet, or NO to search for another single diet modification" 87 D ^DIR S:$D(DUOUT)!$D(DTOUT) Y="^" 88 Q Y 89 INACTIVE() ;Check for inactive/duplicate diets in single or multiple modifications ;**95 90 N I,Y 91 S Y=0 92 S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:'+I D 93 .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 94 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 95 Q Y 1 ORCDFH1 ;SLC/MKB,DKM - Utility functions for FH dialogs cont ;8/24/01 10:22 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**73,95**;Dec 17, 1997 3 ; 4 RECENT ; -- get 5 most recent diet orders 5 N ORDT,ORIFN,ORIT,ORTXT,ORCURR,I,X,CNT,INDT S ORDT=$$NOW^XLFDT,CNT=0 6 F S ORDT=$O(^OR(100,"AW",ORVP,ORDG,ORDT),-1) Q:ORDT'>0 S ORIFN=0 D Q:CNT'<5 7 . F S ORIFN=$O(^OR(100,"AW",ORVP,ORDG,ORDT,ORIFN)) Q:ORIFN'>0 D Q:CNT'<5 8 .. S (ORIT,ORTXT)="" K ORCURR 9 .. S:$P($G(^OR(100,+ORIFN,3)),U,3)=6 ORCURR=1 Q:'$O(^(.1,0)) 10 .. S I=0 F S I=$O(^OR(100,ORIFN,.1,I)) Q:I'>0 S X=+$G(^(I,0)) I X D ;**95 11 ... 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 12 .. Q:'ORIT Q:'$L(ORTXT) Q:ORTXT="NPO" 13 .. S ORDIALOG(PROMPT,"LIST","D",ORIT)=ORIFN ;link oi string to order# 14 .. Q:$G(ORCURR) Q:+$G(ORDIALOG(PROMPT,"LIST","B",ORTXT)) 15 .. S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=ORIT_U_ORTXT 16 .. S ORDIALOG(PROMPT,"LIST","B",ORTXT)=ORIT 17 S ORDIALOG(PROMPT,"LIST")=CNT,ORDIALOG(PROMPT,"TOT")=0 18 Q 19 ; 20 PTR(X) ; -- Return ptr to Order Dialog file #101.41 for prompt X 21 Q +$O(^ORD(101.41,"AB","OR GTX "_X,0)) 22 ; 23 EXP ; -- Expand old order into instances 24 N X,I,P,D S X=$G(ORDIALOG(PROMPT,ORI)) Q:'$L(X) Q:X'[";" 25 S ORDIALOG(PROMPT,ORI)=+X,I=ORI ;1st mod only 26 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 27 ;S:FIRST MAX=$L(X,";") 28 Q 29 ; 30 VALID() ; -- Returns 1 or 0, if selected diet modification is valid 31 N Y,NUM,I,TOTAL,OI 32 S OI=$G(ORDIALOG(PROMPT,ORI)) I OI[";" D Q Y 33 .S Y=1 D EXP 34 .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 35 S Y=1,TOTAL=+$G(ORDIALOG(PROMPT,"TOT")),ORDIALOG(PROMPT,"MAX")=5,MAX=5 36 I $$INACTIVE Q 0 ;**95 37 ;S:FIRST MAX=$S($G(ORDIALOG(PROMPT,"LIST","D",OI)):1,1:5) 38 S OI=$P($G(^ORD(101.43,+OI,0)),U) 39 I (OI="REGULAR")!(OI="NPO") D Q Y 40 . I '$D(ORESET),TOTAL=0 S ORDIALOG(PROMPT,"MAX")=1,MAX=1 Q ; add first 41 . I $G(ORESET),TOTAL'>1 S ORDIALOG(PROMPT,"MAX")=1,MAX=1 Q ; edit first 42 . S Y=0 W $C(7),!,OI_" may not be ordered with other diets!" 43 ;I $$DUP^ORCD(PROMPT,ORI) W $C(7),"This diet has already been selected!" Q 0 ;may delete after testing patch 95 44 S NUM=$P($G(^ORD(101.43,+ORDIALOG(PROMPT,ORI),"FH")),U,2) ; precedence # 45 S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D Q:Y'>0 46 . Q:I=ORI Q:$P($G(^ORD(101.43,+ORDIALOG(PROMPT,I),"FH")),U,2)'=NUM ;ok 47 . S Y=0 W $C(7),!,"This diet is not orderable with those already selected!",! 48 Q Y 49 ; 50 PREV ; -- Ck if previous diet being reordered 51 N I,OI,IFN S OI="",I=0 52 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 S OI=OI_$S(OI:";",1:"")_ORDIALOG(PROMPT,I) 53 S IFN=$S(OI:$G(ORDIALOG(PROMPT,"LIST","D",OI)),1:"") 54 S:IFN ORDIALOG("PREV")=IFN K:'IFN ORDIALOG("PREV") 55 Q 56 ; 57 CNV ; -- Convert meal abbreviation to time [Input Xform] 58 N A1 S A1=$E($P(X,"@",2)) Q:'$L(A1) ;not in form T@meal 59 S A1=$S(A1="M":"11:59P",'$D(ORPARAM(2)):A1,A1="B":$P(ORPARAM(2),U,7),A1="N":$P(ORPARAM(2),U,8),A1="E":$P(ORPARAM(2),U,9),1:A1),$P(X,"@",2)=A1 60 I $G(ORTYPE)="Z",A1?1U,"BNE"[A1 S DATATYPE="",Y=X ;editor 61 Q 62 ; 63 LKUP ; -- special lookup routine for diet modifications 64 G:'$G(ORDIALOG(PROMPT,"LIST")) LKQ N OROOT,Z 65 S:X=" " X=$$SPACE^ORCDLG2(DOMAIN) S OROOT=$NA(ORDIALOG(PROMPT,"LIST")) 66 S Y=$$FIND^ORCDLG2(OROOT,X) 67 I Y Q:X?1N Q:'$$MORE(X,Y) S Z=$$OK Q:Z I Z="^" S Y="^" Q 68 LKQ D DIC^ORCDLG2 69 Q 70 ; 71 MORE(XX,YY) ; -- Returns 1 or 0, if more matches exist 72 Q:$P(YY,U)[";" 1 ;multiple mods 73 N CNT,XP,NOW S CNT=0,XP=XX,NOW=+$$NOW^XLFDT 74 F S XP=$O(^ORD(101.43,"S.DO",XP)) Q:$E(XP,1,$L(XX))'=XX D Q:CNT 75 . N IFN S IFN=$O(^ORD(101.43,"S.DO",XP,0)) Q:IFN=+YY ;same mod 76 . I $G(^ORD(101.43,IFN,.1)),$G(^(.1))'>NOW Q ;inactive 77 . S CNT=CNT+1 78 Q CNT 79 ; 80 OK() ; -- Verify multiple diet mod selection 81 N X,Y,DIR S DIR(0)="YA",DIR("A")=" ... OK? ",DIR("B")="Yes" 82 S DIR("?")="Enter YES if you wish to re-order this entire diet, or NO to search for another single diet modification" 83 D ^DIR S:$D(DUOUT)!$D(DTOUT) Y="^" 84 Q Y 85 INACTIVE() ;Check for inactive/duplicate diets in single or multiple modifications ;**95 86 N I,Y 87 S Y=0 88 S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:'+I D 89 .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 90 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 91 Q Y
Note:
See TracChangeset
for help on using the changeset viewer.
