- 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/ORQ2.m
r613 r623 1 ORQ2 ; SLC/MKB/GSS - Detailed Order Report ;10/10/2006 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**12,56,75,94,141,213,195,243**;Dec 17, 1997;Build 242 3 DETAIL(ORY,ORIFN) ; -- Returns details of order ORIFN in ORY(#) 4 N X,X2,I,CNT,ORDIALOG,OR0,OR3,OR6,SEQ,ITEM,PRMT,MULT,FIRST,TITLE,INST,DIWL,DIWR,DIWF,ACTION,VAIN,ORIGVIEW,ORNMSP,ORYT 5 S CNT=0,ORIFN=+ORIFN,OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),OR6=$G(^(6)) 6 K @ORY,ORYT S ORIGVIEW=1 D TEXT^ORQ12(.ORYT,+ORIFN_";"_+$P(OR3,U,7),80) ;CurrTx 7 M @ORY=ORYT ;Move text to global 8 S I=0 F CNT=1:1 S I=$O(ORYT(I)) Q:I'>0 D:$D(IORVON) SETVIDEO(I,1,$L(ORYT(I)),IORVON,IORVOFF) 9 S CNT=CNT+1,@ORY@(CNT)=" " ;blank 10 D1 I $O(^OR(100,+ORIFN,2,0)) D 11 . S CNT=CNT+1,@ORY@(CNT)="Sub Orders:" 12 . D:$D(IOUON) SETVIDEO(CNT,1,11,IOUON,IOUOFF) 13 . N IFN S IFN=0 14 . F S IFN=+$O(^OR(100,+ORIFN,2,IFN)) Q:IFN<1 I $D(^OR(100,IFN,0)) D SUB(IFN) 15 . S CNT=CNT+1,@ORY@(CNT)=" " ;blank 16 I $P(OR3,U,9),$D(^OR(100,+$P(OR3,U,9),0)) D 17 . S CNT=CNT+1,@ORY@(CNT)="Parent Order:" 18 . D:$D(IOUON) SETVIDEO(CNT,1,12,IOUON,IOUOFF) 19 . D SUB(+$P(OR3,U,9)) 20 . S CNT=CNT+1,@ORY@(CNT)=" " ;blank 21 I $P(OR3,U,11)=1,$P(OR3,U,5) D ;Changed - show previous order 22 . S CNT=CNT+1,@ORY@(CNT)="Previous Order:" 23 . D:$D(IOUON) SETVIDEO(CNT,1,15,IOUON,IOUOFF) ;prev order original text 24 . N ORZ,I,ORIGVIEW S ORIGVIEW=2 D TEXT^ORQ12(.ORZ,+$P(OR3,U,5),55) 25 . S CNT=CNT+1,@ORY@(CNT)=" Order Text: "_$G(ORZ(1)) 26 . S I=1 F S I=$O(ORZ(I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORZ(I)) 27 D2 S CNT=CNT+1,@ORY@(CNT)="Activity:" 28 D:$D(IOUON) SETVIDEO(CNT,1,9,IOUON,IOUOFF) 29 S DIWL=1,DIWR=64,DIWF="C64",ORI=0 K ^UTILITY($J,"W") 30 F S ORI=$O(^OR(100,ORIFN,8,ORI)) Q:ORI'>0 S ACTION=$G(^(ORI,0)) D ACT^ORQ20 31 I "^1^12^13^"[(U_$P(OR3,U,3)_U),$L(OR6),$P(ACTION,U,2)'="DC" D DC^ORQ20 32 I $P(OR3,U,3)=2,$P(OR6,U,6) S CNT=CNT+1,@ORY@(CNT)=$$DATE^ORQ20($P(OR6,U,6))_" Completed"_$S($P(OR6,U,7):" by "_$$USER^ORQ20($P(OR6,U,7)),1:"") 33 S CNT=CNT+1,@ORY@(CNT)=" " ;blank 34 D3 S CNT=CNT+1,@ORY@(CNT)="Current Data:" 35 D:$D(IOUON) SETVIDEO(CNT,1,13,IOUON,IOUOFF) 36 D VA I $G(VAIN(2)) S CNT=CNT+1,@ORY@(CNT)="Current Primary Provider: "_$P(VAIN(2),"^",2) 37 I $G(VAIN(11)) S CNT=CNT+1,@ORY@(CNT)="Current Attending Physician: "_$P(VAIN(11),"^",2) 38 S CNT=CNT+1,@ORY@(CNT)="Treating Specialty: "_$P($G(^DIC(45.7,+$P(OR0,U,13),0)),U) 39 S CNT=CNT+1,@ORY@(CNT)="Ordering Location: "_$P($G(^SC(+$P(OR0,U,10),0)),U) 40 S CNT=CNT+1,@ORY@(CNT)="Start Date/Time: "_$S($P(OR0,U,8):$$DATE^ORQ20($P(OR0,U,8)),1:"") 41 I $P(OR3,U,5),$P(OR3,U,11)=2 S X=$$ORIG(ORIFN),@ORY@(CNT)=@ORY@(CNT)_" (originally "_$$DATE^ORQ20(X)_")" 42 S CNT=CNT+1,@ORY@(CNT)="Stop Date/Time: "_$S($P(OR0,U,9):$$DATE^ORQ20($P(OR0,U,9)),1:"") 43 I $P(OR3,U,3)=1,$P(OR6,U,6) S @ORY@(CNT)=@ORY@(CNT)_" (expired "_$$DATE^ORQ20($P(OR6,U,6))_")" 44 S CNT=CNT+1,@ORY@(CNT)="Current Status: "_$S($D(^ORD(100.01,+$P(OR3,U,3),0)):$P(^(0),"^"),1:"-") 45 I $$GET^XPAR("ALL","ORPF SHOW STATUS DESCRIPTION",1,"I"),$P(OR3,U,3),$D(^ORD(100.01,$P(OR3,U,3),0)) N J S J=0 F S J=$O(^ORD(100.01,$P(OR3,U,3),1,J)) Q:J<1 S CNT=CNT+1,@ORY@(CNT)=" "_^(J,0) 46 S CNT=CNT+1,@ORY@(CNT)="Order #"_ORIFN 47 S CNT=CNT+1,@ORY@(CNT)=" " ;blank 48 D4 S CNT=CNT+1,@ORY@(CNT)="Order:" D:$D(IOUON) SETVIDEO(CNT,1,6,IOUON,IOUOFF) 49 S ORNMSP=$$NMSP^ORCD($P(OR0,U,14)) 50 I '$O(^OR(100,ORIFN,4.5,0)),ORNMSP="RA" D RAD^ORQ21("") Q 51 S ORDIALOG=$P(OR0,U,5) Q:$P(ORDIALOG,";",2)="ORD(101," ; 2.5 order 52 D GETDLG^ORCD(+ORDIALOG),GETORDER^ORCD(ORIFN) 53 S DIWL=1,DIWR=50,DIWF="C50" 54 S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0 S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D 55 . S ITEM=$G(^ORD(101.41,+ORDIALOG,10,DA,0)) Q:$P(ITEM,U,11) ; child 56 . S PRMT=$P(ITEM,U,2),MULT=$P(ITEM,U,7) Q:$P(ITEM,U,9)["*" ;hide 57 . S FIRST=$O(ORDIALOG(PRMT,0)) Q:'FIRST ; no values 58 . S TITLE=$S(MULT&$L($G(ORDIALOG(PRMT,"TTL"))):ORDIALOG(PRMT,"TTL"),1:ORDIALOG(PRMT,"A")) 59 . S TITLE=TITLE_$$REPEAT^XLFSTR(" ",30-$L(TITLE)) 60 . S INST=0 F S INST=$O(ORDIALOG(PRMT,INST)) Q:INST'>0 D 61 . . I $E(ORDIALOG(PRMT,0))="W" D WP Q 62 . . K ^UTILITY($J,"W") S X=$$EXT^ORCD(PRMT,INST) I TITLE["Infusion Rate"&(X'="")&(X'["ml/hr") S TITLE="Infuse Over Time:",TITLE=TITLE_$$REPEAT^XLFSTR(" ",30-$L(TITLE)) 63 . . D ^DIWP 64 . . D:$D(^ORD(101.41,+ORDIALOG,10,"DAD",PRMT)) CHILDREN(PRMT) 65 . . S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=$S((INST=FIRST)&(I=1):TITLE,1:$$REPEAT^XLFSTR(" ",30))_^(I,0) 66 I ORNMSP="GMRC",$G(^OR(100,ORIFN,4)) S CNT=CNT+1,@ORY@(CNT)="Consult No.: "_+^(4) 67 S CNT=CNT+1,@ORY@(CNT)=" " ;blank 68 D RAD^ORQ21(1):ORNMSP="RA",MED^ORQ21:ORNMSP="PS" ;add'l data 69 D BA^ORQ21 ;call for CIDC data 70 D5 I $O(^OR(100,+ORIFN,9,0)) D 71 . N CK,OK,X0,X,CDL,I S CNT=CNT+1,@ORY@(CNT)="Order Checks:" 72 . D:$D(IOUON) SETVIDEO(CNT,1,13,IOUON,IOUOFF) 73 . S CK=0 F S CK=$O(^OR(100,+ORIFN,9,CK)) Q:CK'>0 S X0=$G(^(CK,0)),X=$G(^(1)) D 74 .. S CDL=$$CDL($P(X0,U,2)) I $P(X0,U,6),'$D(OK) S OK=$P(X0,U,4,6) 75 .. I $L(X)'>68 S CNT=CNT+1,@ORY@(CNT)=CDL_X Q 76 .. S DIWL=1,DIWR=68,DIWF="C68" K ^UTILITY($J,"W") D ^DIWP 77 .. S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=CDL_^(I,0),CDL=" " 78 . Q:'$L($G(OK)) S CNT=CNT+1,@ORY@(CNT)="Override: "_$S($P(OK,U,2):$$USER^ORQ20($P(OK,U,2))_" on ",1:"")_$$DATE^ORQ20($P(OK,U,3)) 79 . I $L($P(OK,U))'>68 S CNT=CNT+1,@ORY@(CNT)=" "_$P(OK,U) Q 80 . S DIWL=1,DIWR=68,DIWF="C68",X=$P(OK,U) K ^UTILITY($J,"W") D ^DIWP 81 . S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=" "_^(I,0) 82 K ^TMP("ORWORD",$J),^UTILITY($J,"W") 83 Q 84 ; 85 SUB(IFN) ; -- add suborder or parent 86 N ORCY,STS,STRT,IG D TEXT^ORQ12(.ORCY,IFN,58) 87 S STS=$G(^ORD(100.01,+$P($G(^OR(100,IFN,3)),U,3),.1)) 88 S STRT=$P(^OR(100,IFN,0),U,8) S:STRT'="" STRT=$$DATE^ORQ20(STRT) 89 S IG=0 F S IG=$O(ORCY(IG)) Q:IG<1 S CNT=CNT+1,@ORY@(CNT)=$J(STS,4)_" "_ORCY(IG)_" "_STRT,(STS,STRT)=" " 90 Q 91 ; 92 WP ; -- add word-processing 93 N WP,ORI,X M WP=@ORDIALOG(PRMT,INST) 94 S CNT=CNT+1,@ORY@(CNT)=TITLE 95 S ORI=0 F S ORI=$O(WP(ORI)) Q:ORI'>0 S X=WP(ORI,0) S:X'="" CNT=CNT+1,@ORY@(CNT)=" "_X 96 Q 97 ; 98 CHILDREN(PARENT) ; -- add children 99 N SEQ,DA,ITM,PRMT,TYPE,X 100 S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PARENT,SEQ)) Q:SEQ'>0 S DA=$O(^(SEQ,0)) D 101 . S ITM=$G(^ORD(101.41,+ORDIALOG,10,DA,0)),PRMT=$P(ITM,U,2) 102 . Q:$G(ORDIALOG(PRMT,INST))="" Q:$P(ITM,U,9)["*" ;no value or hide 103 . S TYPE=$E(ORDIALOG(PRMT,0)) D:TYPE="W" WP 104 . I TYPE'="W" D 105 . . S X=$$EXT^ORCD(PRMT,INST) 106 . . I $L(X,"|")=2 S X=$$REPLACE^ORHLESC(X,"|","||") 107 . . D ^DIWP 108 Q 109 ; 110 SETVIDEO(LINE,COL,WIDTH,ON,OFF) ; -- set video attributes 111 S ORY("VIDEO",LINE,COL,WIDTH)=ON 112 S ORY("VIDEO",LINE,COL+WIDTH,0)=OFF 113 Q 114 ; 115 VA ; -- Call VADPT 116 N ORY,DFN,Y S DFN=+$P(OR0,"^",2) D OERR^VADPT 117 Q 118 ; 119 CDL(X) ; -- Returns Clinical Danger Level X 120 N Y S Y=$S(X=1:"HIGH:",X=2:"MODERATE:",X=3:"LOW:",1:"NONE:") 121 S Y=$E(Y_" ",1,12) 122 Q Y 123 ; 124 ORIG(IFN) ; -- Return original start date of [renewal] order 125 N I,Y,X3,DONE 126 S I=IFN,Y=$P($G(^OR(100,IFN,0)),U,8),DONE=0 127 F S X3=$G(^OR(100,I,3)) D Q:DONE 128 . I $P(X3,U,11)=2,$P(X3,U,5) S I=$P(X3,U,5) Q ;loop 129 . S Y=$P($G(^OR(100,I,0)),U,8),DONE=1 130 Q Y 1 ORQ2 ; SLC/MKB/GSS - Detailed Order Report ;7/1/04 10:58 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**12,56,75,94,141,213,195**;Dec 17, 1997 3 DETAIL(ORY,ORIFN) ; -- Returns details of order ORIFN in ORY(#) 4 N X,X2,I,CNT,ORDIALOG,OR0,OR3,OR6,SEQ,ITEM,PRMT,MULT,FIRST,TITLE,INST,DIWL,DIWR,DIWF,ACTION,VAIN,ORIGVIEW,ORNMSP,ORYT 5 S CNT=0,ORIFN=+ORIFN,OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),OR6=$G(^(6)) 6 K @ORY,ORYT S ORIGVIEW=1 D TEXT^ORQ12(.ORYT,+ORIFN_";"_+$P(OR3,U,7),80) ;CurrTx 7 M @ORY=ORYT ;Move text to global 8 S I=0 F CNT=1:1 S I=$O(ORYT(I)) Q:I'>0 D:$D(IORVON) SETVIDEO(I,1,$L(ORYT(I)),IORVON,IORVOFF) 9 S CNT=CNT+1,@ORY@(CNT)=" " ;blank 10 D1 I $O(^OR(100,+ORIFN,2,0)) D 11 . S CNT=CNT+1,@ORY@(CNT)="Sub Orders:" 12 . D:$D(IOUON) SETVIDEO(CNT,1,11,IOUON,IOUOFF) 13 . N IFN S IFN=0 14 . F S IFN=+$O(^OR(100,+ORIFN,2,IFN)) Q:IFN<1 I $D(^OR(100,IFN,0)) D SUB(IFN) 15 . S CNT=CNT+1,@ORY@(CNT)=" " ;blank 16 I $P(OR3,U,9),$D(^OR(100,+$P(OR3,U,9),0)) D 17 . S CNT=CNT+1,@ORY@(CNT)="Parent Order:" 18 . D:$D(IOUON) SETVIDEO(CNT,1,12,IOUON,IOUOFF) 19 . D SUB(+$P(OR3,U,9)) 20 . S CNT=CNT+1,@ORY@(CNT)=" " ;blank 21 I $P(OR3,U,11)=1,$P(OR3,U,5) D ;Changed - show previous order 22 . S CNT=CNT+1,@ORY@(CNT)="Previous Order:" 23 . D:$D(IOUON) SETVIDEO(CNT,1,15,IOUON,IOUOFF) ;prev order original text 24 . N ORZ,I,ORIGVIEW S ORIGVIEW=2 D TEXT^ORQ12(.ORZ,+$P(OR3,U,5),55) 25 . S CNT=CNT+1,@ORY@(CNT)=" Order Text: "_$G(ORZ(1)) 26 . S I=1 F S I=$O(ORZ(I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORZ(I)) 27 D2 S CNT=CNT+1,@ORY@(CNT)="Activity:" 28 D:$D(IOUON) SETVIDEO(CNT,1,9,IOUON,IOUOFF) 29 S DIWL=1,DIWR=64,DIWF="C64",ORI=0 K ^UTILITY($J,"W") 30 F S ORI=$O(^OR(100,ORIFN,8,ORI)) Q:ORI'>0 S ACTION=$G(^(ORI,0)) D ACT^ORQ20 31 I "^1^12^13^"[(U_$P(OR3,U,3)_U),$L(OR6),$P(ACTION,U,2)'="DC" D DC^ORQ20 32 I $P(OR3,U,3)=2,$P(OR6,U,6) S CNT=CNT+1,@ORY@(CNT)=$$DATE^ORQ20($P(OR6,U,6))_" Completed"_$S($P(OR6,U,7):" by "_$$USER^ORQ20($P(OR6,U,7)),1:"") 33 S CNT=CNT+1,@ORY@(CNT)=" " ;blank 34 D3 S CNT=CNT+1,@ORY@(CNT)="Current Data:" 35 D:$D(IOUON) SETVIDEO(CNT,1,13,IOUON,IOUOFF) 36 D VA I $G(VAIN(2)) S CNT=CNT+1,@ORY@(CNT)="Current Primary Provider: "_$P(VAIN(2),"^",2) 37 I $G(VAIN(11)) S CNT=CNT+1,@ORY@(CNT)="Current Attending Physician: "_$P(VAIN(11),"^",2) 38 S CNT=CNT+1,@ORY@(CNT)="Treating Specialty: "_$P($G(^DIC(45.7,+$P(OR0,U,13),0)),U) 39 S CNT=CNT+1,@ORY@(CNT)="Ordering Location: "_$P($G(^SC(+$P(OR0,U,10),0)),U) 40 S CNT=CNT+1,@ORY@(CNT)="Start Date/Time: "_$S($P(OR0,U,8):$$DATE^ORQ20($P(OR0,U,8)),1:"") 41 I $P(OR3,U,5),$P(OR3,U,11)=2 S X=$$ORIG(ORIFN),@ORY@(CNT)=@ORY@(CNT)_" (originally "_$$DATE^ORQ20(X)_")" 42 S CNT=CNT+1,@ORY@(CNT)="Stop Date/Time: "_$S($P(OR0,U,9):$$DATE^ORQ20($P(OR0,U,9)),1:"") 43 S CNT=CNT+1,@ORY@(CNT)="Current Status: "_$S($D(^ORD(100.01,+$P(OR3,U,3),0)):$P(^(0),"^"),1:"-") 44 I $$GET^XPAR("ALL","ORPF SHOW STATUS DESCRIPTION",1,"I"),$P(OR3,U,3),$D(^ORD(100.01,$P(OR3,U,3),0)) N J S J=0 F S J=$O(^ORD(100.01,$P(OR3,U,3),1,J)) Q:J<1 S CNT=CNT+1,@ORY@(CNT)=" "_^(J,0) 45 S CNT=CNT+1,@ORY@(CNT)="Order #"_ORIFN 46 S CNT=CNT+1,@ORY@(CNT)=" " ;blank 47 D4 S CNT=CNT+1,@ORY@(CNT)="Order:" D:$D(IOUON) SETVIDEO(CNT,1,6,IOUON,IOUOFF) 48 S ORNMSP=$$NMSP^ORCD($P(OR0,U,14)) 49 I '$O(^OR(100,ORIFN,4.5,0)),ORNMSP="RA" D RAD^ORQ21("") Q 50 S ORDIALOG=$P(OR0,U,5) Q:$P(ORDIALOG,";",2)="ORD(101," ; 2.5 order 51 D GETDLG^ORCD(+ORDIALOG),GETORDER^ORCD(ORIFN) 52 S DIWL=1,DIWR=50,DIWF="C50" 53 S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0 S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D 54 . S ITEM=$G(^ORD(101.41,+ORDIALOG,10,DA,0)) Q:$P(ITEM,U,11) ; child 55 . S PRMT=$P(ITEM,U,2),MULT=$P(ITEM,U,7) Q:$P(ITEM,U,9)["*" ;hide 56 . S FIRST=$O(ORDIALOG(PRMT,0)) Q:'FIRST ; no values 57 . S TITLE=$S(MULT&$L($G(ORDIALOG(PRMT,"TTL"))):ORDIALOG(PRMT,"TTL"),1:ORDIALOG(PRMT,"A")) 58 . S TITLE=TITLE_$$REPEAT^XLFSTR(" ",30-$L(TITLE)) 59 . S INST=0 F S INST=$O(ORDIALOG(PRMT,INST)) Q:INST'>0 D 60 . . I $E(ORDIALOG(PRMT,0))="W" D WP Q 61 . . K ^UTILITY($J,"W") S X=$$EXT^ORCD(PRMT,INST) D ^DIWP 62 . . D:$D(^ORD(101.41,+ORDIALOG,10,"DAD",PRMT)) CHILDREN(PRMT) 63 . . S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=$S((INST=FIRST)&(I=1):TITLE,1:$$REPEAT^XLFSTR(" ",30))_^(I,0) 64 I ORNMSP="GMRC",$G(^OR(100,ORIFN,4)) S CNT=CNT+1,@ORY@(CNT)="Consult No.: "_+^(4) 65 S CNT=CNT+1,@ORY@(CNT)=" " ;blank 66 D RAD^ORQ21(1):ORNMSP="RA",MED^ORQ21:ORNMSP="PS" ;add'l data 67 D BA^ORQ21 ;call for CIDC data 68 D5 I $O(^OR(100,+ORIFN,9,0)) D 69 . N CK,OK,X0,X,CDL,I S CNT=CNT+1,@ORY@(CNT)="Order Checks:" 70 . D:$D(IOUON) SETVIDEO(CNT,1,13,IOUON,IOUOFF) 71 . S CK=0 F S CK=$O(^OR(100,+ORIFN,9,CK)) Q:CK'>0 S X0=$G(^(CK,0)),X=$G(^(1)) D 72 .. S CDL=$$CDL($P(X0,U,2)) I $P(X0,U,6),'$D(OK) S OK=$P(X0,U,4,6) 73 .. I $L(X)'>68 S CNT=CNT+1,@ORY@(CNT)=CDL_X Q 74 .. S DIWL=1,DIWR=68,DIWF="C68" K ^UTILITY($J,"W") D ^DIWP 75 .. S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=CDL_^(I,0),CDL=" " 76 . Q:'$L($G(OK)) S CNT=CNT+1,@ORY@(CNT)="Override: "_$S($P(OK,U,2):$$USER^ORQ20($P(OK,U,2))_" on ",1:"")_$$DATE^ORQ20($P(OK,U,3)) 77 . I $L($P(OK,U))'>68 S CNT=CNT+1,@ORY@(CNT)=" "_$P(OK,U) Q 78 . S DIWL=1,DIWR=68,DIWF="C68",X=$P(OK,U) K ^UTILITY($J,"W") D ^DIWP 79 . S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=" "_^(I,0) 80 K ^TMP("ORWORD",$J),^UTILITY($J,"W") 81 Q 82 ; 83 SUB(IFN) ; -- add suborder or parent 84 N ORCY,STS,STRT,IG D TEXT^ORQ12(.ORCY,IFN,58) 85 S STS=$G(^ORD(100.01,+$P($G(^OR(100,IFN,3)),U,3),.1)) 86 S STRT=$P(^OR(100,IFN,0),U,8) S:STRT'="" STRT=$$DATE^ORQ20(STRT) 87 S IG=0 F S IG=$O(ORCY(IG)) Q:IG<1 S CNT=CNT+1,@ORY@(CNT)=$J(STS,4)_" "_ORCY(IG)_" "_STRT,(STS,STRT)=" " 88 Q 89 ; 90 WP ; -- add word-processing 91 N WP,ORI,X M WP=@ORDIALOG(PRMT,INST) 92 S CNT=CNT+1,@ORY@(CNT)=TITLE 93 S ORI=0 F S ORI=$O(WP(ORI)) Q:ORI'>0 S X=WP(ORI,0) S:X'="" CNT=CNT+1,@ORY@(CNT)=" "_X 94 Q 95 ; 96 CHILDREN(PARENT) ; -- add children 97 N SEQ,DA,ITM,PRMT,TYPE,X 98 S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PARENT,SEQ)) Q:SEQ'>0 S DA=$O(^(SEQ,0)) D 99 . S ITM=$G(^ORD(101.41,+ORDIALOG,10,DA,0)),PRMT=$P(ITM,U,2) 100 . Q:$G(ORDIALOG(PRMT,INST))="" Q:$P(ITM,U,9)["*" ;no value or hide 101 . S TYPE=$E(ORDIALOG(PRMT,0)) D:TYPE="W" WP 102 . I TYPE'="W" S X=$$EXT^ORCD(PRMT,INST) D ^DIWP 103 Q 104 ; 105 SETVIDEO(LINE,COL,WIDTH,ON,OFF) ; -- set video attributes 106 S ORY("VIDEO",LINE,COL,WIDTH)=ON 107 S ORY("VIDEO",LINE,COL+WIDTH,0)=OFF 108 Q 109 ; 110 VA ; -- Call VADPT 111 N ORY,DFN,Y S DFN=+$P(OR0,"^",2) D OERR^VADPT 112 Q 113 ; 114 CDL(X) ; -- Returns Clinical Danger Level X 115 N Y S Y=$S(X=1:"HIGH:",X=2:"MODERATE:",X=3:"LOW:",1:"NONE:") 116 S Y=$E(Y_" ",1,12) 117 Q Y 118 ; 119 ORIG(IFN) ; -- Return original start date of [renewal] order 120 N I,Y,X3,DONE 121 S I=IFN,Y=$P($G(^OR(100,IFN,0)),U,8),DONE=0 122 F S X3=$G(^OR(100,I,3)) D Q:DONE 123 . I $P(X3,U,11)=2,$P(X3,U,5) S I=$P(X3,U,5) Q ;loop 124 . S Y=$P($G(^OR(100,I,0)),U,8),DONE=1 125 Q Y
Note:
See TracChangeset
for help on using the changeset viewer.
