- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWTPD.m
r613 r623 1 ORWTPD ; 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,243**;Dec 17,1997;Build 242 3 ;; Allow user to customize the CPRS reports date/time 4 ;; and max occurences setting 5 ; 6 SUDF(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 ; 14 SUINDV(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 ; 25 GETIMG(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 ; 38 GETINDV(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 ; 50 GETSETS(Y) ;----Get time/occ limit set for each report 51 N I,CNT,CAT,SEC 52 S I=0,CNT=1,RST="" 53 F S I=$O(^ORD(101.24,I)) Q:'I D 54 . I $P($G(^ORD(101.24,I,0)),U,12)'="M" D 55 .. S CAT=$P(^ORD(101.24,I,0),U,7),SEC=$P(^(0),U,8) 56 .. I $S(CAT=1:1,CAT=6:1,1:0)!($P(^(0),U)="ORRP IMAGING") D 57 ... D GETINDV(.RST,I) 58 ... I $L($P(^ORD(101.24,I,2),U,4))>0 S Y(CNT)=I_U_$P(^(2),U,4)_" ["_SEC_"]"_U_RST 59 ... E S Y(CNT)=I_U_$P(^ORD(101.24,I,2),U,3)_" ["_SEC_"]"_U_RST 60 ... S CNT=CNT+1 61 K I,CNT,RST,CAT 62 Q 63 ; 64 GETDFLT(Y) ;----Get default time/occ limits for all reports 65 N VALUE 66 S Y=$$GET^XPAR("USR.`"_DUZ_"^DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I") 67 K VALUE 68 Q 69 ; 70 RSDFLT(Y) ;----Retrieve sys/pkg level default time/occ setting 71 N VALUE 72 S Y=$$GET^XPAR("DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I") 73 Q 74 ; 75 DELDFLT(Y) ;----Delete user's default setting 76 N ORERR S ORERR="" 77 D NDEL^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS INDV",.ORERR) 78 D DEL^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS ALL",1,.ORERR) 79 K ORERR 80 Q 81 ; 82 ACTDF(Y) ;----Make default setting take action for each report 83 N IND,DFLT,VALUE,X,X0,X4,MAX,DFLT1 84 S DFLT=$$GET^XPAR("USR.`"_DUZ_"^DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I") 85 S IND=0,X=$P($P(DFLT,";"),"-",2) 86 F S IND=$O(^ORD(101.24,IND)) Q:'IND S X0=$G(^(IND,0)),X4=$G(^(4)) D 87 . I $P(X0,"^",8)="R",$P(X0,"^",12)'="M" D 88 .. S MAX=$P(X4,"^",2),DFLT1=DFLT 89 .. I MAX,X,X>MAX S DFLT1="T-"_MAX_";"_$P(DFLT,";",2,99) 90 .. D SUINDV(.Y,IND,DFLT1) 91 Q 92 GETOCM(ORY) ;Get value of "ORCH CONTEXT MEDS" 93 S ORY=$$GET^XPAR("ALL","ORCH CONTEXT MEDS") 94 Q 95 ; 96 PUTOCM(ORY,ORVAL) ;Set value of "ORCH CONTEXT MEDS" 97 I '$L(ORVAL) D DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT MEDS",1) Q 98 N ORERR S ORERR="" 99 D EN^XPAR(DUZ_";VA(200,","ORCH CONTEXT MEDS",1,ORVAL,.ORERR) 100 S ORY=ORERR 101 Q 102 ; 1 ORWTPD ; 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 ; 6 SUDF(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 ; 14 SUINDV(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 ; 25 GETIMG(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 ; 38 GETINDV(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 ; 50 GETSETS(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 ; 62 GETDFLT(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 ; 68 RSDFLT(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 ; 73 DELDFLT(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 ; 80 ACTDF(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 90 GETOCM(ORY) ;Get value of "ORCH CONTEXT MEDS" 91 S ORY=$$GET^XPAR("ALL","ORCH CONTEXT MEDS") 92 Q 93 ; 94 PUTOCM(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 TracChangeset
for help on using the changeset viewer.
