BQIRGDEF.m

BQIRGDEF ;PRXM/HC/ALA-Registry file definition ; 10 May 2007  4:36 PM

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

 Q

 ;

EN(DATA,RFILE) ;EP -- BQI GET REGISTER DISPLAY

 ;

 ;Input

 ;  RFILE - The registry file number or name

 ;

 NEW UID,II,IEN,VFIL,VALUE,ORD,VDATA,VDATA1,VDATA2,BJ

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

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

 K @DATA

 S II=0

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

 ;

 S VFIEN=$G(RFILE,"")

 ;

 S HDR="T00030RFILE_NAME^T00015RFILE_NUMBER^T00030DISPLAY_COLUMN^T00030INTERNAL_COLUMN^I00003SIZE^T00001COLUMN_TYPE^T00008CODE^T00001CODE_TYPE^T00030UPPER^"

 S HDR=HDR_"T00030LOWER^T00030DEFAULT^T00001ACTION^T00001REQ_OPT^T00036EXCLUSION^T00045VALIDATION^T00030VALID_INPUT^T00020TABLE^T00001TABLE_LOOKUP^"

 S HDR=HDR_"T00001PROV_SCREEN^T00150TABLE_SCREEN"_$C(30)

 S @DATA@(II)=HDR

 ;

 I VFIEN="" D  G DONE

 . S VFIL=0

 . F  S VFIL=$O(^BQI(90506.3,"D","R",VFIL)) Q:'VFIL  D VF(VFIL)

 ;

 S VFIEN=$$FIND1^DIC(90506.3,"","M",RFILE,"","","ERROR")

 D VF(VFIEN)

 ;

DONE ;

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

 Q

 ;

VF(VFIL) ;EP

 ;

 S VALUE=$$GET1^DIQ(90506.3,VFIL_",",.01,"E")_U_$$GET1^DIQ(90506.3,VFIL_",",.02,"E")

 S ORD=""

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

 . S IEN=""

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

 .. S VDATA=^BQI(90506.3,VFIL,10,IEN,0)

 .. S VDATA1=$G(^BQI(90506.3,VFIL,10,IEN,1))

 .. S VDATA2=$G(^BQI(90506.3,VFIL,10,IEN,2))

 .. S II=II+1,@DATA@(II)=VALUE_U_$P(VDATA,U,1,4)_U_$P(VDATA,U,7)_U

 .. F BJ=1:1:7 S @DATA@(II)=@DATA@(II)_$P(VDATA1,U,BJ)_U

 .. F BJ=1:1:5 S @DATA@(II)=@DATA@(II)_$P(VDATA2,U,BJ)_U

 .. S @DATA@(II)=@DATA@(II)_$G(^BQI(90506.3,VFIL,10,IEN,6))_$C(30)

 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

BQIRGDEF  ;PRXM/HC/ALA-Registry file definition ; 10 May 2007  4:36 PM

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

 +2        QUIT 

 +3       ;

EN(DATA,RFILE) ;EP -- BQI GET REGISTER DISPLAY

 +1       ;

 +2       ;Input

 +3       ;  RFILE - The registry file number or name

 +4       ;

 +5        NEW UID,II,IEN,VFIL,VALUE,ORD,VDATA,VDATA1,VDATA2,BJ

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

 +7        SET DATA=$NAME(^TMP("BQIRGDEF",UID))

 +8        KILL @DATA

 +9        SET II=0

 +10      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +11      ;

 +12       SET VFIEN=$GET(RFILE,"")

 +13      ;

 +14       SET HDR="T00030RFILE_NAME^T00015RFILE_NUMBER^T00030DISPLAY_COLUMN^T00030INTERNAL_COLUMN^I00003SIZE^T00001COLUMN_TYPE^T00008CODE^T00001CODE_TYPE^T00030UPPER^"

 +15       SET HDR=HDR_"T00030LOWER^T00030DEFAULT^T00001ACTION^T00001REQ_OPT^T00036EXCLUSION^T00045VALIDATION^T00030VALID_INPUT^T00020TABLE^T00001TABLE_LOOKUP^"

 +16       SET HDR=HDR_"T00001PROV_SCREEN^T00150TABLE_SCREEN"_$CHAR(30)

 +17       SET @DATA@(II)=HDR

 +18      ;

 +19       IF VFIEN=""

               Begin DoDot:1

 +20               SET VFIL=0

 +21               FOR 

                       SET VFIL=$ORDER(^BQI(90506.3,"D","R",VFIL))

                       IF 'VFIL

                           QUIT 

                       DO VF(VFIL)

               End DoDot:1

               GOTO DONE

 +22      ;

 +23       SET VFIEN=$$FIND1^DIC(90506.3,"","M",RFILE,"","","ERROR")

 +24       DO VF(VFIEN)

 +25      ;

DONE      ;

 +1        SET II=II+1

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

 +2        QUIT 

 +3       ;

VF(VFIL)  ;EP

 +1       ;

 +2        SET VALUE=$$GET1^DIQ(90506.3,VFIL_",",.01,"E")_U_$$GET1^DIQ(90506.3,VFIL_",",.02,"E")

 +3        SET ORD=""

 +4        FOR 

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

               IF ORD=""

                   QUIT 

               Begin DoDot:1

 +5                SET IEN=""

 +6                FOR 

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

                       IF IEN=""

                           QUIT 

                       Begin DoDot:2

 +7                        SET VDATA=^BQI(90506.3,VFIL,10,IEN,0)

 +8                        SET VDATA1=$GET(^BQI(90506.3,VFIL,10,IEN,1))

 +9                        SET VDATA2=$GET(^BQI(90506.3,VFIL,10,IEN,2))

 +10                       SET II=II+1

                           SET @DATA@(II)=VALUE_U_$PIECE(VDATA,U,1,4)_U_$PIECE(VDATA,U,7)_U

 +11                       FOR BJ=1:1:7

                               SET @DATA@(II)=@DATA@(II)_$PIECE(VDATA1,U,BJ)_U

 +12                       FOR BJ=1:1:5

                               SET @DATA@(II)=@DATA@(II)_$PIECE(VDATA2,U,BJ)_U

 +13                       SET @DATA@(II)=@DATA@(II)_$GET(^BQI(90506.3,VFIL,10,IEN,6))_$CHAR(30)

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

 +15      ;

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