- 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 Mar 13, 2025@21:42:59 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
