source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORKRA.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1ORKRA ; slc/CLA - Order checking support procedure for Radiology ;12/15/97
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,92,105**;Dec 17, 1997
3 Q
4RECENTBA(ORDFN,ORHRS) ; extrinsic function to return the most recent radiology procedure using barium within the past ORHRS in the format:
5 ; order #^order text (first 60 chars) order effective date/time
6 N BDT,EDT,INBDT,XDT,X,ORDT,HDT,ORN,OROI,ORCM,TOT,ORQ,ORDG
7 S X="",ORDT="",HDT="",ORN="",TOT=0,ORQ=""
8 Q:+$G(ORDFN)<1 ORQ
9 Q:+$G(ORHRS)<1 ORQ
10 D NOW^%DTC S EDT=% K %
11 S BDT=$$FMADD^XLFDT(EDT,"","-"_ORHRS,"","")
12 Q:+$G(BDT)<1 ORQ
13 S ORDG=$$DG^ORQOR1("GENERAL RADIOLOGY")
14 Q:+$G(ORDG)<1 ORQ
15 K ^TMP("ORR",$J)
16 D EN^ORQ1(ORDFN_";DPT(",ORDG,1,"",BDT,EDT,0,0)
17 S HDT=$O(^TMP("ORR",$J,HDT)) Q:HDT="" ORQ S TOT=^(HDT,"TOT") I TOT>0 D
18 .F X=1:1:TOT Q:+$G(ORQ)>0 D ;quit on 1st barium found (most recent)
19 ..S ORN=+^TMP("ORR",$J,HDT,X)
20 ..S OROI=$G(^OR(100,ORN,.1,1,0))
21 ..Q:+$G(OROI)<1
22 ..S ORCM=$$CM^ORQQRA(OROI)
23 ..I $G(ORCM)["B" D
24 ...S ORDT=$G(^OR(100,ORN,0)) S:$L($G(ORDT)) ORDT=$P(ORDT,U,8)
25 ...S ORDT=$$FMTE^XLFDT(ORDT,"2P")
26 ...S ORQ=ORN_U_$P($$TEXT^ORKOR(ORN,60),U,2)_" "_$G(ORDT)
27 K ^TMP("ORR",$J)
28 Q ORQ
29RECENTCH(ORDFN,ORDAYS) ;extrinsic function to return the most recent cholecystogram procedure within the past ORDAYS in the format:
30 ; order #^order text (first 60 chars) order effective date/time
31 N BDT,EDT,INBDT,XDT,X,ORDT,HDT,ORN,OROI,ORCM,TOT,ORQ,ORDG
32 S X="",ORDT="",HDT="",ORN="",TOT=0,ORQ=""
33 Q:+$G(ORDFN)<1 ORQ
34 Q:+$G(ORDAYS)<1 ORQ
35 D NOW^%DTC S EDT=% K %
36 S BDT=$$FMADD^XLFDT(EDT,"-"_ORDAYS,"","","")
37 Q:+$G(BDT)<1 ORQ
38 S ORDG=$$DG^ORQOR1("GENERAL RADIOLOGY")
39 Q:+$G(ORDG)<1 ORQ
40 K ^TMP("ORR",$J)
41 D EN^ORQ1(ORDFN_";DPT(",ORDG,1,"",BDT,EDT,0,0)
42 S HDT=$O(^TMP("ORR",$J,HDT)) Q:HDT="" ORQ S TOT=^(HDT,"TOT") I TOT>0 D
43 .F X=1:1:TOT Q:+$G(ORQ)>0 D ;quit on 1st cholecyst found (most recent)
44 ..S ORN=+^TMP("ORR",$J,HDT,X)
45 ..S OROI=$G(^OR(100,ORN,.1,1,0))
46 ..Q:+$G(OROI)<1
47 ..S ORCM=$$CM^ORQQRA(OROI)
48 ..I $G(ORCM)["C" D ;cholecystogram
49 ...S ORDT=$G(^OR(100,ORN,0)) S:$L($G(ORDT)) ORDT=$P(ORDT,U,8)
50 ...S ORDT=$$FMTE^XLFDT(ORDT,"2P")
51 ...S ORQ=ORN_U_$P($$TEXT^ORKOR(ORN,60),U,2)_" "_$G(ORDT)
52 K ^TMP("ORR",$J)
53 Q ORQ
54TYPE(OI) ;extrinisic function which returns the imaging type for an orderable item
55 ;returned as 'RAD','CT','MRI','ANI','CARD','NM','US', or 'VAS'
56 N ORTYPE S ORTYPE=""
57 S ORTYPE=$G(^ORD(101.43,OI,"RA"))
58 S:$L($G(ORTYPE)) ORTYPE=$P(ORTYPE,U,3)
59 Q ORTYPE
60CMCDAYS(DFN) ;extrinsic function to return number of days to look for
61 ; contrast media serum creatinine result
62 Q:'$L(DFN) ""
63 N ORLOC,ORENT,ORDAYS
64 ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
65 ;reliably determined, and many simultaneous outpt locations can occur):
66 S VA200="" D OERR^VADPT
67 S ORLOC=+$G(^DIC(42,+VAIN(4),44))
68 K VA200,VAIN
69 S ORENT=+$G(ORLOC)_";SC(^DIV^SYS^PKG"
70 S ORDAYS=$$GET^XPAR(ORENT,"ORK CONTRAST MEDIA CREATININE",1,"I")
71 Q:$L(ORDAYS) ORDAYS
72 Q ""
Note: See TracBrowser for help on using the repository browser.