BQIRGVW.m

BQIRGVW ;PRXM/HC/ALA-Register View ; 08 Nov 2007  1:04 PM

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

 ;

EN(DATA,REG) ; EP -- BQI GET REGISTER VIEW

 ; Input

 ;   REG - Register name

 ;Output

 ;  DATA  - name of global (passed by reference) in which the data

 ;          is stored

 ;Variables used

 ;  UID - TMP global subscript. Will be either $J or "Z" plus the

 ;        TaskMan Task ID

 ;        

 NEW UID,II,MVALUE,IEN,GIEN,SIEN,DISPLAY,SOR,SDIR,TEMPL,LYIEN,SUB

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

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

 K @DATA

 S II=0

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

 ;

 S @DATA@(II)="T01024DISPLAY_ORDER^T00300SORT_ORDER^T00300SORT_DIRECTION"_$C(30)

 ;

 S REG=$G(REG,"") I REG="" G DONE

 S RGIEN=$O(^BQI(90506.3,"B",REG,"")) I RGIEN="" G DONE

 S ORD="",DISPLAY="",SOR="",SDIR=""

 F  S ORD=$O(^BQI(90506.3,RGIEN,10,"C",ORD)) Q:ORD=""  D

 . S RIEN=""

 . F  S RIEN=$O(^BQI(90506.3,RGIEN,10,"C",ORD,RIEN)) Q:RIEN=""  D

 .. I $P(^BQI(90506.3,RGIEN,10,RIEN,0),U,4)'="S" Q

 .. S CODE=$P(^BQI(90506.3,RGIEN,10,RIEN,0),U,7) I CODE="" Q

 .. S TYPE=$P($G(^BQI(90506.3,RGIEN,10,RIEN,1)),U,1)

 .. S DISPLAY=DISPLAY_CODE_$C(29)

 ;.. ; If this is a multiple, go to the subdefinition

 ;.. ;I TYPE="M" D

 ;... NEW SNAME,SRIEN,SORD

 ;... S SNAME=$P(^BQI(90506.3,RGIEN,10,RIEN,0),U,1),CODE=""

 ;... S SRIEN=$O(^BQI(90506.3,"B",SNAME,"")) I SRIEN="" Q

 ;... S SORD=""

 ;... F  S SORD=$O(^BQI(90506.3,SRIEN,10,"C",SORD)) Q:SORD=""  D

 ;.... S SIEN=""

 ;.... F  S SIEN=$O(^BQI(90506.3,SRIEN,10,"C",SORD,SIEN)) Q:SIEN=""  D

 ;..... I $P(^BQI(90506.3,SRIEN,10,SIEN,0),U,4)'="S" Q

 ;..... S CD=$P(^BQI(90506.3,SRIEN,10,SIEN,0),U,7) I CD="" Q

 ;..... S CODE=CODE_CD_$C(29)

 ;... S CODE=$$TKO^BQIUL1(CODE,$C(29))

 ;

 S SUB=$$GET1^DIQ(90506.3,RGIEN_",",.07,"I")

 S DISPLAY=$S('SUB:$$DFNC^BQIPLVW(),1:"")_$C(29)_$$TKO^BQIUL1(DISPLAY,$C(29))

 S SORT=$$SFNC^BQIPLVW()

 S II=II+1,@DATA@(II)=DISPLAY_U_SORT_"^A"_$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

BQIRGVW   ;PRXM/HC/ALA-Register View ; 08 Nov 2007  1:04 PM

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

 +2       ;

EN(DATA,REG) ; EP -- BQI GET REGISTER VIEW

 +1       ; Input

 +2       ;   REG - Register name

 +3       ;Output

 +4       ;  DATA  - name of global (passed by reference) in which the data

 +5       ;          is stored

 +6       ;Variables used

 +7       ;  UID - TMP global subscript. Will be either $J or "Z" plus the

 +8       ;        TaskMan Task ID

 +9       ;        

 +10       NEW UID,II,MVALUE,IEN,GIEN,SIEN,DISPLAY,SOR,SDIR,TEMPL,LYIEN,SUB

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

 +12       SET DATA=$NAME(^TMP("BQIRGVW",UID))

 +13       KILL @DATA

 +14       SET II=0

 +15      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +16      ;

 +17       SET @DATA@(II)="T01024DISPLAY_ORDER^T00300SORT_ORDER^T00300SORT_DIRECTION"_$CHAR(30)

 +18      ;

 +19       SET REG=$GET(REG,"")

           IF REG=""

               GOTO DONE

 +20       SET RGIEN=$ORDER(^BQI(90506.3,"B",REG,""))

           IF RGIEN=""

               GOTO DONE

 +21       SET ORD=""

           SET DISPLAY=""

           SET SOR=""

           SET SDIR=""

 +22       FOR 

               SET ORD=$ORDER(^BQI(90506.3,RGIEN,10,"C",ORD))

               IF ORD=""

                   QUIT 

               Begin DoDot:1

 +23               SET RIEN=""

 +24               FOR 

                       SET RIEN=$ORDER(^BQI(90506.3,RGIEN,10,"C",ORD,RIEN))

                       IF RIEN=""

                           QUIT 

                       Begin DoDot:2

 +25                       IF $PIECE(^BQI(90506.3,RGIEN,10,RIEN,0),U,4)'="S"

                               QUIT 

 +26                       SET CODE=$PIECE(^BQI(90506.3,RGIEN,10,RIEN,0),U,7)

                           IF CODE=""

                               QUIT 

 +27                       SET TYPE=$PIECE($GET(^BQI(90506.3,RGIEN,10,RIEN,1)),U,1)

 +28                       SET DISPLAY=DISPLAY_CODE_$CHAR(29)

                       End DoDot:2

               End DoDot:1

 +29      ;.. ; If this is a multiple, go to the subdefinition

 +30      ;.. ;I TYPE="M" D

 +31      ;... NEW SNAME,SRIEN,SORD

 +32      ;... S SNAME=$P(^BQI(90506.3,RGIEN,10,RIEN,0),U,1),CODE=""

 +33      ;... S SRIEN=$O(^BQI(90506.3,"B",SNAME,"")) I SRIEN="" Q

 +34      ;... S SORD=""

 +35      ;... F  S SORD=$O(^BQI(90506.3,SRIEN,10,"C",SORD)) Q:SORD=""  D

 +36      ;.... S SIEN=""

 +37      ;.... F  S SIEN=$O(^BQI(90506.3,SRIEN,10,"C",SORD,SIEN)) Q:SIEN=""  D

 +38      ;..... I $P(^BQI(90506.3,SRIEN,10,SIEN,0),U,4)'="S" Q

 +39      ;..... S CD=$P(^BQI(90506.3,SRIEN,10,SIEN,0),U,7) I CD="" Q

 +40      ;..... S CODE=CODE_CD_$C(29)

 +41      ;... S CODE=$$TKO^BQIUL1(CODE,$C(29))

 +42      ;

 +43       SET SUB=$$GET1^DIQ(90506.3,RGIEN_",",.07,"I")

 +44       SET DISPLAY=$SELECT('SUB:$$DFNC^BQIPLVW(),1:"")_$CHAR(29)_$$TKO^BQIUL1(DISPLAY,$CHAR(29))

 +45       SET SORT=$$SFNC^BQIPLVW()

 +46       SET II=II+1

           SET @DATA@(II)=DISPLAY_U_SORT_"^A"_$CHAR(30)

 +47      ;

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