BQIPLRFU.m

BQIPLRFU ;GDIT/HS/ALA-Referrals Utility ; 06 Jan 2015  8:34 AM

 ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27

 ;

 ;

REF(DATA,FAKE) ;EP -- BQI GET REFERRALS LIST

 NEW UID,II,BQILOC,LII,BI

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIUTB2",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIUTB1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 D EN^BQIMSLST(.BQILOC,"D")

 S LII=$O(@BQILOC@(""),-1)

 F II=0:1:LII-1 S @DATA@(II)=@BQILOC@(II)

 D EN^BQIMSLST(.BQILOC,"RF")

 S LII=$O(@BQILOC@(""),-1)

 F BI=1:1:LII-1 S II=II+1,@DATA@(II)=@BQILOC@(BI)

 ;

 S II=II+1,@DATA@(II)=$C(31)

 K @BQILOC

 Q

 ;

CON(DATA,FAKE) ;EP -- BQI GET CONSULTS LIST

 NEW UID,II,BQILOC,LII,BI,EDIT,BATCH

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIUTB2",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIUTB1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 D EN^BQIMSLST(.BQILOC,"D")

 S LII=$O(@BQILOC@(""),-1)

 F II=0:1:LII-1 S @DATA@(II)=@BQILOC@(II)

 D EN^BQIMSLST(.BQILOC,"CN")

 S LII=$O(@BQILOC@(""),-1)

 F BI=1:1:LII-1 S II=II+1,@DATA@(II)=@BQILOC@(BI)

 ;

 S II=II+1,@DATA@(II)=$C(31)

 K @BQILOC

 Q

BQIPLRFU  ;GDIT/HS/ALA-Referrals Utility ; 06 Jan 2015  8:34 AM

 +1       ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27

 +2       ;

 +3       ;

REF(DATA,FAKE) ;EP -- BQI GET REFERRALS LIST

 +1        NEW UID,II,BQILOC,LII,BI

 +2        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +3        SET DATA=$NAME(^TMP("BQIUTB2",UID))

 +4        KILL @DATA

 +5        SET II=0

 +6       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIUTB1 D UNWIND^%ZTER"

 +7       ;

 +8        DO EN^BQIMSLST(.BQILOC,"D")

 +9        SET LII=$ORDER(@BQILOC@(""),-1)

 +10       FOR II=0:1:LII-1

               SET @DATA@(II)=@BQILOC@(II)

 +11       DO EN^BQIMSLST(.BQILOC,"RF")

 +12       SET LII=$ORDER(@BQILOC@(""),-1)

 +13       FOR BI=1:1:LII-1

               SET II=II+1

               SET @DATA@(II)=@BQILOC@(BI)

 +14      ;

 +15       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +16       KILL @BQILOC

 +17       QUIT 

 +18      ;

CON(DATA,FAKE) ;EP -- BQI GET CONSULTS LIST

 +1        NEW UID,II,BQILOC,LII,BI,EDIT,BATCH

 +2        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +3        SET DATA=$NAME(^TMP("BQIUTB2",UID))

 +4        KILL @DATA

 +5        SET II=0

 +6       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIUTB1 D UNWIND^%ZTER"

 +7       ;

 +8        DO EN^BQIMSLST(.BQILOC,"D")

 +9        SET LII=$ORDER(@BQILOC@(""),-1)

 +10       FOR II=0:1:LII-1

               SET @DATA@(II)=@BQILOC@(II)

 +11       DO EN^BQIMSLST(.BQILOC,"CN")

 +12       SET LII=$ORDER(@BQILOC@(""),-1)

 +13       FOR BI=1:1:LII-1

               SET II=II+1

               SET @DATA@(II)=@BQILOC@(BI)

 +14      ;

 +15       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +16       KILL @BQILOC

 +17       QUIT