BQIPTAP ;PRXM/HC/DLS - Scheduled Visits (Pending); 07 Nov 2005 10:37 AM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
EN(DATA,DFN,DRANGE) ; EP - BQI PATIENT SCHEDULED APPTS
;Description
; Retrieves all pending scheduled visits for a patient.
;
;Input
; DFN - Patient IEN
; DRANGE - Future date to pull future appointments up to and including.
;
;Output
; DATA - Name of global in which data is stored.
;
N UID,X,BQII,ARRAY,I,CSTCD
N APDATA,APDTTM,APCLIN,APCLIN,CLIEN,DEFPRV,FMDTTM
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTAP",UID))
K @DATA
K ^TMP("BQIPTAPT",UID)
;
S BQII=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTAP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
D HDR
;
;
S ARRAY="^TMP(""BQIPTAPT"",UID,"
D PEND^BSDU2(DFN,0,.ARRAY)
S DRANGE=$$DATE^BQIUL1($G(DRANGE))
I DRANGE="" S DRANGE=9999999
S DRANGE=DRANGE+.2401
S I=1
F S I=$O(^TMP("BQIPTAPT",UID,I)) Q:'I D
. S APDATA=^TMP("BQIPTAPT",UID,I)
. S APDTTM=$P(APDATA,"^"),APCLIN=$P(APDATA,"^",2)
. S APDTTM=$TR($E(APDTTM,1,7)_$E(APDTTM,9,18),"@"," ")
. S FMDTTM=$$DATE^BQIUL1(APDTTM)
. Q:FMDTTM>DRANGE
. F Q:$E(APCLIN,$L(APCLIN))'=" " S APCLIN=$E(APCLIN,1,($L(APCLIN)-1))
. S CLIEN=^TMP("BQIPTAPT",UID,I,0),DEFPRV=$$DCPRV(CLIEN)
. S CSTCD="" I CLIEN'="" S CSTCD=$$GET1^DIQ(40.7,CLIEN_",",1,"E")
. S BQII=BQII+1,@DATA@(BQII)=$$FMTE^BQIUL1($P(APDATA,"^"))_"^"_APCLIN_" "_CSTCD_"^"_DEFPRV_$C(30)
;
; Drop down to DONE
;
DONE ; -- exit code
K ^TMP("BQIPTAPT",UID)
S BQII=BQII+1,@DATA@(BQII)=$C(31)
Q
;
HDR ;
S @DATA@(BQII)="D00015AP_DATE^T00050AP_CLIN^T00050DEF_PRV"_$C(30)
Q
;
DCPRV(CLIEN) ;EP - Loop thru Clinic Providers and Return Default Provider.
; DCY returns as the name of the default clinic provider.
N DCX,DCY,FOUND
S (DCX,FOUND)=0
S DCY=$P($G(^SC(CLIEN,0)),U,13)
I DCY="" D
. F S DCX=$O(^SC(CLIEN,"PR",DCX)) Q:'DCX!FOUND D
.. I $P($G(^SC(CLIEN,"PR",DCX,0)),U,2)=1 S DCY=+^SC(CLIEN,"PR",DCX,0),FOUND=1
I $G(DCY) S DCY=$$GET1^DIQ(200,DCY,.01)
Q $G(DCY)
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
Q
BQIPTAP ;PRXM/HC/DLS - Scheduled Visits (Pending); 07 Nov 2005 10:37 AM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
EN(DATA,DFN,DRANGE) ; EP - BQI PATIENT SCHEDULED APPTS
+1 ;Description
+2 ; Retrieves all pending scheduled visits for a patient.
+3 ;
+4 ;Input
+5 ; DFN - Patient IEN
+6 ; DRANGE - Future date to pull future appointments up to and including.
+7 ;
+8 ;Output
+9 ; DATA - Name of global in which data is stored.
+10 ;
+11 NEW UID,X,BQII,ARRAY,I,CSTCD
+12 NEW APDATA,APDTTM,APCLIN,APCLIN,CLIEN,DEFPRV,FMDTTM
+13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+14 SET DATA=$NAME(^TMP("BQIPTAP",UID))
+15 KILL @DATA
+16 KILL ^TMP("BQIPTAPT",UID)
+17 ;
+18 SET BQII=0
+19 ;
+20 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTAP D UNWIND^%ZTER"
+21 ;
+22 DO HDR
+23 ;
+24 ;
+25 SET ARRAY="^TMP(""BQIPTAPT"",UID,"
+26 DO PEND^BSDU2(DFN,0,.ARRAY)
+27 SET DRANGE=$$DATE^BQIUL1($GET(DRANGE))
+28 IF DRANGE=""
SET DRANGE=9999999
+29 SET DRANGE=DRANGE+.2401
+30 SET I=1
+31 FOR
SET I=$ORDER(^TMP("BQIPTAPT",UID,I))
IF 'I
QUIT
Begin DoDot:1
+32 SET APDATA=^TMP("BQIPTAPT",UID,I)
+33 SET APDTTM=$PIECE(APDATA,"^")
SET APCLIN=$PIECE(APDATA,"^",2)
+34 SET APDTTM=$TRANSLATE($EXTRACT(APDTTM,1,7)_$EXTRACT(APDTTM,9,18),"@"," ")
+35 SET FMDTTM=$$DATE^BQIUL1(APDTTM)
+36 IF FMDTTM>DRANGE
QUIT
+37 FOR
IF $EXTRACT(APCLIN,$LENGTH(APCLIN))'=" "
QUIT
SET APCLIN=$EXTRACT(APCLIN,1,($LENGTH(APCLIN)-1))
+38 SET CLIEN=^TMP("BQIPTAPT",UID,I,0)
SET DEFPRV=$$DCPRV(CLIEN)
+39 SET CSTCD=""
IF CLIEN'=""
SET CSTCD=$$GET1^DIQ(40.7,CLIEN_",",1,"E")
+40 SET BQII=BQII+1
SET @DATA@(BQII)=$$FMTE^BQIUL1($PIECE(APDATA,"^"))_"^"_APCLIN_" "_CSTCD_"^"_DEFPRV_$CHAR(30)
End DoDot:1
+41 ;
+42 ; Drop down to DONE
+43 ;
DONE ; -- exit code
+1 KILL ^TMP("BQIPTAPT",UID)
+2 SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
+3 QUIT
+4 ;
HDR ;
+1 SET @DATA@(BQII)="D00015AP_DATE^T00050AP_CLIN^T00050DEF_PRV"_$CHAR(30)
+2 QUIT
+3 ;
DCPRV(CLIEN) ;EP - Loop thru Clinic Providers and Return Default Provider.
+1 ; DCY returns as the name of the default clinic provider.
+2 NEW DCX,DCY,FOUND
+3 SET (DCX,FOUND)=0
+4 SET DCY=$PIECE($GET(^SC(CLIEN,0)),U,13)
+5 IF DCY=""
Begin DoDot:1
+6 FOR
SET DCX=$ORDER(^SC(CLIEN,"PR",DCX))
IF 'DCX!FOUND
QUIT
Begin DoDot:2
+7 IF $PIECE($GET(^SC(CLIEN,"PR",DCX,0)),U,2)=1
SET DCY=+^SC(CLIEN,"PR",DCX,0)
SET FOUND=1
End DoDot:2
End DoDot:1
+8 IF $GET(DCY)
SET DCY=$$GET1^DIQ(200,DCY,.01)
+9 QUIT $GET(DCY)
+10 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(BQII)
IF $DATA(DATA)
SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
+6 QUIT
