- 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 Jan 18, 2025@03:35:03 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