BKMVFLD.m

BKMVFLD ;PRXM/HC/CLT - SELECT THE SUBFILE AND FIELD NUMBER ; 17 Mar 2005  5:40 PM

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

 QUIT

 ;

FLDINFO(BKMVIEN) ;EP - Called by EN1^BKMVAUP - Determine field name based on IEN from File 90455

 ; Replaced former call to ^BKMVFLD 

 ; Input variables:

 ;  BKMVIEN - IEN from File 90455 Audit

 ; Output variables:

 ;  Returns FIELDNAME^FIELDTYP

 N BKMFLDNO,BKMFLDNM,BKMFLDTY,BKMFILNO,BKMV

 S (BKMFLDNM,BKMFLDTY,BKMFILNO,BKMFLDNO)=""

 S BKMFLDNO=$$GET1^DIQ(90455,BKMVIEN_",",3)

 I BKMFLDNO'="" D

 . ; Determine the appropriate subfile reference, if necessary

 . S BKMFILNO=$S(BKMFLDNO>40&(BKMFLDNO<50):90451.03,BKMFLDNO>50:90451.07,1:90451.01)

 . ;I BKMFLDNO>20,BKMFLDNO<40 S BKMFLDNO=BKMFLDNO-20

 . I BKMFLDNO>40,BKMFLDNO<41 S BKMFLDNO=$S(BKMFLDNO=40.01:.01,BKMFLDNO=40.1:1,BKMFLDNO=40.2:2,BKMFLDNO=40.3:3,1:"")

 . I BKMFLDNO>50,BKMFLDNO<51 S BKMFLDNO=$S(BKMFLDNO=50.01:.01,BKMFLDNO=50.1:1,BKMFLDNO=50.2:2,1:"")

 . ;I BKMFLDNO>41 S BKMFLDNO=$S(BKMFLDNO=41.1:1,1:.01)

 . I BKMFILNO'="",BKMFLDNO'="" D

 . . K BKMV

 . . D FIELD^DID(BKMFILNO,BKMFLDNO,"","LABEL;TYPE","BKMV")

 . . S BKMFLDNM=$G(BKMV("LABEL"))

 . . S BKMFLDTY=$G(BKMV("TYPE"))

 . . K BKMV

 Q BKMFLDNM_"^"_BKMFLDTY_"^"_BKMFILNO_"^"_BKMFLDNO

 ;

CODEDESC(BKMFILNO,BKMFLDNO,BKMFLD) ; EP

 N BKMDESC,BKMSLCT,BKMSET,BKMI

 S BKMDESC=""

 S BKMSET=$$GET1^DID(BKMFILNO,BKMFLDNO,"","POINTER")

 I $L(BKMSET,";")>1 D

 . ;S BKMSET=$TR(BKMSET,";",",")

 . S BKMSLCT=""

 . ; Loop through SET of CODES to build $SELECT statement

 . F BKMI=1:1:$L(BKMSET,";")-1 D

 . . S BKMSLCT=BKMSLCT_"BKMFLD="""_$P($P(BKMSET,";",BKMI),":",1)_""":"""_$P($P(BKMSET,";",BKMI),":",2)_""","

 . S BKMSLCT=BKMSLCT_"1:"""""

 . S BKMSLCT="S BKMDESC=$S("_BKMSLCT_")"

 . X BKMSLCT

 Q BKMDESC

 ;

PNTRDESC(BKMFILNO,BKMFLDNO,BKMFLD) ; EP

 N BKMDESC,BKMSPCFR,BKMPFLNO

 S BKMDESC=""

 S BKMSPCFR=$$GET1^DID(BKMFILNO,BKMFLDNO,"","SPECIFIER")

 I BKMSPCFR'="" D

 . S BKMPFLNO=$P($P(BKMSPCFR,"P",2),"'",1)

 . I BKMPFLNO'="" S BKMDESC=$$GET1^DIQ(BKMPFLNO,BKMFLD_",",.01,"E")

 Q BKMDESC

 ;

 ;

BKMVFLD   ;PRXM/HC/CLT - SELECT THE SUBFILE AND FIELD NUMBER ; 17 Mar 2005  5:40 PM

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

 +2        QUIT 

 +3       ;

FLDINFO(BKMVIEN) ;EP - Called by EN1^BKMVAUP - Determine field name based on IEN from File 90455

 +1       ; Replaced former call to ^BKMVFLD 

 +2       ; Input variables:

 +3       ;  BKMVIEN - IEN from File 90455 Audit

 +4       ; Output variables:

 +5       ;  Returns FIELDNAME^FIELDTYP

 +6        NEW BKMFLDNO,BKMFLDNM,BKMFLDTY,BKMFILNO,BKMV

 +7        SET (BKMFLDNM,BKMFLDTY,BKMFILNO,BKMFLDNO)=""

 +8        SET BKMFLDNO=$$GET1^DIQ(90455,BKMVIEN_",",3)

 +9        IF BKMFLDNO'=""

               Begin DoDot:1

 +10      ; Determine the appropriate subfile reference, if necessary

 +11               SET BKMFILNO=$SELECT(BKMFLDNO>40&(BKMFLDNO<50):90451.03,BKMFLDNO>50:90451.07,1:90451.01)

 +12      ;I BKMFLDNO>20,BKMFLDNO<40 S BKMFLDNO=BKMFLDNO-20

 +13               IF BKMFLDNO>40

                       IF BKMFLDNO<41

                           SET BKMFLDNO=$SELECT(BKMFLDNO=40.01:.01,BKMFLDNO=40.1:1,BKMFLDNO=40.2:2,BKMFLDNO=40.3:3,1:"")

 +14               IF BKMFLDNO>50

                       IF BKMFLDNO<51

                           SET BKMFLDNO=$SELECT(BKMFLDNO=50.01:.01,BKMFLDNO=50.1:1,BKMFLDNO=50.2:2,1:"")

 +15      ;I BKMFLDNO>41 S BKMFLDNO=$S(BKMFLDNO=41.1:1,1:.01)

 +16               IF BKMFILNO'=""

                       IF BKMFLDNO'=""

                           Begin DoDot:2

 +17                           KILL BKMV

 +18                           DO FIELD^DID(BKMFILNO,BKMFLDNO,"","LABEL;TYPE","BKMV")

 +19                           SET BKMFLDNM=$GET(BKMV("LABEL"))

 +20                           SET BKMFLDTY=$GET(BKMV("TYPE"))

 +21                           KILL BKMV

                           End DoDot:2

               End DoDot:1

 +22       QUIT BKMFLDNM_"^"_BKMFLDTY_"^"_BKMFILNO_"^"_BKMFLDNO

 +23      ;

CODEDESC(BKMFILNO,BKMFLDNO,BKMFLD) ; EP

 +1        NEW BKMDESC,BKMSLCT,BKMSET,BKMI

 +2        SET BKMDESC=""

 +3        SET BKMSET=$$GET1^DID(BKMFILNO,BKMFLDNO,"","POINTER")

 +4        IF $LENGTH(BKMSET,";")>1

               Begin DoDot:1

 +5       ;S BKMSET=$TR(BKMSET,";",",")

 +6                SET BKMSLCT=""

 +7       ; Loop through SET of CODES to build $SELECT statement

 +8                FOR BKMI=1:1:$LENGTH(BKMSET,";")-1

                       Begin DoDot:2

 +9                        SET BKMSLCT=BKMSLCT_"BKMFLD="""_$PIECE($PIECE(BKMSET,";",BKMI),":",1)_""":"""_$PIECE($PIECE(BKMSET,";",BKMI),":",2)_""","

                       End DoDot:2

 +10               SET BKMSLCT=BKMSLCT_"1:"""""

 +11               SET BKMSLCT="S BKMDESC=$S("_BKMSLCT_")"

 +12               XECUTE BKMSLCT

               End DoDot:1

 +13       QUIT BKMDESC

 +14      ;

PNTRDESC(BKMFILNO,BKMFLDNO,BKMFLD) ; EP

 +1        NEW BKMDESC,BKMSPCFR,BKMPFLNO

 +2        SET BKMDESC=""

 +3        SET BKMSPCFR=$$GET1^DID(BKMFILNO,BKMFLDNO,"","SPECIFIER")

 +4        IF BKMSPCFR'=""

               Begin DoDot:1

 +5                SET BKMPFLNO=$PIECE($PIECE(BKMSPCFR,"P",2),"'",1)

 +6                IF BKMPFLNO'=""

                       SET BKMDESC=$$GET1^DIQ(BKMPFLNO,BKMFLD_",",.01,"E")

               End DoDot:1

 +7        QUIT BKMDESC

 +8       ;

 +9       ;