source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/CRHDDR.m@ 1169

Last change on this file since 1169 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1CRHDDR ; CAIRO/CLC - RETRIEVE DNR ORDERS USING ORDER DIALOG ;4/23/08 13:06
2 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
3 ;=================================================================
4ENT(CRHDRTN,DFN,CRHDNRTT,CRHDDIV,CRHDMULT) ;
5 N CRHDSDAT,CRHDFND,CRHDRN,CRHDEXDT,CRHDEXN,X,Y
6 N CRHDSTS,CRHDDL,CRHDCT,CRHDFLG,CRHDIEN1,CRHDOI
7 K CRHDRTN
8 ;CRHDMULT = 1,if multi active orders displayed
9 S CRHDMULT=+$G(CRHDMULT)
10 I '$G(CRHDRN) S CRHDRN=1
11 D DNRPARM(.CRHDNRTT,DUZ,.CRHDDIV)
12 S CRHDFLG=0
13 S CRHDSDAT=$$NOW^XLFDT
14 S CRHDEXDT=0,CRHDCT=0
15 F S CRHDEXDT=$O(^OR(100,"AC",DFN_";DPT(",CRHDEXDT)) Q:'CRHDEXDT!(CRHDFLG) D
16 .S CRHDEXN="" F S CRHDEXN=$O(^OR(100,"AC",DFN_";DPT(",CRHDEXDT,CRHDEXN)) Q:CRHDEXN=""!(CRHDFLG) D
17 ..S CRHDOI=0
18 ..F S CRHDOI=$O(^OR(100,CRHDEXN,.1,"B",CRHDOI)) Q:'CRHDOI!(CRHDFLG) D
19 ...I $D(CRHDNRTT(+CRHDOI)) D DETAIL("CRHDRTN",CRHDEXN,.CRHDFLG,.CRHDCT,.CRHDMULT)
20 Q
21 ;
22DETAIL(CRHDY,CRHDIFN,CRHDFND,CRHDCNT,CRHDMDNR) ; -- Returns details of order CRHDIFN in CRHDY(#)
23 N CRHDMCNT,X,CRHDX2,CRHDI,CRHDILOG,CRHD0,CRHD3,CRHD6,CRHDSEQ,CRHDITEM,CRHDPRMT
24 N CRHDFIRT,CRHDTITL,CRHDINST,CRHDN,ORIGVIEW,ORFLG,CRHDII
25 N DIWL,DIWR,DIWF,CRHDACTI,VAIN,CRHDOVW,ORNMSP,CRHDYT,CRHDDNR,CRHDXX,CRHDNX
26 S CRHDIFN=+CRHDIFN,CRHD0=$G(^OR(100,CRHDIFN,0)),CRHD3=$G(^(3)),CRHD6=$G(^(6))
27 Q:$P(CRHD3,"^",3)'=6
28 K CRHDYT S CRHDOVW=1 D TEXT^CRHD8(.CRHDYT,+CRHDIFN_";"_+$P(CRHD3,U,7),254)
29 ;CurrTx
30 I $D(CRHDYT) D
31 .I 'CRHDMDNR S CRHDFND=1
32 .S CRHDN=0
33 .;USE CRHDEXDT IN THE DATA NODE TO
34 .I $D(@CRHDY) S CRHDCNT=CRHDCNT+1,@CRHDY@(CRHDCNT)=""
35 .F CRHDII=1:1 S CRHDN=$O(CRHDYT(CRHDN)) Q:'CRHDN D
36 ..S CRHDCNT=CRHDCNT+1
37 ..I CRHDII=1 S @CRHDY@(CRHDCNT)=CRHDEXDT_"~"_CRHDIFN_"~"_CRHDYT(CRHDN)
38 ..E S @CRHDY@(CRHDCNT)=CRHDYT(CRHDN)
39 Q
40DNRPARM(CRHDNRTT,DUZ,CRHDDIV) ;GET DNR TITLES
41 N CRHDPAR,CRHDDIVI,CRHDDNRT
42 K CRHDNRTT
43 S CRHDDNRT=0
44 I '+$G(CRHDDIV) S CRHDDIV=+$$SITE^VASITE
45 S CRHDPAR="DIV.`"_+CRHDDIV D GETLST^XPAR(.CRHDDNRT,CRHDPAR,"CRHD DNR ORDERABLE ITEMS")
46 I 'CRHDDNRT D
47 .S CRHDDIVI=$O(^DIC(4,"D",CRHDDIV,0))
48 .I CRHDDIVI S CRHDPAR="DIV.`"_CRHDDIVI D GETLST^XPAR(.CRHDDNRT,CRHDPAR,"CRHD DNR ORDERABLE ITEMS")
49 I CRHDDNRT D
50 .S CRHDN=0 F S CRHDN=$O(CRHDDNRT(CRHDN)) Q:'CRHDN D
51 ..S:$P($G(CRHDDNRT(CRHDN)),"^",2)'="" CRHDNRTT($P(CRHDDNRT(CRHDN),"^",2))=""
52 Q
53LORDITM(CRHDY,CRHDFROM,CRHDDIR) ; Return a set of names from the ORDERABLE ITEMS file.
54 ; copied from ORWU1
55 ; .CRHDY=returned list.
56 ; CRHDDIR=Direction to move through the x-ref with $O.
57 ; CRHDFROM=Starting name for this set.
58 K CRHDRTN
59 N CRHDNAME,CRHDNUMB,CRHDIEN1,CRHDMAX
60 S CRHDI=0,CRHDMAX=44
61 F Q:CRHDI'<CRHDMAX S CRHDFROM=$O(^ORD(101.43,"B",CRHDFROM),CRHDDIR) Q:CRHDFROM="" D
62 .S CRHDIEN1=""
63 .F S CRHDIEN1=$O(^ORD(101.43,"B",CRHDFROM,CRHDIEN1),CRHDDIR) Q:'CRHDIEN1 D
64 ..I $D(^ORD(101.43,CRHDIEN1,.1)),+$G(^ORD(101.43,CRHDIEN1,.1)) I +^ORD(101.43,CRHDIEN1,.1)<$$DT^XLFDT Q
65 ..S CRHDI=CRHDI+1,CRHDY(CRHDI)=CRHDIEN1_"^"_CRHDFROM
66 Q
Note: See TracBrowser for help on using the repository browser.