ORWTPD ; slc/jdl - Personal Reference Tool ;6/26/17 14:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,120,132,148,141,173,195,243,377**;Dec 17,1997;Build 582
;; 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
;
GETOCMIN(ORY) ;Get value of "ORCH CONTEXT MEDS INPAT"
S ORY=$$GET^XPAR("ALL","ORCH CONTEXT MEDS INPAT")
Q
;
PUTOCMIN(ORY,ORVAL) ;Set value of "ORCH CONTEXT MEDS INPAT"
I '$L(ORVAL) D DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT MEDS INPAT",1) Q
N ORERR S ORERR=""
D EN^XPAR(DUZ_";VA(200,","ORCH CONTEXT MEDS INPAT",1,ORVAL,.ORERR)
S ORY=ORERR
Q
;
GETOCMOP(ORY) ;Get value of "ORCH CONTEXT MEDS OUTPAT NONVA"
S ORY=$$GET^XPAR("ALL","ORCH CONTEXT MEDS OUTPAT NONVA")
Q
;
PUTOCMOP(ORY,ORVAL) ;Set value of "ORCH CONTEXT MEDS OUTPAT NONVA"
I '$L(ORVAL) D DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT MEDS OUTPAT NONVA",1) Q
N ORERR S ORERR=""
D EN^XPAR(DUZ_";VA(200,","ORCH CONTEXT MEDS OUTPAT NONVA",1,ORVAL,.ORERR)
S ORY=ORERR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWTPD 4500 printed Oct 16, 2024@18:38:04 Page 2
ORWTPD ; slc/jdl - Personal Reference Tool ;6/26/17 14:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,120,132,148,141,173,195,243,377**;Dec 17,1997;Build 582
+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 ;
GETOCMIN(ORY) ;Get value of "ORCH CONTEXT MEDS INPAT"
+1 SET ORY=$$GET^XPAR("ALL","ORCH CONTEXT MEDS INPAT")
+2 QUIT
+3 ;
PUTOCMIN(ORY,ORVAL) ;Set value of "ORCH CONTEXT MEDS INPAT"
+1 IF '$LENGTH(ORVAL)
DO DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT MEDS INPAT",1)
QUIT
+2 NEW ORERR
SET ORERR=""
+3 DO EN^XPAR(DUZ_";VA(200,","ORCH CONTEXT MEDS INPAT",1,ORVAL,.ORERR)
+4 SET ORY=ORERR
+5 QUIT
+6 ;
GETOCMOP(ORY) ;Get value of "ORCH CONTEXT MEDS OUTPAT NONVA"
+1 SET ORY=$$GET^XPAR("ALL","ORCH CONTEXT MEDS OUTPAT NONVA")
+2 QUIT
+3 ;
PUTOCMOP(ORY,ORVAL) ;Set value of "ORCH CONTEXT MEDS OUTPAT NONVA"
+1 IF '$LENGTH(ORVAL)
DO DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT MEDS OUTPAT NONVA",1)
QUIT
+2 NEW ORERR
SET ORERR=""
+3 DO EN^XPAR(DUZ_";VA(200,","ORCH CONTEXT MEDS OUTPAT NONVA",1,ORVAL,.ORERR)
+4 SET ORY=ORERR
+5 QUIT
+6 ;
