CRHDDNR ; CAIRO/CLC - GET ACTIVE DNR ORDER ;4/23/08 07:48
;;1.0;CRHD;**2**;Jan 28, 2008;Build 11
;=================================================================
;
; 10/05/2009 KAM CRHD*1*2 Modifications to better handle Free Text
; DNR searches
;
ENT(CRHDRTN,DFN,CRHDNRTT,CRHDDIV,CRHDMULT) ;
K CRHDRTN
N CRHDRN S CRHDRN=1
S CRHDMULT=$G(CRHDMULT)
D DNRPARM(.CRHDNRTT,DUZ,.CRHDDIV)
I 'CRHDNRTT S CRHDNRTT(1)="^DNR ORDER"
N CRHDFILE,CRHDSDAT,CRHDFND,CRHDTMP,CRHDEXDT,CRHDBY,CRHDDI
N CRHDOI,CRHDEXN,X,Y,CRHDBDNR
N CRHDDDNR,CRHDBI,CRHDFLG,CRHDZ,CRHDCNT,CRHDZCT,CRHDZZOR
S (CRHDFLG,CRHDZCT)=0,CRHDCNT=1
S CRHDFILE=$$TERMLKUP^ORB31(.CRHDBY,"DNR")
S CRHDSDAT=$$NOW^XLFDT
;S CRHDEXDT=9999999.999999-CRHDSDAT
S CRHDEXDT=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
..I $D(CRHDBY),(+$G(CRHDFILE)=101.43) D
...F CRHDBI=1:1:CRHDBY D
....S CRHDBDNR=$P(CRHDBY(CRHDBI),U)
....S CRHDOI=$$OI^ORQOR2(CRHDEXN)
....I CRHDBDNR=CRHDOI D
.....D DETAIL("CRHDRTN",CRHDEXN,.CRHDFLG,.CRHDCNT,CRHDMULT) ;,WRT("STMP")
..;I '$$OI^ORQOR2(CRHDEXN)&('CRHDFLG) D
..I 'CRHDFLG D
...D DETAIL("CRHDRTN",CRHDEXN,.CRHDFLG,.CRHDCNT,CRHDMULT) ;,WRT("TMP")
I '$D(CRHDRTN) S CRHDRTN(1)=""
E S CRHDRTN(1)=$G(CRHDCNT)
Q
DETAIL(CRHDY,CRHDIFN,CRHDFND,CRHDCNT,CRHDMDNR) ; -- Returns details of order CRHDIFN in CRHDY(#)
N CRHDMCNT,X,X2,I,CRHDILOG,CRHD0,CRHD3,CRHD6,CRHDSEQ,CRHDITEM,CRHDPRMT,CRHDMULT,CRHDFIRT,CRHDTITL,CRHDINST
N DIWL,DIWR,DIWF,CRHDACTI,CRHDII,VAIN,ORIGVIEW,CRHDNMSP,CRHDYT,CRHDDNR,CRHDXX,CRHDNX,CRHDGOTI,ORFLG
S CRHDIFN=+CRHDIFN,CRHD0=$G(^OR(100,CRHDIFN,0)),CRHD3=$G(^(3)),CRHD6=$G(^(6))
K CRHDYT S ORIGVIEW=1 D TEXT^CRHD8(.CRHDYT,+CRHDIFN_";"_+$P(CRHD3,U,7),254) ;CurrTx
; 10/05/2009 KAM CRHD*1*2 Changed next line to look at all order text lines (Added the For loop)
I $D(CRHDYT) S CRHDDNR=0 F S CRHDDNR=$O(CRHDYT(CRHDDNR)) Q:CRHDDNR="" D
.Q:$D(CRHDZZOR(CRHDIFN))
.; 10/05/2009 KAM CRHD*1*2 Commented out the next line so CRHD will look at the entire order text
.;S CRHDDNR=0,CRHDDNR=$O(CRHDYT(CRHDDNR))
.S CRHDGOTI=0
.S CRHDXX="" F S CRHDXX=$O(CRHDNRTT(CRHDXX)) Q:CRHDXX=""!(CRHDGOTI)!(CRHDFND) D ;S NX=0 F S NX=$O(CRHDNRTT(XX,NX)) Q:'NX!(CRHDFND) D ; KAM DID NOT COMMENT THIS LINE
..;
..; 10/05/2009 KAM CRHD*1*2 Added $$TRNSLT calls to next line so searches would no longer be case sensitive
..; 07/22/2010 KAM CRHD*1*2 Commented next line and modified compare
..;I ($$TRNSLT($G(CRHDYT(CRHDDNR)))'[$$TRNSLT($P(CRHDNRTT(CRHDXX),"^",2)))&($$TRNSLT($P(CRHDNRTT(CRHDXX),"^",2))'[$$TRNSLT(CRHDYT(CRHDDNR))) Q
.. I $$TRNSLT($G(CRHDYT(CRHDDNR)))'[$$TRNSLT($P(CRHDNRTT(CRHDXX),"^",2)) Q ;CRHD*1*2
..;
..S CRHDZCT=$G(CRHDZCT)+1,CRHDGOTI=1
..I 'CRHDMDNR S CRHDFND=1
..I CRHDCNT>1 S CRHDCNT=CRHDCNT+1,@CRHDY@(CRHDCNT)=""
..S CRHDMCNT=0 F CRHDII=1:1 S CRHDMCNT=$O(CRHDYT(CRHDMCNT)) Q:'CRHDMCNT S CRHDCNT=CRHDCNT+1 D
...I CRHDII=1 S @CRHDY@(CRHDCNT)=CRHDEXDT_"~"_CRHDIFN_"~"_CRHDYT(CRHDMCNT)
...E S @CRHDY@(CRHDCNT)=CRHDYT(CRHDMCNT)
..S CRHDCNT=$G(CRHDCNT)+1
..S @CRHDY@(CRHDCNT)="Start Date/Time: "_$S($P(CRHD0,U,8):$$DATE^ORQ20($P(CRHD0,U,8)),1:"")
..I $P(CRHD3,U,5),$P(CRHD3,U,11)=2 S X=$$ORIG(CRHDIFN),@CRHDY@(CRHDCNT)=@CRHDY@(CRHDCNT)_" (originally "_$$DATE^ORQ20(X)_")"
..S CRHDCNT=CRHDCNT+1
..S:+$P(CRHD0,U,9) @CRHDY@(CRHDCNT)="Stop Date/Time: "_$S($P(CRHD0,U,9):$$DATE^ORQ20($P(CRHD0,U,9)),1:"")
..S CRHDZZOR(CRHDIFN)=""
Q
WRT(CRHDC,CRHDARRY,CRHDTRG) ;
Q:'$D(CRHDARRY)
N CRHDN
S CRHDN=0 F S CRHDN=$O(CRHDARRY(CRHDN)) Q:'CRHDN S CRHDC=$G(CRHDC)+1,@CRHDTRG@(CRHDC,0)=CRHDARRY(CRHDN)
Q
ORIG(CRHDIFN) ; -- Return original start date of [renewal] order
N CRHDI,CRHDY,CRHDX3,CRHDDONE
S CRHDI=CRHDIFN,CRHDY=$P($G(^OR(100,CRHDIFN,0)),U,8),CRHDDONE=0
F S CRHDX3=$G(^OR(100,CRHDI,3)) D Q:CRHDDONE
. I $P(CRHDX3,U,11)=2,$P(CRHDX3,U,5) S CRHDI=$P(CRHDX3,U,5) Q ;loop
. S CRHDY=$P($G(^OR(100,CRHDI,0)),U,8),CRHDDONE=1
Q CRHDY
DNRPARM(CRHDNRTT,DUZ,CRHDDIV) ;GET DNR TITLES
N CRHDPAR,CRHDDIVI
S CRHDNRTT=0
I '+$G(CRHDDIV) S CRHDDIV=+$$SITE^VASITE
I 'CRHDNRTT S CRHDPAR="DIV.`"_+CRHDDIV D GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
I 'CRHDNRTT D
.S CRHDDIVI=$O(^DIC(4,"D",CRHDDIV,0))
.I CRHDDIVI S CRHDPAR="DIV.`"_CRHDDIVI D GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
Q
TRNSLT(CRHDINPT) ; 10/05/2009 KAM CRHD*1*2 Added to eliminate case sensitivity
Q $TR(CRHDINPT,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HCRHDDNR 4671 printed Dec 13, 2024@02:37:56 Page 2
CRHDDNR ; CAIRO/CLC - GET ACTIVE DNR ORDER ;4/23/08 07:48
+1 ;;1.0;CRHD;**2**;Jan 28, 2008;Build 11
+2 ;=================================================================
+3 ;
+4 ; 10/05/2009 KAM CRHD*1*2 Modifications to better handle Free Text
+5 ; DNR searches
+6 ;
ENT(CRHDRTN,DFN,CRHDNRTT,CRHDDIV,CRHDMULT) ;
+1 KILL CRHDRTN
+2 NEW CRHDRN
SET CRHDRN=1
+3 SET CRHDMULT=$GET(CRHDMULT)
+4 DO DNRPARM(.CRHDNRTT,DUZ,.CRHDDIV)
+5 IF 'CRHDNRTT
SET CRHDNRTT(1)="^DNR ORDER"
+6 NEW CRHDFILE,CRHDSDAT,CRHDFND,CRHDTMP,CRHDEXDT,CRHDBY,CRHDDI
+7 NEW CRHDOI,CRHDEXN,X,Y,CRHDBDNR
+8 NEW CRHDDDNR,CRHDBI,CRHDFLG,CRHDZ,CRHDCNT,CRHDZCT,CRHDZZOR
+9 SET (CRHDFLG,CRHDZCT)=0
SET CRHDCNT=1
+10 SET CRHDFILE=$$TERMLKUP^ORB31(.CRHDBY,"DNR")
+11 SET CRHDSDAT=$$NOW^XLFDT
+12 ;S CRHDEXDT=9999999.999999-CRHDSDAT
+13 SET CRHDEXDT=0
+14 FOR
SET CRHDEXDT=$ORDER(^OR(100,"AC",DFN_";DPT(",CRHDEXDT))
if 'CRHDEXDT!(CRHDFLG)
QUIT
Begin DoDot:1
+15 SET CRHDEXN=""
FOR
SET CRHDEXN=$ORDER(^OR(100,"AC",DFN_";DPT(",CRHDEXDT,CRHDEXN))
if CRHDEXN=""!(CRHDFLG)
QUIT
Begin DoDot:2
+16 IF $DATA(CRHDBY)
IF (+$GET(CRHDFILE)=101.43)
Begin DoDot:3
+17 FOR CRHDBI=1:1:CRHDBY
Begin DoDot:4
+18 SET CRHDBDNR=$PIECE(CRHDBY(CRHDBI),U)
+19 SET CRHDOI=$$OI^ORQOR2(CRHDEXN)
+20 IF CRHDBDNR=CRHDOI
Begin DoDot:5
+21 ;,WRT("STMP")
DO DETAIL("CRHDRTN",CRHDEXN,.CRHDFLG,.CRHDCNT,CRHDMULT)
End DoDot:5
End DoDot:4
End DoDot:3
+22 ;I '$$OI^ORQOR2(CRHDEXN)&('CRHDFLG) D
+23 IF 'CRHDFLG
Begin DoDot:3
+24 ;,WRT("TMP")
DO DETAIL("CRHDRTN",CRHDEXN,.CRHDFLG,.CRHDCNT,CRHDMULT)
End DoDot:3
End DoDot:2
End DoDot:1
+25 IF '$DATA(CRHDRTN)
SET CRHDRTN(1)=""
+26 IF '$TEST
SET CRHDRTN(1)=$GET(CRHDCNT)
+27 QUIT
DETAIL(CRHDY,CRHDIFN,CRHDFND,CRHDCNT,CRHDMDNR) ; -- Returns details of order CRHDIFN in CRHDY(#)
+1 NEW CRHDMCNT,X,X2,I,CRHDILOG,CRHD0,CRHD3,CRHD6,CRHDSEQ,CRHDITEM,CRHDPRMT,CRHDMULT,CRHDFIRT,CRHDTITL,CRHDINST
+2 NEW DIWL,DIWR,DIWF,CRHDACTI,CRHDII,VAIN,ORIGVIEW,CRHDNMSP,CRHDYT,CRHDDNR,CRHDXX,CRHDNX,CRHDGOTI,ORFLG
+3 SET CRHDIFN=+CRHDIFN
SET CRHD0=$GET(^OR(100,CRHDIFN,0))
SET CRHD3=$GET(^(3))
SET CRHD6=$GET(^(6))
+4 ;CurrTx
KILL CRHDYT
SET ORIGVIEW=1
DO TEXT^CRHD8(.CRHDYT,+CRHDIFN_";"_+$PIECE(CRHD3,U,7),254)
+5 ; 10/05/2009 KAM CRHD*1*2 Changed next line to look at all order text lines (Added the For loop)
+6 IF $DATA(CRHDYT)
SET CRHDDNR=0
FOR
SET CRHDDNR=$ORDER(CRHDYT(CRHDDNR))
if CRHDDNR=""
QUIT
Begin DoDot:1
+7 if $DATA(CRHDZZOR(CRHDIFN))
QUIT
+8 ; 10/05/2009 KAM CRHD*1*2 Commented out the next line so CRHD will look at the entire order text
+9 ;S CRHDDNR=0,CRHDDNR=$O(CRHDYT(CRHDDNR))
+10 SET CRHDGOTI=0
+11 ;S NX=0 F S NX=$O(CRHDNRTT(XX,NX)) Q:'NX!(CRHDFND) D ; KAM DID NOT COMMENT THIS LINE
SET CRHDXX=""
FOR
SET CRHDXX=$ORDER(CRHDNRTT(CRHDXX))
if CRHDXX=""!(CRHDGOTI)!(CRHDFND)
QUIT
Begin DoDot:2
+12 ;
+13 ; 10/05/2009 KAM CRHD*1*2 Added $$TRNSLT calls to next line so searches would no longer be case sensitive
+14 ; 07/22/2010 KAM CRHD*1*2 Commented next line and modified compare
+15 ;I ($$TRNSLT($G(CRHDYT(CRHDDNR)))'[$$TRNSLT($P(CRHDNRTT(CRHDXX),"^",2)))&($$TRNSLT($P(CRHDNRTT(CRHDXX),"^",2))'[$$TRNSLT(CRHDYT(CRHDDNR))) Q
+16 ;CRHD*1*2
IF $$TRNSLT($GET(CRHDYT(CRHDDNR)))'[$$TRNSLT($PIECE(CRHDNRTT(CRHDXX),"^",2))
QUIT
+17 ;
+18 SET CRHDZCT=$GET(CRHDZCT)+1
SET CRHDGOTI=1
+19 IF 'CRHDMDNR
SET CRHDFND=1
+20 IF CRHDCNT>1
SET CRHDCNT=CRHDCNT+1
SET @CRHDY@(CRHDCNT)=""
+21 SET CRHDMCNT=0
FOR CRHDII=1:1
SET CRHDMCNT=$ORDER(CRHDYT(CRHDMCNT))
if 'CRHDMCNT
QUIT
SET CRHDCNT=CRHDCNT+1
Begin DoDot:3
+22 IF CRHDII=1
SET @CRHDY@(CRHDCNT)=CRHDEXDT_"~"_CRHDIFN_"~"_CRHDYT(CRHDMCNT)
+23 IF '$TEST
SET @CRHDY@(CRHDCNT)=CRHDYT(CRHDMCNT)
End DoDot:3
+24 SET CRHDCNT=$GET(CRHDCNT)+1
+25 SET @CRHDY@(CRHDCNT)="Start Date/Time: "_$SELECT($PIECE(CRHD0,U,8):$$DATE^ORQ20($PIECE(CRHD0,U,8)),1:"")
+26 IF $PIECE(CRHD3,U,5)
IF $PIECE(CRHD3,U,11)=2
SET X=$$ORIG(CRHDIFN)
SET @CRHDY@(CRHDCNT)=@CRHDY@(CRHDCNT)_" (originally "_$$DATE^ORQ20(X)_")"
+27 SET CRHDCNT=CRHDCNT+1
+28 if +$PIECE(CRHD0,U,9)
SET @CRHDY@(CRHDCNT)="Stop Date/Time: "_$SELECT($PIECE(CRHD0,U,9):$$DATE^ORQ20($PIECE(CRHD0,U,9)),1:"")
+29 SET CRHDZZOR(CRHDIFN)=""
End DoDot:2
End DoDot:1
+30 QUIT
WRT(CRHDC,CRHDARRY,CRHDTRG) ;
+1 if '$DATA(CRHDARRY)
QUIT
+2 NEW CRHDN
+3 SET CRHDN=0
FOR
SET CRHDN=$ORDER(CRHDARRY(CRHDN))
if 'CRHDN
QUIT
SET CRHDC=$GET(CRHDC)+1
SET @CRHDTRG@(CRHDC,0)=CRHDARRY(CRHDN)
+4 QUIT
ORIG(CRHDIFN) ; -- Return original start date of [renewal] order
+1 NEW CRHDI,CRHDY,CRHDX3,CRHDDONE
+2 SET CRHDI=CRHDIFN
SET CRHDY=$PIECE($GET(^OR(100,CRHDIFN,0)),U,8)
SET CRHDDONE=0
+3 FOR
SET CRHDX3=$GET(^OR(100,CRHDI,3))
Begin DoDot:1
+4 ;loop
IF $PIECE(CRHDX3,U,11)=2
IF $PIECE(CRHDX3,U,5)
SET CRHDI=$PIECE(CRHDX3,U,5)
QUIT
+5 SET CRHDY=$PIECE($GET(^OR(100,CRHDI,0)),U,8)
SET CRHDDONE=1
End DoDot:1
if CRHDDONE
QUIT
+6 QUIT CRHDY
DNRPARM(CRHDNRTT,DUZ,CRHDDIV) ;GET DNR TITLES
+1 NEW CRHDPAR,CRHDDIVI
+2 SET CRHDNRTT=0
+3 IF '+$GET(CRHDDIV)
SET CRHDDIV=+$$SITE^VASITE
+4 IF 'CRHDNRTT
SET CRHDPAR="DIV.`"_+CRHDDIV
DO GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
+5 IF 'CRHDNRTT
Begin DoDot:1
+6 SET CRHDDIVI=$ORDER(^DIC(4,"D",CRHDDIV,0))
+7 IF CRHDDIVI
SET CRHDPAR="DIV.`"_CRHDDIVI
DO GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
End DoDot:1
+8 QUIT
TRNSLT(CRHDINPT) ; 10/05/2009 KAM CRHD*1*2 Added to eliminate case sensitivity
+1 QUIT $TRANSLATE(CRHDINPT,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
