- ORWTPD ; slc/jdl - Personal Reference Tool ;6/20/02 11:40am [7/22/03 11:27am]
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,120,132,148,141,173,195,243**;Dec 17,1997;Build 242
- ;; Allow user to customize the CPRS reports date/time
- ;; and max occurences setting
- ;
- SUDF(Y,VALUE) ;----Set user default for all CPRS reports
- N ORERR S ORERR=""
- 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
- E D EN^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS ALL",1,VALUE,.ORERR)
- S Y=1
- K ORERR,VALUES1
- Q
- ;
- SUINDV(Y,RPTS,VALUE) ;----Set user individual time/occ setting
- ; RPTS format: RPTIen^RPTIen^RPTIen such as 1^2^3
- I $L(RPTS)=0 Q
- N ORERR,RPTID,P1,P7 S ORERR=0
- S (P1,P7)=""
- F I=1:1:$L(RPTS,"^") S RPTID=$P(RPTS,U,I) D
- . S P1=$P($G(^ORD(101.24,RPTID,0)),U),P7=$P($G(^(0)),U,7)
- . I "02345"[P7,(P1'="ORRP IMAGING") D DEL^XPAR("USR.`"_DUZ,"ORWRP TIME/OCC LIMITS INDV",RPTID,.ORERR) Q
- . D EN^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS INDV",RPTID,VALUE,.ORERR)
- Q
- ;
- GETIMG(Y,RPT) ; ----Get Image (local only) Time/Occ
- N IMGID,BEG,END,MAX
- S IMGID=0,Y=""
- S IMGID=$O(^ORD(101.24,"B","ORRP IMAGING",0))
- D GETINDV(.Y,IMGID)
- I $L(Y) D
- . S BEG=$$DT^ORCHTAB1($P(Y,";"))
- . S END=$$DT^ORCHTAB1($P(Y,";",2))
- . S MAX=$P(Y,";",3)
- . S Y=BEG_"^"_END_"^"_MAX
- I Y="" D GETDEF^ORWRA(.Y)
- Q
- ;
- GETINDV(Y,RPT) ;----Get time/occ limits for this report
- ;RPT: Report IEN of 101.24
- N CTX,X0,X4,X,IMGCTX
- S X0=$G(^ORD(101.24,RPT,0)),X4=$G(^(4))
- I "02345"[($P(X0,U,7)),($P(X0,U)'="ORRP IMAGING") Q
- S CTX="^DIV^SYS^PKG"
- S Y=$$GET^XPAR("USR.`"_DUZ_CTX,"ORWRP TIME/OCC LIMITS INDV",RPT,"I")
- S:'$L(Y) Y=$$GET^XPAR("USR.`"_DUZ_CTX,"ORWRP TIME/OCC LIMITS ALL",1,"I")
- I $P(^ORD(101.24,RPT,0),U,7)=1 S $P(Y,";",3)=""
- 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)
- Q
- ;
- GETSETS(Y) ;----Get time/occ limit set for each report
- N I,CNT,CAT,SEC
- S I=0,CNT=1,RST=""
- F S I=$O(^ORD(101.24,I)) Q:'I D
- . I $P($G(^ORD(101.24,I,0)),U,12)'="M" D
- .. S CAT=$P(^ORD(101.24,I,0),U,7),SEC=$P(^(0),U,8)
- .. I $S(CAT=1:1,CAT=6:1,1:0)!($P(^(0),U)="ORRP IMAGING") D
- ... D GETINDV(.RST,I)
- ... I $L($P(^ORD(101.24,I,2),U,4))>0 S Y(CNT)=I_U_$P(^(2),U,4)_" ["_SEC_"]"_U_RST
- ... E S Y(CNT)=I_U_$P(^ORD(101.24,I,2),U,3)_" ["_SEC_"]"_U_RST
- ... S CNT=CNT+1
- K I,CNT,RST,CAT
- Q
- ;
- GETDFLT(Y) ;----Get default time/occ limits for all reports
- N VALUE
- S Y=$$GET^XPAR("USR.`"_DUZ_"^DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
- K VALUE
- Q
- ;
- RSDFLT(Y) ;----Retrieve sys/pkg level default time/occ setting
- N VALUE
- S Y=$$GET^XPAR("DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
- Q
- ;
- DELDFLT(Y) ;----Delete user's default setting
- N ORERR S ORERR=""
- D NDEL^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS INDV",.ORERR)
- D DEL^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS ALL",1,.ORERR)
- K ORERR
- Q
- ;
- ACTDF(Y) ;----Make default setting take action for each report
- N IND,DFLT,VALUE,X,X0,X4,MAX,DFLT1
- S DFLT=$$GET^XPAR("USR.`"_DUZ_"^DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
- S IND=0,X=$P($P(DFLT,";"),"-",2)
- F S IND=$O(^ORD(101.24,IND)) Q:'IND S X0=$G(^(IND,0)),X4=$G(^(4)) D
- . I $P(X0,"^",8)="R",$P(X0,"^",12)'="M" D
- .. S MAX=$P(X4,"^",2),DFLT1=DFLT
- .. I MAX,X,X>MAX S DFLT1="T-"_MAX_";"_$P(DFLT,";",2,99)
- .. D SUINDV(.Y,IND,DFLT1)
- Q
- GETOCM(ORY) ;Get value of "ORCH CONTEXT MEDS"
- S ORY=$$GET^XPAR("ALL","ORCH CONTEXT MEDS")
- Q
- ;
- PUTOCM(ORY,ORVAL) ;Set value of "ORCH CONTEXT MEDS"
- I '$L(ORVAL) D DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT MEDS",1) Q
- N ORERR S ORERR=""
- D EN^XPAR(DUZ_";VA(200,","ORCH CONTEXT MEDS",1,ORVAL,.ORERR)
- S ORY=ORERR
- Q
- ;
- ORWTPD ; slc/jdl - Personal Reference Tool ;6/20/02 11:40am [7/22/03 11:27am]
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,120,132,148,141,173,195,243**;Dec 17,1997;Build 242
- +2 ;; Allow user to customize the CPRS reports date/time
- +3 ;; and max occurences setting
- +4 ;
- SUDF(Y,VALUE) ;----Set user default for all CPRS reports
- +1 NEW ORERR
- SET ORERR=""
- +2 IF VALUE=$$GET^XPAR("DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
- DO DEL^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS ALL",1,.ORERR)
- KILL ORERR
- QUIT
- +3 IF '$TEST
- DO EN^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS ALL",1,VALUE,.ORERR)
- +4 SET Y=1
- +5 KILL ORERR,VALUES1
- +6 QUIT
- +7 ;
- SUINDV(Y,RPTS,VALUE) ;----Set user individual time/occ setting
- +1 ; RPTS format: RPTIen^RPTIen^RPTIen such as 1^2^3
- +2 IF $LENGTH(RPTS)=0
- QUIT
- +3 NEW ORERR,RPTID,P1,P7
- SET ORERR=0
- +4 SET (P1,P7)=""
- +5 FOR I=1:1:$LENGTH(RPTS,"^")
- SET RPTID=$PIECE(RPTS,U,I)
- Begin DoDot:1
- +6 SET P1=$PIECE($GET(^ORD(101.24,RPTID,0)),U)
- SET P7=$PIECE($GET(^(0)),U,7)
- +7 IF "02345"[P7
- IF (P1'="ORRP IMAGING")
- DO DEL^XPAR("USR.`"_DUZ,"ORWRP TIME/OCC LIMITS INDV",RPTID,.ORERR)
- QUIT
- +8 DO EN^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS INDV",RPTID,VALUE,.ORERR)
- End DoDot:1
- +9 QUIT
- +10 ;
- GETIMG(Y,RPT) ; ----Get Image (local only) Time/Occ
- +1 NEW IMGID,BEG,END,MAX
- +2 SET IMGID=0
- SET Y=""
- +3 SET IMGID=$ORDER(^ORD(101.24,"B","ORRP IMAGING",0))
- +4 DO GETINDV(.Y,IMGID)
- +5 IF $LENGTH(Y)
- Begin DoDot:1
- +6 SET BEG=$$DT^ORCHTAB1($PIECE(Y,";"))
- +7 SET END=$$DT^ORCHTAB1($PIECE(Y,";",2))
- +8 SET MAX=$PIECE(Y,";",3)
- +9 SET Y=BEG_"^"_END_"^"_MAX
- End DoDot:1
- +10 IF Y=""
- DO GETDEF^ORWRA(.Y)
- +11 QUIT
- +12 ;
- GETINDV(Y,RPT) ;----Get time/occ limits for this report
- +1 ;RPT: Report IEN of 101.24
- +2 NEW CTX,X0,X4,X,IMGCTX
- +3 SET X0=$GET(^ORD(101.24,RPT,0))
- SET X4=$GET(^(4))
- +4 IF "02345"[($PIECE(X0,U,7))
- IF ($PIECE(X0,U)'="ORRP IMAGING")
- QUIT
- +5 SET CTX="^DIV^SYS^PKG"
- +6 SET Y=$$GET^XPAR("USR.`"_DUZ_CTX,"ORWRP TIME/OCC LIMITS INDV",RPT,"I")
- +7 IF '$LENGTH(Y)
- SET Y=$$GET^XPAR("USR.`"_DUZ_CTX,"ORWRP TIME/OCC LIMITS ALL",1,"I")
- +8 IF $PIECE(^ORD(101.24,RPT,0),U,7)=1
- SET $PIECE(Y,";",3)=""
- +9 IF $PIECE(X4,"^",2)
- SET X=$PIECE($PIECE(Y,";"),"-",2)
- IF X
- IF X>$PIECE(X4,"^",2)
- SET Y="T-"_$PIECE(X4,"^",2)_";"_$PIECE(Y,";",2,99)
- +10 QUIT
- +11 ;
- GETSETS(Y) ;----Get time/occ limit set for each report
- +1 NEW I,CNT,CAT,SEC
- +2 SET I=0
- SET CNT=1
- SET RST=""
- +3 FOR
- SET I=$ORDER(^ORD(101.24,I))
- IF 'I
- QUIT
- Begin DoDot:1
- +4 IF $PIECE($GET(^ORD(101.24,I,0)),U,12)'="M"
- Begin DoDot:2
- +5 SET CAT=$PIECE(^ORD(101.24,I,0),U,7)
- SET SEC=$PIECE(^(0),U,8)
- +6 IF $SELECT(CAT=1:1,CAT=6:1,1:0)!($PIECE(^(0),U)="ORRP IMAGING")
- Begin DoDot:3
- +7 DO GETINDV(.RST,I)
- +8 IF $LENGTH($PIECE(^ORD(101.24,I,2),U,4))>0
- SET Y(CNT)=I_U_$PIECE(^(2),U,4)_" ["_SEC_"]"_U_RST
- +9 IF '$TEST
- SET Y(CNT)=I_U_$PIECE(^ORD(101.24,I,2),U,3)_" ["_SEC_"]"_U_RST
- +10 SET CNT=CNT+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 KILL I,CNT,RST,CAT
- +12 QUIT
- +13 ;
- GETDFLT(Y) ;----Get default time/occ limits for all reports
- +1 NEW VALUE
- +2 SET Y=$$GET^XPAR("USR.`"_DUZ_"^DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
- +3 KILL VALUE
- +4 QUIT
- +5 ;
- RSDFLT(Y) ;----Retrieve sys/pkg level default time/occ setting
- +1 NEW VALUE
- +2 SET Y=$$GET^XPAR("DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
- +3 QUIT
- +4 ;
- DELDFLT(Y) ;----Delete user's default setting
- +1 NEW ORERR
- SET ORERR=""
- +2 DO NDEL^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS INDV",.ORERR)
- +3 DO DEL^XPAR(DUZ_";VA(200,","ORWRP TIME/OCC LIMITS ALL",1,.ORERR)
- +4 KILL ORERR
- +5 QUIT
- +6 ;
- ACTDF(Y) ;----Make default setting take action for each report
- +1 NEW IND,DFLT,VALUE,X,X0,X4,MAX,DFLT1
- +2 SET DFLT=$$GET^XPAR("USR.`"_DUZ_"^DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
- +3 SET IND=0
- SET X=$PIECE($PIECE(DFLT,";"),"-",2)
- +4 FOR
- SET IND=$ORDER(^ORD(101.24,IND))
- IF 'IND
- QUIT
- SET X0=$GET(^(IND,0))
- SET X4=$GET(^(4))
- Begin DoDot:1
- +5 IF $PIECE(X0,"^",8)="R"
- IF $PIECE(X0,"^",12)'="M"
- Begin DoDot:2
- +6 SET MAX=$PIECE(X4,"^",2)
- SET DFLT1=DFLT
- +7 IF MAX
- IF X
- IF X>MAX
- SET DFLT1="T-"_MAX_";"_$PIECE(DFLT,";",2,99)
- +8 DO SUINDV(.Y,IND,DFLT1)
- End DoDot:2
- End DoDot:1
- +9 QUIT
- GETOCM(ORY) ;Get value of "ORCH CONTEXT MEDS"
- +1 SET ORY=$$GET^XPAR("ALL","ORCH CONTEXT MEDS")
- +2 QUIT
- +3 ;
- PUTOCM(ORY,ORVAL) ;Set value of "ORCH CONTEXT MEDS"
- +1 IF '$LENGTH(ORVAL)
- DO DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT MEDS",1)
- QUIT
- +2 NEW ORERR
- SET ORERR=""
- +3 DO EN^XPAR(DUZ_";VA(200,","ORCH CONTEXT MEDS",1,ORVAL,.ORERR)
- +4 SET ORY=ORERR
- +5 QUIT
- +6 ;
