ORWRP3 ;SLC/DCM - OE/RR REPORT EXTRACT RPCS ;03/17/2015 10:24
;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,120,132,215,243,350**;Dec 17, 1997;Build 77
;
; DBIA 4011 Access ^XWB(8994)
;
EX(ROOT,TST) ;Expand columns
;TST=ptr to file 101.24
;Y(i)=id^Name^Qualifier^IOM^Entry^Routine^Remote^Type^Category^RPC^ifn^sort_order^max_days^direct^hdr^fhie
Q:'$G(TST)
N J,X,X0,X1,X2,X4,RPC,HEAD,ORX0,ORX2,ORX4,ORX,ORTIMOCC,MAX
I '$L($G(C)) S C=0
S ORTIMOCC=$$GET^XPAR("USR.`"_DUZ_"^SYS^PKG","ORWRP TIME/OCC LIMITS INDV",+TST,"I")
I '$L(ORTIMOCC) S ORTIMOCC=$$GET^XPAR("USR.`"_DUZ_"^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
S X0=$G(^ORD(101.24,+TST,0)),X2=$G(^(2)),X4=$G(^(4)),MAX=$P(X4,"^",2),X=$P($P(ORTIMOCC,";"),"-",2)
I $P(X4,"^",10) Q
I X,MAX,X>MAX S ORTIMOCC="T-"_MAX_";"_$P(ORTIMOCC,";",2,99)
I '$L(ORTIMOCC) S ORTIMOCC=";;"
I '$O(^ORD(101.24,+TST,10,0)) D Q
. Q:$P(X0,"^",12)="L"
. S RPC=$P($G(^XWB(8994,+$P(X0,"^",13),0)),"^") ;DBIA 4011
. S HEAD=$P(X0,"^")
. I $L($P(X2,"^",3)) S HEAD=$P(X2,"^",3)
. S X1=$P(X0,U,2)_U_HEAD_U_ORTIMOCC_";"_$P(X0,U,4)_U_$P(X0,U,19)_";"_$P(X0,U,20)_";"
. S X=X1_+$P(X0,U,21)_U_$P(X0,U,6)_U_$P(X0,U,5)_U_$P(X0,U,3)_U_$P(X0,U,12)_U_$P(X0,U,7)_U_RPC_U_+TST_U_$P(X4,U)_U_$P(X4,U,2)_U_$P(X4,U,4)_U_$P(X4,U,5)_U_$P(X4,U,8)_U_$P(X4,U,9)
. D SETITEM(.ROOT,X)
I $O(^ORD(101.24,+TST,10,0)) S ORX0=^ORD(101.24,+TST,0),ORX2=$G(^(2)),ORX4=$G(^(4)) D
. I $P(ORX4,"^",10) Q
. S RPC=$P($G(^XWB(8994,+$P(X0,"^",13),0)),"^") ;DBIA 4011
. S X=ORX0,HEAD=$P(X,"^")
. I $L($P(ORX2,"^",3)) S HEAD=$P(ORX2,"^",3)
. S X1=$P(X,U,2)_U_HEAD_U_ORTIMOCC_";"_$P(X,U,4)_U_$P(X,U,19)_";"_$P(X,U,20)_";"
. S ORX=X1_+$P(X,U,21)_U_$P(X,U,6)_U_$P(X,U,5)_U_$P(X,U,3)_U_$P(X,U,12)_U_$P(X,U,7)_U_RPC_U_+TST_U_$P(ORX4,U)_U_$P(ORX4,U,2)_U_$P(ORX4,U,4)_U_$P(ORX4,U,5)_U_$P(ORX4,U,8)_U_$P(X4,U,9)
. D SETITEM(.ROOT,"[PARENT START]^"_ORX)
. S J=0 F S J=$O(^ORD(101.24,+TST,10,J)) Q:J<1 S X=^(J,0) D EX(.ROOT,+X)
. D SETITEM(.ROOT,"[PARENT END]^"_ORX)
Q
LIST(LST,TAB) ;Get list for Reports & Labs Tab Treeview
N ROOT
S ROOT=$NA(LST)
K @ROOT
D TRY1(.ROOT,$G(TAB))
Q
TRY1(ROOT,TAB) ;Test expanding reports using established parameters
N I,ORLIST,ORENT,ORDEF,ORJUNK,ORNLIST,C
D SETITEM(.ROOT,"[REPORT LIST]")
D GETLST^XPAR(.ORLIST,"ALL",$S($G(TAB)="LABS":"ORWRP REPORT LAB LIST",1:"ORWRP REPORT LIST"))
I $G(TAB)="LABS" D
. S ORENT="ALL^"_$G(ORL)_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
. S ORDEF=$$GET^XPAR(ORENT,"OR LAB TAB DEFAULT REPORT") Q:ORDEF'>0
. S I=0,ORJUNK=0 F S I=$O(ORLIST(I)) Q:'I I $P(ORLIST(I),"^",2)=ORDEF S ORJUNK=I Q
. S I=0,C=1,ORNLIST(1)="1^"_ORDEF F S I=$O(ORLIST(I)) Q:'I I I'=ORJUNK S C=C+1,ORNLIST(C)=ORLIST(I)
. K ORLIST M ORLIST=ORNLIST
S I=0
F S I=$O(ORLIST(I)) Q:'I Q:'$D(^ORD(101.24,$P(ORLIST(I),"^",2),0)) D EX(.ROOT,$P(ORLIST(I),"^",2))
D SETITEM(.ROOT,"$$END")
Q
SETITEM(ROOT,X) ; -- set item in list
S @ROOT@($O(@ROOT@(9999),-1)+1)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWRP3 3024 printed Dec 13, 2024@02:37:20 Page 2
ORWRP3 ;SLC/DCM - OE/RR REPORT EXTRACT RPCS ;03/17/2015 10:24
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,120,132,215,243,350**;Dec 17, 1997;Build 77
+2 ;
+3 ; DBIA 4011 Access ^XWB(8994)
+4 ;
EX(ROOT,TST) ;Expand columns
+1 ;TST=ptr to file 101.24
+2 ;Y(i)=id^Name^Qualifier^IOM^Entry^Routine^Remote^Type^Category^RPC^ifn^sort_order^max_days^direct^hdr^fhie
+3 if '$GET(TST)
QUIT
+4 NEW J,X,X0,X1,X2,X4,RPC,HEAD,ORX0,ORX2,ORX4,ORX,ORTIMOCC,MAX
+5 IF '$LENGTH($GET(C))
SET C=0
+6 SET ORTIMOCC=$$GET^XPAR("USR.`"_DUZ_"^SYS^PKG","ORWRP TIME/OCC LIMITS INDV",+TST,"I")
+7 IF '$LENGTH(ORTIMOCC)
SET ORTIMOCC=$$GET^XPAR("USR.`"_DUZ_"^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
+8 SET X0=$GET(^ORD(101.24,+TST,0))
SET X2=$GET(^(2))
SET X4=$GET(^(4))
SET MAX=$PIECE(X4,"^",2)
SET X=$PIECE($PIECE(ORTIMOCC,";"),"-",2)
+9 IF $PIECE(X4,"^",10)
QUIT
+10 IF X
IF MAX
IF X>MAX
SET ORTIMOCC="T-"_MAX_";"_$PIECE(ORTIMOCC,";",2,99)
+11 IF '$LENGTH(ORTIMOCC)
SET ORTIMOCC=";;"
+12 IF '$ORDER(^ORD(101.24,+TST,10,0))
Begin DoDot:1
+13 if $PIECE(X0,"^",12)="L"
QUIT
+14 ;DBIA 4011
SET RPC=$PIECE($GET(^XWB(8994,+$PIECE(X0,"^",13),0)),"^")
+15 SET HEAD=$PIECE(X0,"^")
+16 IF $LENGTH($PIECE(X2,"^",3))
SET HEAD=$PIECE(X2,"^",3)
+17 SET X1=$PIECE(X0,U,2)_U_HEAD_U_ORTIMOCC_";"_$PIECE(X0,U,4)_U_$PIECE(X0,U,19)_";"_$PIECE(X0,U,20)_";"
+18 SET X=X1_+$PIECE(X0,U,21)_U_$PIECE(X0,U,6)_U_$PIECE(X0,U,5)_U_$PIECE(X0,U,3)_U_$PIECE(X0,U,12)_U_$PIECE(X0,U,7)_U_RPC_U_+TST_U_$PIECE(X4,U)_U_$PIECE(X4,U,2)_U_$PIECE(X4,U,4)_U_$PIECE(X4,U,5)_U_$PIECE(X4,U,8)_U_$PIECE(X4,U,9)
+19 DO SETITEM(.ROOT,X)
End DoDot:1
QUIT
+20 IF $ORDER(^ORD(101.24,+TST,10,0))
SET ORX0=^ORD(101.24,+TST,0)
SET ORX2=$GET(^(2))
SET ORX4=$GET(^(4))
Begin DoDot:1
+21 IF $PIECE(ORX4,"^",10)
QUIT
+22 ;DBIA 4011
SET RPC=$PIECE($GET(^XWB(8994,+$PIECE(X0,"^",13),0)),"^")
+23 SET X=ORX0
SET HEAD=$PIECE(X,"^")
+24 IF $LENGTH($PIECE(ORX2,"^",3))
SET HEAD=$PIECE(ORX2,"^",3)
+25 SET X1=$PIECE(X,U,2)_U_HEAD_U_ORTIMOCC_";"_$PIECE(X,U,4)_U_$PIECE(X,U,19)_";"_$PIECE(X,U,20)_";"
+26 SET ORX=X1_+$PIECE(X,U,21)_U_$PIECE(X,U,6)_U_$PIECE(X,U,5)_U_$PIECE(X,U,3)_U_$PIECE(X,U,12)_U_$PIECE(X,U,7)_U_RPC_U_+TST_U_$PIECE(ORX4,U)_U_$PIECE(ORX4,U,2)_U_$PIECE(ORX4,U,4)_U_$PIECE(ORX4,U,5)_U_$PIECE(ORX4,U,8)_U_$PIECE(X4,U,9)
+27 DO SETITEM(.ROOT,"[PARENT START]^"_ORX)
+28 SET J=0
FOR
SET J=$ORDER(^ORD(101.24,+TST,10,J))
if J<1
QUIT
SET X=^(J,0)
DO EX(.ROOT,+X)
+29 DO SETITEM(.ROOT,"[PARENT END]^"_ORX)
End DoDot:1
+30 QUIT
LIST(LST,TAB) ;Get list for Reports & Labs Tab Treeview
+1 NEW ROOT
+2 SET ROOT=$NAME(LST)
+3 KILL @ROOT
+4 DO TRY1(.ROOT,$GET(TAB))
+5 QUIT
TRY1(ROOT,TAB) ;Test expanding reports using established parameters
+1 NEW I,ORLIST,ORENT,ORDEF,ORJUNK,ORNLIST,C
+2 DO SETITEM(.ROOT,"[REPORT LIST]")
+3 DO GETLST^XPAR(.ORLIST,"ALL",$SELECT($GET(TAB)="LABS":"ORWRP REPORT LAB LIST",1:"ORWRP REPORT LIST"))
+4 IF $GET(TAB)="LABS"
Begin DoDot:1
+5 SET ORENT="ALL^"_$GET(ORL)_$SELECT($GET(^VA(200,DUZ,5)):"^SRV.`"_+$GET(^(5)),1:"")
+6 SET ORDEF=$$GET^XPAR(ORENT,"OR LAB TAB DEFAULT REPORT")
if ORDEF'>0
QUIT
+7 SET I=0
SET ORJUNK=0
FOR
SET I=$ORDER(ORLIST(I))
if 'I
QUIT
IF $PIECE(ORLIST(I),"^",2)=ORDEF
SET ORJUNK=I
QUIT
+8 SET I=0
SET C=1
SET ORNLIST(1)="1^"_ORDEF
FOR
SET I=$ORDER(ORLIST(I))
if 'I
QUIT
IF I'=ORJUNK
SET C=C+1
SET ORNLIST(C)=ORLIST(I)
+9 KILL ORLIST
MERGE ORLIST=ORNLIST
End DoDot:1
+10 SET I=0
+11 FOR
SET I=$ORDER(ORLIST(I))
if 'I
QUIT
if '$DATA(^ORD(101.24,$PIECE(ORLIST(I),"^",2),0))
QUIT
DO EX(.ROOT,$PIECE(ORLIST(I),"^",2))
+12 DO SETITEM(.ROOT,"$$END")
+13 QUIT
SETITEM(ROOT,X) ; -- set item in list
+1 SET @ROOT@($ORDER(@ROOT@(9999),-1)+1)=X
+2 QUIT
