- 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
