BQIRGLST.m

BQIRGLST ;VNGT/HS/ALA - Get register view ; 18 May 2007  2:25 PM

 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 ;

 ;

GET(DATA,REG) ;EP -- BQI GET REGISTER LIST

 NEW UID,II,BQILOC,LII,BI

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

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

 K @DATA

 S II=0

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

 ;

 S REG=$G(REG,"")

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

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

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

 ;

 ; If want to get all view fields for a specified register

 I REG'="" D

 . NEW RN

 . S RN=$O(^BQI(90506.5,"B",REG,"")) I RN="" Q

 . S RTYP=$P(^BQI(90506.5,RN,0),U,2) I RTYP="" Q

 . ;S SRC=$P(^DD(90506.1,2.01,0),"^",3)

 . ;F BI=1:1:$L(SRC,";") I $P($P(SRC,";",BI),":",2)=REG S RTYP=$P($P(SRC,";",BI),":",1)

 . D EN^BQIMSLST(.BQILOC,RTYP)

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

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

 ;

 ; If want to get all view fields for all registers

 I REG="" D

 . NEW IEN,REG

 . S IEN=0

 . F  S IEN=$O(^BQI(90507,IEN)) Q:'IEN  D

 .. ; If the register is not active, quit

 .. I $$GET1^DIQ(90507,IEN_",",.08,"I") Q

 .. S REG=$$GET1^DIQ(90507,IEN_",",.01,"E"),RTYP=""

 .. S RN=$O(^BQI(90506.5,"D",IEN,"")) I RN="" Q

 .. S RTYP=$P(^BQI(90506.5,RN,0),U,2)

 .. ;S SRC=$P(^DD(90506.1,2.01,0),"^",3)

 .. ;F BI=1:1:$L(SRC,";") I $P($P(SRC,";",BI),":",2)=REG S RTYP=$P($P(SRC,";",BI),":",1)

 .. I RTYP="" Q

 .. I RTYP="D"!(RTYP="G")!(RTYP="R") Q

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

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

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

 .. K @BQILOC,REG,RTYP

 ;

DONE ;

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

 K @BQILOC

 Q

BQIRGLST  ;VNGT/HS/ALA - Get register view ; 18 May 2007  2:25 PM

 +1       ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 +2       ;

 +3       ;

GET(DATA,REG) ;EP -- BQI GET REGISTER LIST

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

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

 +3        SET DATA=$NAME(^TMP("BQIRGLST",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        SET REG=$GET(REG,"")

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

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

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

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

 +12      ;

 +13      ; If want to get all view fields for a specified register

 +14       IF REG'=""

               Begin DoDot:1

 +15               NEW RN

 +16               SET RN=$ORDER(^BQI(90506.5,"B",REG,""))

                   IF RN=""

                       QUIT 

 +17               SET RTYP=$PIECE(^BQI(90506.5,RN,0),U,2)

                   IF RTYP=""

                       QUIT 

 +18      ;S SRC=$P(^DD(90506.1,2.01,0),"^",3)

 +19      ;F BI=1:1:$L(SRC,";") I $P($P(SRC,";",BI),":",2)=REG S RTYP=$P($P(SRC,";",BI),":",1)

 +20               DO EN^BQIMSLST(.BQILOC,RTYP)

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

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

                       SET II=II+1

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

               End DoDot:1

 +23      ;

 +24      ; If want to get all view fields for all registers

 +25       IF REG=""

               Begin DoDot:1

 +26               NEW IEN,REG

 +27               SET IEN=0

 +28               FOR 

                       SET IEN=$ORDER(^BQI(90507,IEN))

                       IF 'IEN

                           QUIT 

                       Begin DoDot:2

 +29      ; If the register is not active, quit

 +30                       IF $$GET1^DIQ(90507,IEN_",",.08,"I")

                               QUIT 

 +31                       SET REG=$$GET1^DIQ(90507,IEN_",",.01,"E")

                           SET RTYP=""

 +32                       SET RN=$ORDER(^BQI(90506.5,"D",IEN,""))

                           IF RN=""

                               QUIT 

 +33                       SET RTYP=$PIECE(^BQI(90506.5,RN,0),U,2)

 +34      ;S SRC=$P(^DD(90506.1,2.01,0),"^",3)

 +35      ;F BI=1:1:$L(SRC,";") I $P($P(SRC,";",BI),":",2)=REG S RTYP=$P($P(SRC,";",BI),":",1)

 +36                       IF RTYP=""

                               QUIT 

 +37                       IF RTYP="D"!(RTYP="G")!(RTYP="R")

                               QUIT 

 +38                       DO EN^BQIMSLST(.BQILOC,RTYP)

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

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

                               SET II=II+1

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

 +41                       KILL @BQILOC,REG,RTYP

                       End DoDot:2

               End DoDot:1

 +42      ;

DONE      ;

 +1        SET II=II+1

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

 +2        KILL @BQILOC

 +3        QUIT