- ORQ2 ; SLC/MKB/GSS - Detailed Order Report ;10/10/2006
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**12,56,75,94,141,213,195,243,282**;Dec 17, 1997;Build 6
- ;
- ;
- ;Reference to ^DIC(45.7 supported by IA #519
- ;Reference to OERR^VADPT supported by IA #4325
- ;
- DETAIL(ORY,ORIFN) ; -- Returns details of order ORIFN in ORY(#)
- N X,X2,I,CNT,ORDIALOG,OR0,OR3,OR6,SEQ,ITEM,PRMT,MULT,FIRST,TITLE,INST,DIWL,DIWR,DIWF,ACTION,VAIN,ORIGVIEW,ORNMSP,ORYT
- S CNT=0,ORIFN=+ORIFN,OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),OR6=$G(^(6))
- S ORNMSP=$$NMSP^ORCD($P(OR0,U,14))
- K @ORY,ORYT S ORIGVIEW=1 D TEXT^ORQ12(.ORYT,+ORIFN_";"_+$P(OR3,U,7),80) ;CurrTx
- M @ORY=ORYT ;Move text to global
- 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)
- S CNT=CNT+1,@ORY@(CNT)=" " ;blank
- D1 I $O(^OR(100,+ORIFN,2,0)) D
- . S CNT=CNT+1,@ORY@(CNT)="Sub Orders:"
- . D:$D(IOUON) SETVIDEO(CNT,1,11,IOUON,IOUOFF)
- . N IFN S IFN=0
- . F S IFN=+$O(^OR(100,+ORIFN,2,IFN)) Q:IFN<1 I $D(^OR(100,IFN,0)) D SUB(IFN)
- . S CNT=CNT+1,@ORY@(CNT)=" " ;blank
- I $P(OR3,U,9),$D(^OR(100,+$P(OR3,U,9),0)) D
- . S CNT=CNT+1,@ORY@(CNT)="Parent Order:"
- . D:$D(IOUON) SETVIDEO(CNT,1,12,IOUON,IOUOFF)
- . D SUB(+$P(OR3,U,9))
- . S CNT=CNT+1,@ORY@(CNT)=" " ;blank
- I $P(OR3,U,11)=1,$P(OR3,U,5) D ;Changed - show previous order
- . S CNT=CNT+1,@ORY@(CNT)="Previous Order:"
- . D:$D(IOUON) SETVIDEO(CNT,1,15,IOUON,IOUOFF) ;prev order original text
- . N ORZ,I,ORIGVIEW S ORIGVIEW=2 D TEXT^ORQ12(.ORZ,+$P(OR3,U,5),55)
- . S CNT=CNT+1,@ORY@(CNT)=" Order Text: "_$G(ORZ(1))
- . S I=1 F S I=$O(ORZ(I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORZ(I))
- D2 S CNT=CNT+1,@ORY@(CNT)="Activity:"
- D:$D(IOUON) SETVIDEO(CNT,1,9,IOUON,IOUOFF)
- S DIWL=1,DIWR=64,DIWF="C64",ORI=0 K ^UTILITY($J,"W")
- F S ORI=$O(^OR(100,ORIFN,8,ORI)) Q:ORI'>0 S ACTION=$G(^(ORI,0)) D ACT^ORQ20
- I "^1^12^13^"[(U_$P(OR3,U,3)_U),$L(OR6),$P(ACTION,U,2)'="DC" D DC^ORQ20
- 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:"")
- S CNT=CNT+1,@ORY@(CNT)=" " ;blank
- D3 S CNT=CNT+1,@ORY@(CNT)="Current Data:"
- D:$D(IOUON) SETVIDEO(CNT,1,13,IOUON,IOUOFF)
- D VA I $G(VAIN(2)) S CNT=CNT+1,@ORY@(CNT)="Current Primary Provider: "_$P(VAIN(2),"^",2)
- I $G(VAIN(11)) S CNT=CNT+1,@ORY@(CNT)="Current Attending Physician: "_$P(VAIN(11),"^",2)
- S CNT=CNT+1,@ORY@(CNT)="Treating Specialty: "_$P($G(^DIC(45.7,+$P(OR0,U,13),0)),U)
- S CNT=CNT+1,@ORY@(CNT)="Ordering Location: "_$P($G(^SC(+$P(OR0,U,10),0)),U)
- S CNT=CNT+1,@ORY@(CNT)="Start Date/Time: "_$S($P(OR0,U,8):$$DATE^ORQ20($P(OR0,U,8)),1:"")
- I $P(OR3,U,5),$P(OR3,U,11)=2 S X=$$ORIG(ORIFN),@ORY@(CNT)=@ORY@(CNT)_" (originally "_$$DATE^ORQ20(X)_")"
- S CNT=CNT+1,@ORY@(CNT)="Stop Date/Time: "_$S($P(OR0,U,9):$$DATE^ORQ20($P(OR0,U,9)),1:"")
- I $P(OR3,U,3)=1,$P(OR6,U,6) S @ORY@(CNT)=@ORY@(CNT)_" (expired "_$$DATE^ORQ20($P(OR6,U,6))_")"
- S CNT=CNT+1,@ORY@(CNT)="Current Status: "_$S($D(^ORD(100.01,+$P(OR3,U,3),0)):$P(^(0),"^"),1:"-")
- 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)
- S CNT=CNT+1,@ORY@(CNT)="Order #"_ORIFN
- S CNT=CNT+1,@ORY@(CNT)=" " ;blank
- D4 S CNT=CNT+1,@ORY@(CNT)="Order:" D:$D(IOUON) SETVIDEO(CNT,1,6,IOUON,IOUOFF)
- I '$O(^OR(100,ORIFN,4.5,0)),ORNMSP="RA" D RAD^ORQ21("") Q
- S ORDIALOG=$P(OR0,U,5) Q:$P(ORDIALOG,";",2)="ORD(101," ; 2.5 order
- D GETDLG^ORCD(+ORDIALOG),GETORDER^ORCD(ORIFN)
- S DIWL=1,DIWR=50,DIWF="C50"
- 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
- . S ITEM=$G(^ORD(101.41,+ORDIALOG,10,DA,0)) Q:$P(ITEM,U,11) ; child
- . S PRMT=$P(ITEM,U,2),MULT=$P(ITEM,U,7) Q:$P(ITEM,U,9)["*" ;hide
- . S FIRST=$O(ORDIALOG(PRMT,0)) Q:'FIRST ; no values
- . S TITLE=$S(MULT&$L($G(ORDIALOG(PRMT,"TTL"))):ORDIALOG(PRMT,"TTL"),1:ORDIALOG(PRMT,"A"))
- . S TITLE=TITLE_$$REPEAT^XLFSTR(" ",30-$L(TITLE))
- . S INST=0 F S INST=$O(ORDIALOG(PRMT,INST)) Q:INST'>0 D
- . . I $E(ORDIALOG(PRMT,0))="W" D WP Q
- . . 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))
- . . D ^DIWP
- . . D:$D(^ORD(101.41,+ORDIALOG,10,"DAD",PRMT)) CHILDREN(PRMT)
- . . 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)
- I ORNMSP="GMRC",$G(^OR(100,ORIFN,4)) S CNT=CNT+1,@ORY@(CNT)="Consult No.: "_+^(4)
- S CNT=CNT+1,@ORY@(CNT)=" " ;blank
- D RAD^ORQ21(1):ORNMSP="RA",MED^ORQ21:ORNMSP="PS" ;add'l data
- D BA^ORQ21 ;call for CIDC data
- D5 I $O(^OR(100,+ORIFN,9,0)) D
- . N CK,OK,X0,X,CDL,I S CNT=CNT+1,@ORY@(CNT)="Order Checks:"
- . D:$D(IOUON) SETVIDEO(CNT,1,13,IOUON,IOUOFF)
- . S CK=0 F S CK=$O(^OR(100,+ORIFN,9,CK)) Q:CK'>0 S X0=$G(^(CK,0)),X=$G(^(1)) D
- .. S CDL=$$CDL($P(X0,U,2)) I $P(X0,U,6),'$D(OK) S OK=$P(X0,U,4,6)
- .. I $L(X)'>68 S CNT=CNT+1,@ORY@(CNT)=CDL_X Q
- .. S DIWL=1,DIWR=68,DIWF="C68" K ^UTILITY($J,"W") D ^DIWP
- .. 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=" "
- . 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))
- . I $L($P(OK,U))'>68 S CNT=CNT+1,@ORY@(CNT)=" "_$P(OK,U) Q
- . S DIWL=1,DIWR=68,DIWF="C68",X=$P(OK,U) K ^UTILITY($J,"W") D ^DIWP
- . S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=" "_^(I,0)
- K ^TMP("ORWORD",$J),^UTILITY($J,"W")
- Q
- ;
- SUB(IFN) ; -- add suborder or parent
- N ORCY,STS,STRT,IG,A,STOP,SCHED D TEXT^ORQ12(.ORCY,IFN,58)
- S STS=$G(^ORD(100.01,+$P($G(^OR(100,IFN,3)),U,3),.1))
- S A=^OR(100,IFN,0),STRT=$P(A,U,8),STOP=$P(A,U,9)
- S SCHED=$$VALUE^ORX8(IFN,"SCHEDULE",1,"E")
- S:STRT'="" STRT=$$DATE^ORQ20(STRT) I ORNMSP="LR" S:STOP]"" STOP=$$DATE^ORQ20(STOP)
- 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)=" "
- I ORNMSP="LR",STOP]"" S CNT=CNT+1,@ORY@(CNT)=$J("How often: ",16)_SCHED_" Stops: "_STOP
- Q
- ;
- WP ; -- add word-processing
- N WP,ORI,X M WP=@ORDIALOG(PRMT,INST)
- S CNT=CNT+1,@ORY@(CNT)=TITLE
- 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
- Q
- ;
- CHILDREN(PARENT) ; -- add children
- N SEQ,DA,ITM,PRMT,TYPE,X
- S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PARENT,SEQ)) Q:SEQ'>0 S DA=$O(^(SEQ,0)) D
- . S ITM=$G(^ORD(101.41,+ORDIALOG,10,DA,0)),PRMT=$P(ITM,U,2)
- . Q:$G(ORDIALOG(PRMT,INST))="" Q:$P(ITM,U,9)["*" ;no value or hide
- . S TYPE=$E(ORDIALOG(PRMT,0)) D:TYPE="W" WP
- . I TYPE'="W" D
- . . S X=$$EXT^ORCD(PRMT,INST)
- . . I $L(X,"|")=2 S X=$$REPLACE^ORHLESC(X,"|","||")
- . . D ^DIWP
- Q
- ;
- SETVIDEO(LINE,COL,WIDTH,ON,OFF) ; -- set video attributes
- S ORY("VIDEO",LINE,COL,WIDTH)=ON
- S ORY("VIDEO",LINE,COL+WIDTH,0)=OFF
- Q
- ;
- VA ; -- Call VADPT
- N ORY,DFN,Y S DFN=+$P(OR0,"^",2) D OERR^VADPT
- Q
- ;
- CDL(X) ; -- Returns Clinical Danger Level X
- N Y S Y=$S(X=1:"HIGH:",X=2:"MODERATE:",X=3:"LOW:",1:"NONE:")
- S Y=$E(Y_" ",1,12)
- Q Y
- ;
- ORIG(IFN) ; -- Return original start date of [renewal] order
- N I,Y,X3,DONE
- S I=IFN,Y=$P($G(^OR(100,IFN,0)),U,8),DONE=0
- F S X3=$G(^OR(100,I,3)) D Q:DONE
- . I $P(X3,U,11)=2,$P(X3,U,5) S I=$P(X3,U,5) Q ;loop
- . S Y=$P($G(^OR(100,I,0)),U,8),DONE=1
- Q Y
- ORQ2 ; SLC/MKB/GSS - Detailed Order Report ;10/10/2006
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**12,56,75,94,141,213,195,243,282**;Dec 17, 1997;Build 6
- +2 ;
- +3 ;
- +4 ;Reference to ^DIC(45.7 supported by IA #519
- +5 ;Reference to OERR^VADPT supported by IA #4325
- +6 ;
- DETAIL(ORY,ORIFN) ; -- Returns details of order ORIFN in ORY(#)
- +1 NEW X,X2,I,CNT,ORDIALOG,OR0,OR3,OR6,SEQ,ITEM,PRMT,MULT,FIRST,TITLE,INST,DIWL,DIWR,DIWF,ACTION,VAIN,ORIGVIEW,ORNMSP,ORYT
- +2 SET CNT=0
- SET ORIFN=+ORIFN
- SET OR0=$GET(^OR(100,ORIFN,0))
- SET OR3=$GET(^(3))
- SET OR6=$GET(^(6))
- +3 SET ORNMSP=$$NMSP^ORCD($PIECE(OR0,U,14))
- +4 ;CurrTx
- KILL @ORY,ORYT
- SET ORIGVIEW=1
- DO TEXT^ORQ12(.ORYT,+ORIFN_";"_+$PIECE(OR3,U,7),80)
- +5 ;Move text to global
- MERGE @ORY=ORYT
- +6 SET I=0
- FOR CNT=1:1
- SET I=$ORDER(ORYT(I))
- IF I'>0
- QUIT
- IF $DATA(IORVON)
- DO SETVIDEO(I,1,$LENGTH(ORYT(I)),IORVON,IORVOFF)
- +7 ;blank
- SET CNT=CNT+1
- SET @ORY@(CNT)=" "
- D1 IF $ORDER(^OR(100,+ORIFN,2,0))
- Begin DoDot:1
- +1 SET CNT=CNT+1
- SET @ORY@(CNT)="Sub Orders:"
- +2 IF $DATA(IOUON)
- DO SETVIDEO(CNT,1,11,IOUON,IOUOFF)
- +3 NEW IFN
- SET IFN=0
- +4 FOR
- SET IFN=+$ORDER(^OR(100,+ORIFN,2,IFN))
- IF IFN<1
- QUIT
- IF $DATA(^OR(100,IFN,0))
- DO SUB(IFN)
- +5 ;blank
- SET CNT=CNT+1
- SET @ORY@(CNT)=" "
- End DoDot:1
- +6 IF $PIECE(OR3,U,9)
- IF $DATA(^OR(100,+$PIECE(OR3,U,9),0))
- Begin DoDot:1
- +7 SET CNT=CNT+1
- SET @ORY@(CNT)="Parent Order:"
- +8 IF $DATA(IOUON)
- DO SETVIDEO(CNT,1,12,IOUON,IOUOFF)
- +9 DO SUB(+$PIECE(OR3,U,9))
- +10 ;blank
- SET CNT=CNT+1
- SET @ORY@(CNT)=" "
- End DoDot:1
- +11 ;Changed - show previous order
- IF $PIECE(OR3,U,11)=1
- IF $PIECE(OR3,U,5)
- Begin DoDot:1
- +12 SET CNT=CNT+1
- SET @ORY@(CNT)="Previous Order:"
- +13 ;prev order original text
- IF $DATA(IOUON)
- DO SETVIDEO(CNT,1,15,IOUON,IOUOFF)
- +14 NEW ORZ,I,ORIGVIEW
- SET ORIGVIEW=2
- DO TEXT^ORQ12(.ORZ,+$PIECE(OR3,U,5),55)
- +15 SET CNT=CNT+1
- SET @ORY@(CNT)=" Order Text: "_$GET(ORZ(1))
- +16 SET I=1
- FOR
- SET I=$ORDER(ORZ(I))
- IF I'>0
- QUIT
- SET CNT=CNT+1
- SET @ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$GET(ORZ(I))
- End DoDot:1
- D2 SET CNT=CNT+1
- SET @ORY@(CNT)="Activity:"
- +1 IF $DATA(IOUON)
- DO SETVIDEO(CNT,1,9,IOUON,IOUOFF)
- +2 SET DIWL=1
- SET DIWR=64
- SET DIWF="C64"
- SET ORI=0
- KILL ^UTILITY($JOB,"W")
- +3 FOR
- SET ORI=$ORDER(^OR(100,ORIFN,8,ORI))
- IF ORI'>0
- QUIT
- SET ACTION=$GET(^(ORI,0))
- DO ACT^ORQ20
- +4 IF "^1^12^13^"[(U_$PIECE(OR3,U,3)_U)
- IF $LENGTH(OR6)
- IF $PIECE(ACTION,U,2)'="DC"
- DO DC^ORQ20
- +5 IF $PIECE(OR3,U,3)=2
- IF $PIECE(OR6,U,6)
- SET CNT=CNT+1
- SET @ORY@(CNT)=$$DATE^ORQ20($PIECE(OR6,U,6))_" Completed"_$SELECT($PIECE(OR6,U,7):" by "_$$USER^ORQ20($PIECE(OR6,U,7)),1:"")
- +6 ;blank
- SET CNT=CNT+1
- SET @ORY@(CNT)=" "
- D3 SET CNT=CNT+1
- SET @ORY@(CNT)="Current Data:"
- +1 IF $DATA(IOUON)
- DO SETVIDEO(CNT,1,13,IOUON,IOUOFF)
- +2 DO VA
- IF $GET(VAIN(2))
- SET CNT=CNT+1
- SET @ORY@(CNT)="Current Primary Provider: "_$PIECE(VAIN(2),"^",2)
- +3 IF $GET(VAIN(11))
- SET CNT=CNT+1
- SET @ORY@(CNT)="Current Attending Physician: "_$PIECE(VAIN(11),"^",2)
- +4 SET CNT=CNT+1
- SET @ORY@(CNT)="Treating Specialty: "_$PIECE($GET(^DIC(45.7,+$PIECE(OR0,U,13),0)),U)
- +5 SET CNT=CNT+1
- SET @ORY@(CNT)="Ordering Location: "_$PIECE($GET(^SC(+$PIECE(OR0,U,10),0)),U)
- +6 SET CNT=CNT+1
- SET @ORY@(CNT)="Start Date/Time: "_$SELECT($PIECE(OR0,U,8):$$DATE^ORQ20($PIECE(OR0,U,8)),1:"")
- +7 IF $PIECE(OR3,U,5)
- IF $PIECE(OR3,U,11)=2
- SET X=$$ORIG(ORIFN)
- SET @ORY@(CNT)=@ORY@(CNT)_" (originally "_$$DATE^ORQ20(X)_")"
- +8 SET CNT=CNT+1
- SET @ORY@(CNT)="Stop Date/Time: "_$SELECT($PIECE(OR0,U,9):$$DATE^ORQ20($PIECE(OR0,U,9)),1:"")
- +9 IF $PIECE(OR3,U,3)=1
- IF $PIECE(OR6,U,6)
- SET @ORY@(CNT)=@ORY@(CNT)_" (expired "_$$DATE^ORQ20($PIECE(OR6,U,6))_")"
- +10 SET CNT=CNT+1
- SET @ORY@(CNT)="Current Status: "_$SELECT($DATA(^ORD(100.01,+$PIECE(OR3,U,3),0)):$PIECE(^(0),"^"),1:"-")
- +11 IF $$GET^XPAR("ALL","ORPF SHOW STATUS DESCRIPTION",1,"I")
- IF $PIECE(OR3,U,3)
- IF $DATA(^ORD(100.01,$PIECE(OR3,U,3),0))
- NEW J
- SET J=0
- FOR
- SET J=$ORDER(^ORD(100.01,$PIECE(OR3,U,3),1,J))
- IF J<1
- QUIT
- SET CNT=CNT+1
- SET @ORY@(CNT)=" "_^(J,0)
- +12 SET CNT=CNT+1
- SET @ORY@(CNT)="Order #"_ORIFN
- +13 ;blank
- SET CNT=CNT+1
- SET @ORY@(CNT)=" "
- D4 SET CNT=CNT+1
- SET @ORY@(CNT)="Order:"
- IF $DATA(IOUON)
- DO SETVIDEO(CNT,1,6,IOUON,IOUOFF)
- +1 IF '$ORDER(^OR(100,ORIFN,4.5,0))
- IF ORNMSP="RA"
- DO RAD^ORQ21("")
- QUIT
- +2 ; 2.5 order
- SET ORDIALOG=$PIECE(OR0,U,5)
- IF $PIECE(ORDIALOG,";",2)="ORD(101,"
- QUIT
- +3 DO GETDLG^ORCD(+ORDIALOG)
- DO GETORDER^ORCD(ORIFN)
- +4 SET DIWL=1
- SET DIWR=50
- SET DIWF="C50"
- +5 SET SEQ=0
- FOR
- SET SEQ=$ORDER(^ORD(101.41,+ORDIALOG,10,"B",SEQ))
- IF SEQ'>0
- QUIT
- SET DA=0
- FOR
- SET DA=$ORDER(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA))
- IF 'DA
- QUIT
- Begin DoDot:1
- +6 ; child
- SET ITEM=$GET(^ORD(101.41,+ORDIALOG,10,DA,0))
- IF $PIECE(ITEM,U,11)
- QUIT
- +7 ;hide
- SET PRMT=$PIECE(ITEM,U,2)
- SET MULT=$PIECE(ITEM,U,7)
- IF $PIECE(ITEM,U,9)["*"
- QUIT
- +8 ; no values
- SET FIRST=$ORDER(ORDIALOG(PRMT,0))
- IF 'FIRST
- QUIT
- +9 SET TITLE=$SELECT(MULT&$LENGTH($GET(ORDIALOG(PRMT,"TTL"))):ORDIALOG(PRMT,"TTL"),1:ORDIALOG(PRMT,"A"))
- +10 SET TITLE=TITLE_$$REPEAT^XLFSTR(" ",30-$LENGTH(TITLE))
- +11 SET INST=0
- FOR
- SET INST=$ORDER(ORDIALOG(PRMT,INST))
- IF INST'>0
- QUIT
- Begin DoDot:2
- +12 IF $EXTRACT(ORDIALOG(PRMT,0))="W"
- DO WP
- QUIT
- +13 KILL ^UTILITY($JOB,"W")
- SET X=$$EXT^ORCD(PRMT,INST)
- IF TITLE["Infusion Rate"&(X'="")&(X'["ml/hr")
- SET TITLE="Infuse Over Time:"
- SET TITLE=TITLE_$$REPEAT^XLFSTR(" ",30-$LENGTH(TITLE))
- +14 DO ^DIWP
- +15 IF $DATA(^ORD(101.41,+ORDIALOG,10,"DAD",PRMT))
- DO CHILDREN(PRMT)
- +16 SET I=0
- FOR
- SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
- IF I'>0
- QUIT
- SET CNT=CNT+1
- SET @ORY@(CNT)=$SELECT((INST=FIRST)&(I=1):TITLE,1:$$REPEAT^XLFSTR(" ",30))_^(I,0)
- End DoDot:2
- End DoDot:1
- +17 IF ORNMSP="GMRC"
- IF $GET(^OR(100,ORIFN,4))
- SET CNT=CNT+1
- SET @ORY@(CNT)="Consult No.: "_+^(4)
- +18 ;blank
- SET CNT=CNT+1
- SET @ORY@(CNT)=" "
- +19 ;add'l data
- IF ORNMSP="RA"
- DO RAD^ORQ21(1)
- IF ORNMSP="PS"
- DO MED^ORQ21
- +20 ;call for CIDC data
- DO BA^ORQ21
- D5 IF $ORDER(^OR(100,+ORIFN,9,0))
- Begin DoDot:1
- +1 NEW CK,OK,X0,X,CDL,I
- SET CNT=CNT+1
- SET @ORY@(CNT)="Order Checks:"
- +2 IF $DATA(IOUON)
- DO SETVIDEO(CNT,1,13,IOUON,IOUOFF)
- +3 SET CK=0
- FOR
- SET CK=$ORDER(^OR(100,+ORIFN,9,CK))
- IF CK'>0
- QUIT
- SET X0=$GET(^(CK,0))
- SET X=$GET(^(1))
- Begin DoDot:2
- +4 SET CDL=$$CDL($PIECE(X0,U,2))
- IF $PIECE(X0,U,6)
- IF '$DATA(OK)
- SET OK=$PIECE(X0,U,4,6)
- +5 IF $LENGTH(X)'>68
- SET CNT=CNT+1
- SET @ORY@(CNT)=CDL_X
- QUIT
- +6 SET DIWL=1
- SET DIWR=68
- SET DIWF="C68"
- KILL ^UTILITY($JOB,"W")
- DO ^DIWP
- +7 SET I=0
- FOR
- SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
- IF I'>0
- QUIT
- SET CNT=CNT+1
- SET @ORY@(CNT)=CDL_^(I,0)
- SET CDL=" "
- End DoDot:2
- +8 IF '$LENGTH($GET(OK))
- QUIT
- SET CNT=CNT+1
- SET @ORY@(CNT)="Override: "_$SELECT($PIECE(OK,U,2):$$USER^ORQ20($PIECE(OK,U,2))_" on ",1:"")_$$DATE^ORQ20($PIECE(OK,U,3))
- +9 IF $LENGTH($PIECE(OK,U))'>68
- SET CNT=CNT+1
- SET @ORY@(CNT)=" "_$PIECE(OK,U)
- QUIT
- +10 SET DIWL=1
- SET DIWR=68
- SET DIWF="C68"
- SET X=$PIECE(OK,U)
- KILL ^UTILITY($JOB,"W")
- DO ^DIWP
- +11 SET I=0
- FOR
- SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
- IF I'>0
- QUIT
- SET CNT=CNT+1
- SET @ORY@(CNT)=" "_^(I,0)
- End DoDot:1
- +12 KILL ^TMP("ORWORD",$JOB),^UTILITY($JOB,"W")
- +13 QUIT
- +14 ;
- SUB(IFN) ; -- add suborder or parent
- +1 NEW ORCY,STS,STRT,IG,A,STOP,SCHED
- DO TEXT^ORQ12(.ORCY,IFN,58)
- +2 SET STS=$GET(^ORD(100.01,+$PIECE($GET(^OR(100,IFN,3)),U,3),.1))
- +3 SET A=^OR(100,IFN,0)
- SET STRT=$PIECE(A,U,8)
- SET STOP=$PIECE(A,U,9)
- +4 SET SCHED=$$VALUE^ORX8(IFN,"SCHEDULE",1,"E")
- +5 IF STRT'=""
- SET STRT=$$DATE^ORQ20(STRT)
- IF ORNMSP="LR"
- IF STOP]""
- SET STOP=$$DATE^ORQ20(STOP)
- +6 SET IG=0
- FOR
- SET IG=$ORDER(ORCY(IG))
- IF IG<1
- QUIT
- SET CNT=CNT+1
- SET @ORY@(CNT)=$JUSTIFY(STS,4)_" "_ORCY(IG)_" "_STRT
- SET (STS,STRT)=" "
- +7 IF ORNMSP="LR"
- IF STOP]""
- SET CNT=CNT+1
- SET @ORY@(CNT)=$JUSTIFY("How often: ",16)_SCHED_" Stops: "_STOP
- +8 QUIT
- +9 ;
- WP ; -- add word-processing
- +1 NEW WP,ORI,X
- MERGE WP=@ORDIALOG(PRMT,INST)
- +2 SET CNT=CNT+1
- SET @ORY@(CNT)=TITLE
- +3 SET ORI=0
- FOR
- SET ORI=$ORDER(WP(ORI))
- IF ORI'>0
- QUIT
- SET X=WP(ORI,0)
- IF X'=""
- SET CNT=CNT+1
- SET @ORY@(CNT)=" "_X
- +4 QUIT
- +5 ;
- CHILDREN(PARENT) ; -- add children
- +1 NEW SEQ,DA,ITM,PRMT,TYPE,X
- +2 SET SEQ=0
- FOR
- SET SEQ=$ORDER(^ORD(101.41,+ORDIALOG,10,"DAD",PARENT,SEQ))
- IF SEQ'>0
- QUIT
- SET DA=$ORDER(^(SEQ,0))
- Begin DoDot:1
- +3 SET ITM=$GET(^ORD(101.41,+ORDIALOG,10,DA,0))
- SET PRMT=$PIECE(ITM,U,2)
- +4 ;no value or hide
- IF $GET(ORDIALOG(PRMT,INST))=""
- QUIT
- IF $PIECE(ITM,U,9)["*"
- QUIT
- +5 SET TYPE=$EXTRACT(ORDIALOG(PRMT,0))
- IF TYPE="W"
- DO WP
- +6 IF TYPE'="W"
- Begin DoDot:2
- +7 SET X=$$EXT^ORCD(PRMT,INST)
- +8 IF $LENGTH(X,"|")=2
- SET X=$$REPLACE^ORHLESC(X,"|","||")
- +9 DO ^DIWP
- End DoDot:2
- End DoDot:1
- +10 QUIT
- +11 ;
- SETVIDEO(LINE,COL,WIDTH,ON,OFF) ; -- set video attributes
- +1 SET ORY("VIDEO",LINE,COL,WIDTH)=ON
- +2 SET ORY("VIDEO",LINE,COL+WIDTH,0)=OFF
- +3 QUIT
- +4 ;
- VA ; -- Call VADPT
- +1 NEW ORY,DFN,Y
- SET DFN=+$PIECE(OR0,"^",2)
- DO OERR^VADPT
- +2 QUIT
- +3 ;
- CDL(X) ; -- Returns Clinical Danger Level X
- +1 NEW Y
- SET Y=$SELECT(X=1:"HIGH:",X=2:"MODERATE:",X=3:"LOW:",1:"NONE:")
- +2 SET Y=$EXTRACT(Y_" ",1,12)
- +3 QUIT Y
- +4 ;
- ORIG(IFN) ; -- Return original start date of [renewal] order
- +1 NEW I,Y,X3,DONE
- +2 SET I=IFN
- SET Y=$PIECE($GET(^OR(100,IFN,0)),U,8)
- SET DONE=0
- +3 FOR
- SET X3=$GET(^OR(100,I,3))
- Begin DoDot:1
- +4 ;loop
- IF $PIECE(X3,U,11)=2
- IF $PIECE(X3,U,5)
- SET I=$PIECE(X3,U,5)
- QUIT
- +5 SET Y=$PIECE($GET(^OR(100,I,0)),U,8)
- SET DONE=1
- End DoDot:1
- IF DONE
- QUIT
- +6 QUIT Y
