BQIRGHML.m

BQIRGHML ;PRXM/HC/ALA-HMS Multiples ; 07 Nov 2007  7:21 PM

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

 ;

 Q

 ;

EN(HEADR,VALUE,BQIDFN,HFIL,HFLD,DISPLAY) ;

 NEW BQRIEN,HIVIEN,IENS,DA

 D FIELD^DID(HFIL,HFLD,"","GLOBAL SUBSCRIPT LOCATION;SPECIFIER","HARRAY")

 S NOD=$P($G(HARRAY("GLOBAL SUBSCRIPT LOCATION")),";",1)

 S SBFIL=$G(HARRAY("SPECIFIER"))

 S SBFIL=$$STRIP^XLFSTR(SBFIL,"ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 S IEN=0,HEADR="T00030IEN^",VALUE=""

 S ORD=""

 F  S ORD=$O(DISPLAY(ORD)) Q:ORD=""  D

 . S HDR=$P(DISPLAY(ORD),U,1)

 . S HEADR=HEADR_HDR_"^"

 ;

 S BQRIEN=$$BKMIEN^BKMIXX3(BQIDFN) I BQRIEN="" Q ""

 S HIVIEN=$$HIVIEN^BKMIXX3() I HIVIEN="" Q ""

 ;

 F  S IEN=$O(^BKM(90451,BQRIEN,1,HIVIEN,NOD,IEN)) Q:'IEN  D

 . NEW DA,IENS

 . S DA(2)=BQRIEN,DA(1)=HIVIEN,DA=IEN,IENS=$$IENS^DILF(.DA)

 . S VALUE(IEN)=IENS_"^"

 . ; Get an array of the display order fields

 . S ORD=""

 . F  S ORD=$O(DISPLAY(ORD)) Q:ORD=""  D

 .. S FLD=$P(DISPLAY(ORD),U,2),TYPE=$P(DISPLAY(ORD),U,3)

 .. I TYPE'="D"!(TYPE'="X") S VAL=$$GET1^DIQ(SBFIL,IENS,FLD,"E")

 .. I TYPE="C"!(TYPE="T") S VAL=$$GET1^DIQ(SBFIL,IENS,FLD,"I")_$C(28)_$$GET1^DIQ(SBFIL,IENS,FLD,"E")

 .. I TYPE="D" S VAL=$$GET1^DIQ(SBFIL,IENS,FLD,"I"),VAL=$$FMTE^BQIUL1(VAL)

 .. I TYPE="W" D

 ... K HARRAY

 ... S VAL=$$GET1^DIQ(SBFIL,IENS,FLD,"Z","HARRAY")

 ... S LIEN=0,VAL=""

 ... F  S LIEN=$O(HARRAY(LIEN)) Q:'LIEN  D

 .... S VAL=VAL_HARRAY(LIEN,0)_$C(10)

 ... S VAL=$$TKO^BQIUL1(VAL,$C(10))

 .. S VALUE(IEN)=VALUE(IEN)_VAL_"^"

 Q

BQIRGHML  ;PRXM/HC/ALA-HMS Multiples ; 07 Nov 2007  7:21 PM

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

 +2       ;

 +3        QUIT 

 +4       ;

EN(HEADR,VALUE,BQIDFN,HFIL,HFLD,DISPLAY) ;

 +1        NEW BQRIEN,HIVIEN,IENS,DA

 +2        DO FIELD^DID(HFIL,HFLD,"","GLOBAL SUBSCRIPT LOCATION;SPECIFIER","HARRAY")

 +3        SET NOD=$PIECE($GET(HARRAY("GLOBAL SUBSCRIPT LOCATION")),";",1)

 +4        SET SBFIL=$GET(HARRAY("SPECIFIER"))

 +5        SET SBFIL=$$STRIP^XLFSTR(SBFIL,"ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 +6        SET IEN=0

           SET HEADR="T00030IEN^"

           SET VALUE=""

 +7        SET ORD=""

 +8        FOR 

               SET ORD=$ORDER(DISPLAY(ORD))

               IF ORD=""

                   QUIT 

               Begin DoDot:1

 +9                SET HDR=$PIECE(DISPLAY(ORD),U,1)

 +10               SET HEADR=HEADR_HDR_"^"

               End DoDot:1

 +11      ;

 +12       SET BQRIEN=$$BKMIEN^BKMIXX3(BQIDFN)

           IF BQRIEN=""

               QUIT ""

 +13       SET HIVIEN=$$HIVIEN^BKMIXX3()

           IF HIVIEN=""

               QUIT ""

 +14      ;

 +15       FOR 

               SET IEN=$ORDER(^BKM(90451,BQRIEN,1,HIVIEN,NOD,IEN))

               IF 'IEN

                   QUIT 

               Begin DoDot:1

 +16               NEW DA,IENS

 +17               SET DA(2)=BQRIEN

                   SET DA(1)=HIVIEN

                   SET DA=IEN

                   SET IENS=$$IENS^DILF(.DA)

 +18               SET VALUE(IEN)=IENS_"^"

 +19      ; Get an array of the display order fields

 +20               SET ORD=""

 +21               FOR 

                       SET ORD=$ORDER(DISPLAY(ORD))

                       IF ORD=""

                           QUIT 

                       Begin DoDot:2

 +22                       SET FLD=$PIECE(DISPLAY(ORD),U,2)

                           SET TYPE=$PIECE(DISPLAY(ORD),U,3)

 +23                       IF TYPE'="D"!(TYPE'="X")

                               SET VAL=$$GET1^DIQ(SBFIL,IENS,FLD,"E")

 +24                       IF TYPE="C"!(TYPE="T")

                               SET VAL=$$GET1^DIQ(SBFIL,IENS,FLD,"I")_$CHAR(28)_$$GET1^DIQ(SBFIL,IENS,FLD,"E")

 +25                       IF TYPE="D"

                               SET VAL=$$GET1^DIQ(SBFIL,IENS,FLD,"I")

                               SET VAL=$$FMTE^BQIUL1(VAL)

 +26                       IF TYPE="W"

                               Begin DoDot:3

 +27                               KILL HARRAY

 +28                               SET VAL=$$GET1^DIQ(SBFIL,IENS,FLD,"Z","HARRAY")

 +29                               SET LIEN=0

                                   SET VAL=""

 +30                               FOR 

                                       SET LIEN=$ORDER(HARRAY(LIEN))

                                       IF 'LIEN

                                           QUIT 

                                       Begin DoDot:4

 +31                                       SET VAL=VAL_HARRAY(LIEN,0)_$CHAR(10)

                                       End DoDot:4

 +32                               SET VAL=$$TKO^BQIUL1(VAL,$CHAR(10))

                               End DoDot:3

 +33                       SET VALUE(IEN)=VALUE(IEN)_VAL_"^"

                       End DoDot:2

               End DoDot:1

 +34       QUIT