CRHDDR ; CAIRO/CLC - RETRIEVE DNR ORDERS USING ORDER DIALOG ;4/23/08 13:06
;;1.0;CRHD;****;Jan 28, 2008;Build 19
;=================================================================
ENT(CRHDRTN,DFN,CRHDNRTT,CRHDDIV,CRHDMULT) ;
N CRHDSDAT,CRHDFND,CRHDRN,CRHDEXDT,CRHDEXN,X,Y
N CRHDSTS,CRHDDL,CRHDCT,CRHDFLG,CRHDIEN1,CRHDOI
K CRHDRTN
;CRHDMULT = 1,if multi active orders displayed
S CRHDMULT=+$G(CRHDMULT)
I '$G(CRHDRN) S CRHDRN=1
D DNRPARM(.CRHDNRTT,DUZ,.CRHDDIV)
S CRHDFLG=0
S CRHDSDAT=$$NOW^XLFDT
S CRHDEXDT=0,CRHDCT=0
F S CRHDEXDT=$O(^OR(100,"AC",DFN_";DPT(",CRHDEXDT)) Q:'CRHDEXDT!(CRHDFLG) D
.S CRHDEXN="" F S CRHDEXN=$O(^OR(100,"AC",DFN_";DPT(",CRHDEXDT,CRHDEXN)) Q:CRHDEXN=""!(CRHDFLG) D
..S CRHDOI=0
..F S CRHDOI=$O(^OR(100,CRHDEXN,.1,"B",CRHDOI)) Q:'CRHDOI!(CRHDFLG) D
...I $D(CRHDNRTT(+CRHDOI)) D DETAIL("CRHDRTN",CRHDEXN,.CRHDFLG,.CRHDCT,.CRHDMULT)
Q
;
DETAIL(CRHDY,CRHDIFN,CRHDFND,CRHDCNT,CRHDMDNR) ; -- Returns details of order CRHDIFN in CRHDY(#)
N CRHDMCNT,X,CRHDX2,CRHDI,CRHDILOG,CRHD0,CRHD3,CRHD6,CRHDSEQ,CRHDITEM,CRHDPRMT
N CRHDFIRT,CRHDTITL,CRHDINST,CRHDN,ORIGVIEW,ORFLG,CRHDII
N DIWL,DIWR,DIWF,CRHDACTI,VAIN,CRHDOVW,ORNMSP,CRHDYT,CRHDDNR,CRHDXX,CRHDNX
S CRHDIFN=+CRHDIFN,CRHD0=$G(^OR(100,CRHDIFN,0)),CRHD3=$G(^(3)),CRHD6=$G(^(6))
Q:$P(CRHD3,"^",3)'=6
K CRHDYT S CRHDOVW=1 D TEXT^CRHD8(.CRHDYT,+CRHDIFN_";"_+$P(CRHD3,U,7),254)
;CurrTx
I $D(CRHDYT) D
.I 'CRHDMDNR S CRHDFND=1
.S CRHDN=0
.;USE CRHDEXDT IN THE DATA NODE TO
.I $D(@CRHDY) S CRHDCNT=CRHDCNT+1,@CRHDY@(CRHDCNT)=""
.F CRHDII=1:1 S CRHDN=$O(CRHDYT(CRHDN)) Q:'CRHDN D
..S CRHDCNT=CRHDCNT+1
..I CRHDII=1 S @CRHDY@(CRHDCNT)=CRHDEXDT_"~"_CRHDIFN_"~"_CRHDYT(CRHDN)
..E S @CRHDY@(CRHDCNT)=CRHDYT(CRHDN)
Q
DNRPARM(CRHDNRTT,DUZ,CRHDDIV) ;GET DNR TITLES
N CRHDPAR,CRHDDIVI,CRHDDNRT
K CRHDNRTT
S CRHDDNRT=0
I '+$G(CRHDDIV) S CRHDDIV=+$$SITE^VASITE
S CRHDPAR="DIV.`"_+CRHDDIV D GETLST^XPAR(.CRHDDNRT,CRHDPAR,"CRHD DNR ORDERABLE ITEMS")
I 'CRHDDNRT D
.S CRHDDIVI=$O(^DIC(4,"D",CRHDDIV,0))
.I CRHDDIVI S CRHDPAR="DIV.`"_CRHDDIVI D GETLST^XPAR(.CRHDDNRT,CRHDPAR,"CRHD DNR ORDERABLE ITEMS")
I CRHDDNRT D
.S CRHDN=0 F S CRHDN=$O(CRHDDNRT(CRHDN)) Q:'CRHDN D
..S:$P($G(CRHDDNRT(CRHDN)),"^",2)'="" CRHDNRTT($P(CRHDDNRT(CRHDN),"^",2))=""
Q
LORDITM(CRHDY,CRHDFROM,CRHDDIR) ; Return a set of names from the ORDERABLE ITEMS file.
; copied from ORWU1
; .CRHDY=returned list.
; CRHDDIR=Direction to move through the x-ref with $O.
; CRHDFROM=Starting name for this set.
K CRHDRTN
N CRHDNAME,CRHDNUMB,CRHDIEN1,CRHDMAX
S CRHDI=0,CRHDMAX=44
F Q:CRHDI'<CRHDMAX S CRHDFROM=$O(^ORD(101.43,"B",CRHDFROM),CRHDDIR) Q:CRHDFROM="" D
.S CRHDIEN1=""
.F S CRHDIEN1=$O(^ORD(101.43,"B",CRHDFROM,CRHDIEN1),CRHDDIR) Q:'CRHDIEN1 D
..I $D(^ORD(101.43,CRHDIEN1,.1)),+$G(^ORD(101.43,CRHDIEN1,.1)) I +^ORD(101.43,CRHDIEN1,.1)<$$DT^XLFDT Q
..S CRHDI=CRHDI+1,CRHDY(CRHDI)=CRHDIEN1_"^"_CRHDFROM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HCRHDDR 2967 printed Dec 13, 2024@02:37:57 Page 2
CRHDDR ; CAIRO/CLC - RETRIEVE DNR ORDERS USING ORDER DIALOG ;4/23/08 13:06
+1 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
+2 ;=================================================================
ENT(CRHDRTN,DFN,CRHDNRTT,CRHDDIV,CRHDMULT) ;
+1 NEW CRHDSDAT,CRHDFND,CRHDRN,CRHDEXDT,CRHDEXN,X,Y
+2 NEW CRHDSTS,CRHDDL,CRHDCT,CRHDFLG,CRHDIEN1,CRHDOI
+3 KILL CRHDRTN
+4 ;CRHDMULT = 1,if multi active orders displayed
+5 SET CRHDMULT=+$GET(CRHDMULT)
+6 IF '$GET(CRHDRN)
SET CRHDRN=1
+7 DO DNRPARM(.CRHDNRTT,DUZ,.CRHDDIV)
+8 SET CRHDFLG=0
+9 SET CRHDSDAT=$$NOW^XLFDT
+10 SET CRHDEXDT=0
SET CRHDCT=0
+11 FOR
SET CRHDEXDT=$ORDER(^OR(100,"AC",DFN_";DPT(",CRHDEXDT))
if 'CRHDEXDT!(CRHDFLG)
QUIT
Begin DoDot:1
+12 SET CRHDEXN=""
FOR
SET CRHDEXN=$ORDER(^OR(100,"AC",DFN_";DPT(",CRHDEXDT,CRHDEXN))
if CRHDEXN=""!(CRHDFLG)
QUIT
Begin DoDot:2
+13 SET CRHDOI=0
+14 FOR
SET CRHDOI=$ORDER(^OR(100,CRHDEXN,.1,"B",CRHDOI))
if 'CRHDOI!(CRHDFLG)
QUIT
Begin DoDot:3
+15 IF $DATA(CRHDNRTT(+CRHDOI))
DO DETAIL("CRHDRTN",CRHDEXN,.CRHDFLG,.CRHDCT,.CRHDMULT)
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
DETAIL(CRHDY,CRHDIFN,CRHDFND,CRHDCNT,CRHDMDNR) ; -- Returns details of order CRHDIFN in CRHDY(#)
+1 NEW CRHDMCNT,X,CRHDX2,CRHDI,CRHDILOG,CRHD0,CRHD3,CRHD6,CRHDSEQ,CRHDITEM,CRHDPRMT
+2 NEW CRHDFIRT,CRHDTITL,CRHDINST,CRHDN,ORIGVIEW,ORFLG,CRHDII
+3 NEW DIWL,DIWR,DIWF,CRHDACTI,VAIN,CRHDOVW,ORNMSP,CRHDYT,CRHDDNR,CRHDXX,CRHDNX
+4 SET CRHDIFN=+CRHDIFN
SET CRHD0=$GET(^OR(100,CRHDIFN,0))
SET CRHD3=$GET(^(3))
SET CRHD6=$GET(^(6))
+5 if $PIECE(CRHD3,"^",3)'=6
QUIT
+6 KILL CRHDYT
SET CRHDOVW=1
DO TEXT^CRHD8(.CRHDYT,+CRHDIFN_";"_+$PIECE(CRHD3,U,7),254)
+7 ;CurrTx
+8 IF $DATA(CRHDYT)
Begin DoDot:1
+9 IF 'CRHDMDNR
SET CRHDFND=1
+10 SET CRHDN=0
+11 ;USE CRHDEXDT IN THE DATA NODE TO
+12 IF $DATA(@CRHDY)
SET CRHDCNT=CRHDCNT+1
SET @CRHDY@(CRHDCNT)=""
+13 FOR CRHDII=1:1
SET CRHDN=$ORDER(CRHDYT(CRHDN))
if 'CRHDN
QUIT
Begin DoDot:2
+14 SET CRHDCNT=CRHDCNT+1
+15 IF CRHDII=1
SET @CRHDY@(CRHDCNT)=CRHDEXDT_"~"_CRHDIFN_"~"_CRHDYT(CRHDN)
+16 IF '$TEST
SET @CRHDY@(CRHDCNT)=CRHDYT(CRHDN)
End DoDot:2
End DoDot:1
+17 QUIT
DNRPARM(CRHDNRTT,DUZ,CRHDDIV) ;GET DNR TITLES
+1 NEW CRHDPAR,CRHDDIVI,CRHDDNRT
+2 KILL CRHDNRTT
+3 SET CRHDDNRT=0
+4 IF '+$GET(CRHDDIV)
SET CRHDDIV=+$$SITE^VASITE
+5 SET CRHDPAR="DIV.`"_+CRHDDIV
DO GETLST^XPAR(.CRHDDNRT,CRHDPAR,"CRHD DNR ORDERABLE ITEMS")
+6 IF 'CRHDDNRT
Begin DoDot:1
+7 SET CRHDDIVI=$ORDER(^DIC(4,"D",CRHDDIV,0))
+8 IF CRHDDIVI
SET CRHDPAR="DIV.`"_CRHDDIVI
DO GETLST^XPAR(.CRHDDNRT,CRHDPAR,"CRHD DNR ORDERABLE ITEMS")
End DoDot:1
+9 IF CRHDDNRT
Begin DoDot:1
+10 SET CRHDN=0
FOR
SET CRHDN=$ORDER(CRHDDNRT(CRHDN))
if 'CRHDN
QUIT
Begin DoDot:2
+11 if $PIECE($GET(CRHDDNRT(CRHDN)),"^",2)'=""
SET CRHDNRTT($PIECE(CRHDDNRT(CRHDN),"^",2))=""
End DoDot:2
End DoDot:1
+12 QUIT
LORDITM(CRHDY,CRHDFROM,CRHDDIR) ; Return a set of names from the ORDERABLE ITEMS file.
+1 ; copied from ORWU1
+2 ; .CRHDY=returned list.
+3 ; CRHDDIR=Direction to move through the x-ref with $O.
+4 ; CRHDFROM=Starting name for this set.
+5 KILL CRHDRTN
+6 NEW CRHDNAME,CRHDNUMB,CRHDIEN1,CRHDMAX
+7 SET CRHDI=0
SET CRHDMAX=44
+8 FOR
if CRHDI'<CRHDMAX
QUIT
SET CRHDFROM=$ORDER(^ORD(101.43,"B",CRHDFROM),CRHDDIR)
if CRHDFROM=""
QUIT
Begin DoDot:1
+9 SET CRHDIEN1=""
+10 FOR
SET CRHDIEN1=$ORDER(^ORD(101.43,"B",CRHDFROM,CRHDIEN1),CRHDDIR)
if 'CRHDIEN1
QUIT
Begin DoDot:2
+11 IF $DATA(^ORD(101.43,CRHDIEN1,.1))
IF +$GET(^ORD(101.43,CRHDIEN1,.1))
IF +^ORD(101.43,CRHDIEN1,.1)<$$DT^XLFDT
QUIT
+12 SET CRHDI=CRHDI+1
SET CRHDY(CRHDI)=CRHDIEN1_"^"_CRHDFROM
End DoDot:2
End DoDot:1
+13 QUIT
