BQISYPNL ;GDIT/HS/ALA-Users Panel Autopop Report ; 12 Aug 2015 7:24 AM
;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
;
;
EN(DATA,FAKE) ;EP -- BQI GET AUTOPOP REPORT
NEW UID,II,HDR,DZ,CT,IEN,VALUE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQISYPNL",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPNL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00030USER^D00030LAST_DATETIME^I00010ATLOG^I00010NIGHT"
S @DATA@(II)=HDR_$C(30)
;
S DZ=""
F S DZ=$O(^BQICARE("AC","A",DZ)) Q:DZ="" D
. S CT=0,IEN=""
. S $P(VALUE(DZ),U,1)=$$FMTE^BQIUL1($P(^BQICARE(DZ,0),U,6)\1)
. F S IEN=$O(^BQICARE("AC","A",DZ,IEN)) Q:IEN="" S CT=CT+1,$P(VALUE(DZ),"^",2)=CT
. S $P(VALUE(DZ),U,3)=0
;
S DZ=""
F S DZ=$O(^BQICARE("AC","N",DZ)) Q:DZ="" D
. S CT=0,IEN=""
. S $P(VALUE(DZ),U,1)=$$FMTE^BQIUL1($P(^BQICARE(DZ,0),U,6)\1)
. F S IEN=$O(^BQICARE("AC","N",DZ,IEN)) Q:IEN="" S CT=CT+1,$P(VALUE(DZ),"^",3)=CT
. I $P(VALUE(DZ),"^",2)="" S $P(VALUE(DZ),"^",2)=0
;
S DZ=""
F S DZ=$O(VALUE(DZ)) Q:DZ="" D
. S II=II+1,@DATA@(II)=$P($G(^VA(200,DZ,0)),U,1)_U_VALUE(DZ)_$C(30)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
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(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
REF(DATA,FAKE) ;EP -- BQI GET REFERRAL TEXT
NEW UID,II,HDR,VALUE,RANGE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQISYRFP",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPNL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00060REF_TEXT"
S @DATA@(II)=HDR_$C(30)
S VALUE=$P($G(^BQI(90508,1,16)),"^",4) I VALUE="" S VALUE="T-12M"
S RANGE=$$FMTE^XLFDT($$DATE^BQIUL1(VALUE))_" - "_$$FMTE^XLFDT(DT,1)
S II=II+1,@DATA@(II)="Referrals for the dates of "_RANGE_$C(30)
G DONE
;
CON(DATA,FAKE) ;EP -- BQI GET CONSULT TEXT
NEW UID,II,HDR,VALUE,RANGE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQISYCNP",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPNL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00060CON_TEXT"
S @DATA@(II)=HDR_$C(30)
S VALUE=$P($G(^BQI(90508,1,16)),"^",5) I VALUE="" S VALUE="T-"_$$GET^XPAR("ALL","GMRC CONSULT LIST DAYS")
S RANGE=$$FMTE^XLFDT($$DATE^BQIUL1(VALUE))_" - "_$$FMTE^XLFDT(DT,1)
S II=II+1,@DATA@(II)="Consults for the dates of "_RANGE_$C(30)
G DONE
BQISYPNL ;GDIT/HS/ALA-Users Panel Autopop Report ; 12 Aug 2015 7:24 AM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
+2 ;
+3 ;
EN(DATA,FAKE) ;EP -- BQI GET AUTOPOP REPORT
+1 NEW UID,II,HDR,DZ,CT,IEN,VALUE
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQISYPNL",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPNL D UNWIND^%ZTER"
+8 ;
+9 SET HDR="T00030USER^D00030LAST_DATETIME^I00010ATLOG^I00010NIGHT"
+10 SET @DATA@(II)=HDR_$CHAR(30)
+11 ;
+12 SET DZ=""
+13 FOR
SET DZ=$ORDER(^BQICARE("AC","A",DZ))
IF DZ=""
QUIT
Begin DoDot:1
+14 SET CT=0
SET IEN=""
+15 SET $PIECE(VALUE(DZ),U,1)=$$FMTE^BQIUL1($PIECE(^BQICARE(DZ,0),U,6)\1)
+16 FOR
SET IEN=$ORDER(^BQICARE("AC","A",DZ,IEN))
IF IEN=""
QUIT
SET CT=CT+1
SET $PIECE(VALUE(DZ),"^",2)=CT
+17 SET $PIECE(VALUE(DZ),U,3)=0
End DoDot:1
+18 ;
+19 SET DZ=""
+20 FOR
SET DZ=$ORDER(^BQICARE("AC","N",DZ))
IF DZ=""
QUIT
Begin DoDot:1
+21 SET CT=0
SET IEN=""
+22 SET $PIECE(VALUE(DZ),U,1)=$$FMTE^BQIUL1($PIECE(^BQICARE(DZ,0),U,6)\1)
+23 FOR
SET IEN=$ORDER(^BQICARE("AC","N",DZ,IEN))
IF IEN=""
QUIT
SET CT=CT+1
SET $PIECE(VALUE(DZ),"^",3)=CT
+24 IF $PIECE(VALUE(DZ),"^",2)=""
SET $PIECE(VALUE(DZ),"^",2)=0
End DoDot:1
+25 ;
+26 SET DZ=""
+27 FOR
SET DZ=$ORDER(VALUE(DZ))
IF DZ=""
QUIT
Begin DoDot:1
+28 SET II=II+1
SET @DATA@(II)=$PIECE($GET(^VA(200,DZ,0)),U,1)_U_VALUE(DZ)_$CHAR(30)
End DoDot:1
+29 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
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(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
REF(DATA,FAKE) ;EP -- BQI GET REFERRAL TEXT
+1 NEW UID,II,HDR,VALUE,RANGE
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQISYRFP",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPNL D UNWIND^%ZTER"
+8 ;
+9 SET HDR="T00060REF_TEXT"
+10 SET @DATA@(II)=HDR_$CHAR(30)
+11 SET VALUE=$PIECE($GET(^BQI(90508,1,16)),"^",4)
IF VALUE=""
SET VALUE="T-12M"
+12 SET RANGE=$$FMTE^XLFDT($$DATE^BQIUL1(VALUE))_" - "_$$FMTE^XLFDT(DT,1)
+13 SET II=II+1
SET @DATA@(II)="Referrals for the dates of "_RANGE_$CHAR(30)
+14 GOTO DONE
+15 ;
CON(DATA,FAKE) ;EP -- BQI GET CONSULT TEXT
+1 NEW UID,II,HDR,VALUE,RANGE
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQISYCNP",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPNL D UNWIND^%ZTER"
+8 ;
+9 SET HDR="T00060CON_TEXT"
+10 SET @DATA@(II)=HDR_$CHAR(30)
+11 SET VALUE=$PIECE($GET(^BQI(90508,1,16)),"^",5)
IF VALUE=""
SET VALUE="T-"_$$GET^XPAR("ALL","GMRC CONSULT LIST DAYS")
+12 SET RANGE=$$FMTE^XLFDT($$DATE^BQIUL1(VALUE))_" - "_$$FMTE^XLFDT(DT,1)
+13 SET II=II+1
SET @DATA@(II)="Consults for the dates of "_RANGE_$CHAR(30)
+14 GOTO DONE
