- ORWCOM ;SLC/JM - Wraps RPCs for COM Objects Hooks ;8/02/2001
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109**;Dec 17, 1997
- Q
- DETAILS(ORY,ID) ; Returns Details about a specific COM Object
- N NODE
- S ORY=0
- I +ID D
- .S NODE=$G(^ORD(101.15,+ID,0))
- .I NODE'="",$P(NODE,U,3)'="I" S ORY=ID_U_NODE
- Q
- GETOBJ(ORY,PARAM,ORIDX) ; Returns COM Object info
- N SRV,ID
- S SRV=$$GET1^DIQ(200,DUZ,29,"I")
- S ID=$$GET^XPAR(DUZ_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS",PARAM,ORIDX,"I")
- D DETAILS(.ORY,ID)
- Q
- PTOBJ(ORY) ; Returns Patient COM Object
- D GETOBJ(.ORY,"ORWCOM PATIENT SELECTED",1)
- Q
- ORDEROBJ(ORY,ORGRP) ; Returns Accept Order COM Object
- D GETOBJ(.ORY,"ORWCOM ORDER ACCEPTED",ORGRP)
- Q
- GETOBJS(ORY) ; Returns list of all active COM objects
- N I,J,IDX,NODE
- S I="",IDX=0
- F S I=$O(^ORD(101.15,"B",I)) Q:I="" D
- .S J=$O(^ORD(101.15,"B",I,0)) Q:'+J
- .S NODE=$G(^ORD(101.15,J,0))
- .I $P(NODE,U,3)'="I" D
- ..S IDX=IDX+1
- ..S ORY(IDX)=J_U_NODE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWCOM 963 printed Mar 13, 2025@21:40:04 Page 2
- ORWCOM ;SLC/JM - Wraps RPCs for COM Objects Hooks ;8/02/2001
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109**;Dec 17, 1997
- +2 QUIT
- DETAILS(ORY,ID) ; Returns Details about a specific COM Object
- +1 NEW NODE
- +2 SET ORY=0
- +3 IF +ID
- Begin DoDot:1
- +4 SET NODE=$GET(^ORD(101.15,+ID,0))
- +5 IF NODE'=""
- IF $PIECE(NODE,U,3)'="I"
- SET ORY=ID_U_NODE
- End DoDot:1
- +6 QUIT
- GETOBJ(ORY,PARAM,ORIDX) ; Returns COM Object info
- +1 NEW SRV,ID
- +2 SET SRV=$$GET1^DIQ(200,DUZ,29,"I")
- +3 SET ID=$$GET^XPAR(DUZ_";VA(200,^SRV.`"_+$GET(SRV)_"^DIV^SYS",PARAM,ORIDX,"I")
- +4 DO DETAILS(.ORY,ID)
- +5 QUIT
- PTOBJ(ORY) ; Returns Patient COM Object
- +1 DO GETOBJ(.ORY,"ORWCOM PATIENT SELECTED",1)
- +2 QUIT
- ORDEROBJ(ORY,ORGRP) ; Returns Accept Order COM Object
- +1 DO GETOBJ(.ORY,"ORWCOM ORDER ACCEPTED",ORGRP)
- +2 QUIT
- GETOBJS(ORY) ; Returns list of all active COM objects
- +1 NEW I,J,IDX,NODE
- +2 SET I=""
- SET IDX=0
- +3 FOR
- SET I=$ORDER(^ORD(101.15,"B",I))
- if I=""
- QUIT
- Begin DoDot:1
- +4 SET J=$ORDER(^ORD(101.15,"B",I,0))
- if '+J
- QUIT
- +5 SET NODE=$GET(^ORD(101.15,J,0))
- +6 IF $PIECE(NODE,U,3)'="I"
- Begin DoDot:2
- +7 SET IDX=IDX+1
- +8 SET ORY(IDX)=J_U_NODE
- End DoDot:2
- End DoDot:1
- +9 QUIT