source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWTPD.m@ 1604

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

revised back to 6/30/08 version

File size: 3.6 KB
Line 
1ORWTPD ; slc/jdl - Personal Reference Tool ;6/20/02 11:40am [7/22/03 11:27am]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,120,132,148,141,173,195**;Dec 17,1997
3 ;; Allow user to customize the CPRS reports date/time
4 ;; and max occurences setting
5 ;
6SUDF(Y,VALUE) ;----Set user default for all CPRS reports
7 N ORERR S ORERR=""
8 I VALUE=$$GET^XPAR("DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I") D DEL^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS ALL",1,.ORERR) K ORERR Q
9 E D EN^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS ALL",1,VALUE,.ORERR)
10 S Y=1
11 K ORERR,VALUES1
12 Q
13 ;
14SUINDV(Y,RPTS,VALUE) ;----Set user individual time/occ setting
15 ; RPTS format: RPTIen^RPTIen^RPTIen such as 1^2^3
16 I $L(RPTS)=0 Q
17 N ORERR,RPTID,P1,P7 S ORERR=0
18 S (P1,P7)=""
19 F I=1:1:$L(RPTS,"^") S RPTID=$P(RPTS,U,I) D
20 . S P1=$P($G(^ORD(101.24,RPTID,0)),U),P7=$P($G(^(0)),U,7)
21 . I "02345"[P7,(P1'="ORRP IMAGING") D DEL^XPAR("USR.`"_DUZ,"ORWRP TIME/OCC LIMITS INDV",RPTID,.ORERR) Q
22 . D EN^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS INDV",RPTID,VALUE,.ORERR)
23 Q
24 ;
25GETIMG(Y,RPT) ; ----Get Image (local only) Time/Occ
26 N IMGID,BEG,END,MAX
27 S IMGID=0,Y=""
28 S IMGID=$O(^ORD(101.24,"B","ORRP IMAGING",0))
29 D GETINDV(.Y,IMGID)
30 I $L(Y) D
31 . S BEG=$$DT^ORCHTAB1($P(Y,";"))
32 . S END=$$DT^ORCHTAB1($P(Y,";",2))
33 . S MAX=$P(Y,";",3)
34 . S Y=BEG_"^"_END_"^"_MAX
35 I Y="" D GETDEF^ORWRA(.Y)
36 Q
37 ;
38GETINDV(Y,RPT) ;----Get time/occ limits for this report
39 ;RPT: Report IEN of 101.24
40 N CTX,X0,X4,X,IMGCTX
41 S X0=$G(^ORD(101.24,RPT,0)),X4=$G(^(4))
42 I "02345"[($P(X0,U,7)),($P(X0,U)'="ORRP IMAGING") Q
43 S CTX="^DIV^SYS^PKG"
44 S Y=$$GET^XPAR("USR.`"_DUZ_CTX,"ORWRP TIME/OCC LIMITS INDV",RPT,"I")
45 S:'$L(Y) Y=$$GET^XPAR("USR.`"_DUZ_CTX,"ORWRP TIME/OCC LIMITS ALL",1,"I")
46 I $P(^ORD(101.24,RPT,0),U,7)=1 S $P(Y,";",3)=""
47 I $P(X4,"^",2) S X=$P($P(Y,";"),"-",2) I X,X>$P(X4,"^",2) S Y="T-"_$P(X4,"^",2)_";"_$P(Y,";",2,99)
48 Q
49 ;
50GETSETS(Y) ;----Get time/occ limit set for each report
51 N I,CNT,CAT S I=0,CNT=1,RST=""
52 F S I=$O(^ORD(101.24,I)) Q:'I D
53 .I $P($G(^ORD(101.24,I,0)),U,8)="R",$P($G(^ORD(101.24,I,0)),U,12)'="M" D
54 ..S CAT=$P(^ORD(101.24,I,0),U,7) I $S(CAT=1:1,CAT=6:1,1:0)!($P(^(0),U)="ORRP IMAGING") D
55 ...D GETINDV(.RST,I)
56 ...I $L($P(^ORD(101.24,I,2),U,4))>0 S Y(CNT)=I_U_$P(^ORD(101.24,I,2),U,4)_U_RST
57 ...E S Y(CNT)=I_U_$P(^ORD(101.24,I,2),U,3)_U_RST
58 ... S CNT=CNT+1
59 K I,CNT,RST,CAT
60 Q
61 ;
62GETDFLT(Y) ;----Get default time/occ limits for all reports
63 N VALUE
64 S Y=$$GET^XPAR("USR.`"_DUZ_"^DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
65 K VALUE
66 Q
67 ;
68RSDFLT(Y) ;----Retrieve sys/pkg level default time/occ setting
69 N VALUE
70 S Y=$$GET^XPAR("DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
71 Q
72 ;
73DELDFLT(Y) ;----Delete user's default setting
74 N ORERR S ORERR=""
75 D NDEL^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS INDV",.ORERR)
76 D DEL^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS ALL",1,.ORERR)
77 K ORERR
78 Q
79 ;
80ACTDF(Y) ;----Make default setting take action for each report
81 N IND,DFLT,VALUE,X,X0,X4,MAX,DFLT1
82 S DFLT=$$GET^XPAR("USR.`"_DUZ_"^DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
83 S IND=0,X=$P($P(DFLT,";"),"-",2)
84 F S IND=$O(^ORD(101.24,IND)) Q:'IND S X0=$G(^(IND,0)),X4=$G(^(4)) D
85 . I $P(X0,"^",8)="R",$P(X0,"^",12)'="M" D
86 .. S MAX=$P(X4,"^",2),DFLT1=DFLT
87 .. I MAX,X,X>MAX S DFLT1="T-"_MAX_";"_$P(DFLT,";",2,99)
88 .. D SUINDV(.Y,IND,DFLT1)
89 Q
90GETOCM(ORY) ;Get value of "ORCH CONTEXT MEDS"
91 S ORY=$$GET^XPAR("ALL","ORCH CONTEXT MEDS")
92 Q
93 ;
94PUTOCM(ORY,ORVAL) ;Set value of "ORCH CONTEXT MEDS"
95 I '$L(ORVAL) D DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT MEDS",1) Q
96 N ORERR S ORERR=""
97 D EN^XPAR(DUZ_";VA(200,","ORCH CONTEXT MEDS",1,ORVAL,.ORERR)
98 S ORY=ORERR
99 Q
100 ;
Note: See TracBrowser for help on using the repository browser.