ORQRY01 ;SLC/JDL - Order query utility ;11/20/06 09:01
;;3.0;ORDER ENTRY/RESULTS REPORTING;**153,174,215,260**;Dec 17, 1997;Build 26
;
; DBIA 3869 GETPLIST^SDAMA202 ^TMP($J,"SDAMA202")
;
DOCDT(DOCS) ;Date range for TIU
N XDT,SDATE,EDATE
S XDT=$O(DOCS("Reference",""))
Q:'$L(XDT)
S SDATE=$P(XDT,":"),EDATE=$P(XDT,":",2)
S:SDATE=-1 SDATE=0
I EDATE=-1 S EDATE=9999999+EDATE
E S EDATE=EDATE+1
K DOCS("Reference",XDT)
S DOCS("Reference",SDATE_":"_EDATE)=""
Q
CLINPTS(ORY,CLIN,ORBDATE,OREDATE) ; RETURN LIST OF PTS W/CLINIC APPT W/IN DT RNG
;Copied from CLINPTS^ORQPTQ2 without maximum limitation
S ORY="^TMP(""ORCLINPT"",$J)"
K @ORY
I +$G(CLIN)<1 S @ORY@(1)="^No clinic identified" Q
I $$ACTLOC^ORWU(CLIN)'=1 S @ORY@(1)="^Clinic is inactive or Occasion Of Service" Q
N DFN,NAME,I,J,X,ORERR,ORJ,ORSRV,ORNOWDT,CHKX,CHKIN,ORC,CLNAM
S ORNOWDT=$$NOW^XLFDT
S ORSRV=$$GET1^DIQ(200,DUZ,29,"I") I +ORSRV>0 S ORSRV=$P(ORSRV,U)
S DFN=0,I=1
I ORBDATE="" S ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
I OREDATE="" S OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
;CONVERT ORBDATE AND OREDATE INTO FILEMAN DATE/TIME
D DT^DILF("T",ORBDATE,.ORBDATE,"","")
D DT^DILF("T",OREDATE,.OREDATE,"","")
I (ORBDATE=-1)!(OREDATE=-1) S @ORY@(1)="^Error in date range." Q
S OREDATE=$P(OREDATE,".")_.5 ;ADD 1/2 DAY TO END DATE
; DBIA 3869
N ORI,ORCSTAT
K ^TMP($J,"SDAMA202","GETPLIST")
D GETPLIST^SDAMA202(+CLIN,"1;3;4","",ORBDATE,OREDATE) ;DBIA 3869
S ORERR=$$CLINERR
I $L(ORERR) S @ORY@(1)=U_ORERR Q
S ORI=0
F S ORI=$O(^TMP($J,"SDAMA202","GETPLIST",ORI)) Q:ORI<1 D ;DBIA 3869
. S ORCSTAT=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,3))
. I ORCSTAT'="NT" Q:ORCSTAT="C" Q:ORCSTAT="N"
. S ORJ=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,1))
. S DFN=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,4))
. I ORJ,DFN S @ORY@(I)=DFN_"^"_$P(^DPT(DFN,0),"^")_"^"_+CLIN_"^"_ORJ,I=I+1
K ^TMP($J,"SDAMA202","GETPLIST")
S:'$D(@ORY) @ORY@(1)="^No appointments."
Q
;
SDA(ERR,ERRMSG) ; common call to scheduling to return new variables for errors - out of scope
D SDA^VADPT
S ERR=VAERR
I ERR=1 S ERRMSG="^Error encountered^Error encountered" Q
I ERR=2 S ERRMSG="^Database is unavailable^Database is unavailable" Q
S ERRMSG=""
Q
;
CLINERR() ; $$ -> error msg or ""
N ERR,MSG
S MSG=""
S ERR=+$O(^TMP($J,"SDAMA202","GETPLIST","ERROR",""))
I ERR D
. S MSG="Server Error #"_ERR_": "
. S MSG=MSG_$G(^TMP($J,"SDAMA202","GETPLIST","ERROR",ERR))
. K ^TMP($J,"SDAMA202","GETPLIST")
Q MSG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQRY01 2677 printed Apr 09, 2024@21:33:37 Page 2
ORQRY01 ;SLC/JDL - Order query utility ;11/20/06 09:01
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153,174,215,260**;Dec 17, 1997;Build 26
+2 ;
+3 ; DBIA 3869 GETPLIST^SDAMA202 ^TMP($J,"SDAMA202")
+4 ;
DOCDT(DOCS) ;Date range for TIU
+1 NEW XDT,SDATE,EDATE
+2 SET XDT=$ORDER(DOCS("Reference",""))
+3 if '$LENGTH(XDT)
QUIT
+4 SET SDATE=$PIECE(XDT,":")
SET EDATE=$PIECE(XDT,":",2)
+5 if SDATE=-1
SET SDATE=0
+6 IF EDATE=-1
SET EDATE=9999999+EDATE
+7 IF '$TEST
SET EDATE=EDATE+1
+8 KILL DOCS("Reference",XDT)
+9 SET DOCS("Reference",SDATE_":"_EDATE)=""
+10 QUIT
CLINPTS(ORY,CLIN,ORBDATE,OREDATE) ; RETURN LIST OF PTS W/CLINIC APPT W/IN DT RNG
+1 ;Copied from CLINPTS^ORQPTQ2 without maximum limitation
+2 SET ORY="^TMP(""ORCLINPT"",$J)"
+3 KILL @ORY
+4 IF +$GET(CLIN)<1
SET @ORY@(1)="^No clinic identified"
QUIT
+5 IF $$ACTLOC^ORWU(CLIN)'=1
SET @ORY@(1)="^Clinic is inactive or Occasion Of Service"
QUIT
+6 NEW DFN,NAME,I,J,X,ORERR,ORJ,ORSRV,ORNOWDT,CHKX,CHKIN,ORC,CLNAM
+7 SET ORNOWDT=$$NOW^XLFDT
+8 SET ORSRV=$$GET1^DIQ(200,DUZ,29,"I")
IF +ORSRV>0
SET ORSRV=$PIECE(ORSRV,U)
+9 SET DFN=0
SET I=1
+10 IF ORBDATE=""
SET ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
+11 IF OREDATE=""
SET OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
+12 ;CONVERT ORBDATE AND OREDATE INTO FILEMAN DATE/TIME
+13 DO DT^DILF("T",ORBDATE,.ORBDATE,"","")
+14 DO DT^DILF("T",OREDATE,.OREDATE,"","")
+15 IF (ORBDATE=-1)!(OREDATE=-1)
SET @ORY@(1)="^Error in date range."
QUIT
+16 ;ADD 1/2 DAY TO END DATE
SET OREDATE=$PIECE(OREDATE,".")_.5
+17 ; DBIA 3869
+18 NEW ORI,ORCSTAT
+19 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
+20 ;DBIA 3869
DO GETPLIST^SDAMA202(+CLIN,"1;3;4","",ORBDATE,OREDATE)
+21 SET ORERR=$$CLINERR
+22 IF $LENGTH(ORERR)
SET @ORY@(1)=U_ORERR
QUIT
+23 SET ORI=0
+24 ;DBIA 3869
FOR
SET ORI=$ORDER(^TMP($JOB,"SDAMA202","GETPLIST",ORI))
if ORI<1
QUIT
Begin DoDot:1
+25 SET ORCSTAT=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",ORI,3))
+26 IF ORCSTAT'="NT"
if ORCSTAT="C"
QUIT
if ORCSTAT="N"
QUIT
+27 SET ORJ=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",ORI,1))
+28 SET DFN=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",ORI,4))
+29 IF ORJ
IF DFN
SET @ORY@(I)=DFN_"^"_$PIECE(^DPT(DFN,0),"^")_"^"_+CLIN_"^"_ORJ
SET I=I+1
End DoDot:1
+30 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
+31 if '$DATA(@ORY)
SET @ORY@(1)="^No appointments."
+32 QUIT
+33 ;
SDA(ERR,ERRMSG) ; common call to scheduling to return new variables for errors - out of scope
+1 DO SDA^VADPT
+2 SET ERR=VAERR
+3 IF ERR=1
SET ERRMSG="^Error encountered^Error encountered"
QUIT
+4 IF ERR=2
SET ERRMSG="^Database is unavailable^Database is unavailable"
QUIT
+5 SET ERRMSG=""
+6 QUIT
+7 ;
CLINERR() ; $$ -> error msg or ""
+1 NEW ERR,MSG
+2 SET MSG=""
+3 SET ERR=+$ORDER(^TMP($JOB,"SDAMA202","GETPLIST","ERROR",""))
+4 IF ERR
Begin DoDot:1
+5 SET MSG="Server Error #"_ERR_": "
+6 SET MSG=MSG_$GET(^TMP($JOB,"SDAMA202","GETPLIST","ERROR",ERR))
+7 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
End DoDot:1
+8 QUIT MSG
