- 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
