BQIGPUTL.m

BQIGPUTL ;PRXM/HC/ALA - GPRA Utilities ; 10 Feb 2006  5:11 PM

 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59

 ;

 Q

 ;

SUM(BQIGYR,BQIND) ;EP -- Is indicator a summary indicator?

 ;

 ;Input

 ;  BQIGYR = GPRA Year

 ;  BQIND = Internal entry number of GPRA individual indicator

 ;  Only valid for CRS versions less than 8.0

 ;

 NEW BQIH,BQIY

 S BQIH=$$SPM() I BQIH=-1 Q 0

 S BQIY=$$LKP(BQIGYR) I BQIY=-1 Q 0

 I '$D(^BQI(90508,BQIH,20,BQIY,20,"B",BQIND)) Q 0

 Q 1

 ;

SPM() ;EP -- Get site parameter entry

 NEW DIC,X,Y,BGPHOME,BHM

 I $G(U)="" D DT^DICRW

 S BGPHOME=$$HME()

 ;

 S X=$$GET1^DIQ(4,BGPHOME,.01,"E"),DIC(0)="XZ",DIC="^BQI(90508,"

 D ^DIC

 I Y=-1 S $P(^BQI(90508,1,0),U,1)=BGPHOME,^BQI(90508,"B",BGPHOME,1)="",Y=1

 Q +Y

 ;

LKP(BQIGYR) ;EP -- Lookup CRS year in the parameter file

 NEW X,DA,DIC,Y

 ;

 ; Check to see if BQIH has already been defined, if not, define it

 I $G(BQIH)="" S BQIH=$$SPM()

 S X=BQIGYR,DA(1)=BQIH,DIC(0)="XZ",DIC="^BQI(90508,"_DA(1)_",20,"

 D ^DIC

 Q +Y

 ;

GFN(BQIHH,BQIYY) ;EP - Get GPRA global reference

 ;

 ;Input

 ;  BQIHH - Site parameter internal entry number

 ;  BQIYY - GPRA Year

 ;Output

 ;  BQIINDF  - FileMan file number for Indicators

 ;  BQIMEASF - FileMan file number of Individual Indicators

 ;

 NEW DA,IENS

 S DA(1)=BQIHH,DA=BQIYY

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

 S BQIINDF=$$GET1^DIQ(90508.01,IENS,.02,"E")

 S BQIMEASF=$$GET1^DIQ(90508.01,IENS,.03,"E")

 Q

 ;

HME() ;EP - Get Home Site

 NEW BHM,BHOME

 I $G(U)="" D DT^DICRW

 S BHM=$O(^BQI(90508,0))

 I BHM'="" S BHOME=$P($G(^BQI(90508,BHM,0)),U,1)

 I $G(BHOME)="" S BHOME=$P($G(^XTV(8989.3,1,"XUS")),U,17)

 ;S BHM=$O(^BGPSITE(0)) I BHM'="" S BHOME=$P($G(^BGPSITE(BHM,0)),U,1)

 Q $G(BHOME)

 ;

MEAS(GCODE) ;EP - Get the reverse direction code

 NEW BQIH,BQIYR,BQMEAS,VER

 S PDIR=""

 I $P(GCODE,"_",1)'?.N Q PDIR

 S YEAR=$P(GCODE,"_",1)

 S BQMEAS=$P(GCODE,"_",2)

 S BQIH=$$SPM()

 S BQIYR=$$LKP(YEAR)

 S VER=$$VERSION^XPDUTL("BGP")

 I VER>7.0 D

 . D GFN(BQIH,BQIYR)

 . S PDIR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1705,"E")

 Q PDIR

BQIGPUTL  ;PRXM/HC/ALA - GPRA Utilities ; 10 Feb 2006  5:11 PM

 +1       ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59

 +2       ;

 +3        QUIT 

 +4       ;

SUM(BQIGYR,BQIND) ;EP -- Is indicator a summary indicator?

 +1       ;

 +2       ;Input

 +3       ;  BQIGYR = GPRA Year

 +4       ;  BQIND = Internal entry number of GPRA individual indicator

 +5       ;  Only valid for CRS versions less than 8.0

 +6       ;

 +7        NEW BQIH,BQIY

 +8        SET BQIH=$$SPM()

           IF BQIH=-1

               QUIT 0

 +9        SET BQIY=$$LKP(BQIGYR)

           IF BQIY=-1

               QUIT 0

 +10       IF '$DATA(^BQI(90508,BQIH,20,BQIY,20,"B",BQIND))

               QUIT 0

 +11       QUIT 1

 +12      ;

SPM()     ;EP -- Get site parameter entry

 +1        NEW DIC,X,Y,BGPHOME,BHM

 +2        IF $GET(U)=""

               DO DT^DICRW

 +3        SET BGPHOME=$$HME()

 +4       ;

 +5        SET X=$$GET1^DIQ(4,BGPHOME,.01,"E")

           SET DIC(0)="XZ"

           SET DIC="^BQI(90508,"

 +6        DO ^DIC

 +7        IF Y=-1

               SET $PIECE(^BQI(90508,1,0),U,1)=BGPHOME

               SET ^BQI(90508,"B",BGPHOME,1)=""

               SET Y=1

 +8        QUIT +Y

 +9       ;

LKP(BQIGYR) ;EP -- Lookup CRS year in the parameter file

 +1        NEW X,DA,DIC,Y

 +2       ;

 +3       ; Check to see if BQIH has already been defined, if not, define it

 +4        IF $GET(BQIH)=""

               SET BQIH=$$SPM()

 +5        SET X=BQIGYR

           SET DA(1)=BQIH

           SET DIC(0)="XZ"

           SET DIC="^BQI(90508,"_DA(1)_",20,"

 +6        DO ^DIC

 +7        QUIT +Y

 +8       ;

GFN(BQIHH,BQIYY) ;EP - Get GPRA global reference

 +1       ;

 +2       ;Input

 +3       ;  BQIHH - Site parameter internal entry number

 +4       ;  BQIYY - GPRA Year

 +5       ;Output

 +6       ;  BQIINDF  - FileMan file number for Indicators

 +7       ;  BQIMEASF - FileMan file number of Individual Indicators

 +8       ;

 +9        NEW DA,IENS

 +10       SET DA(1)=BQIHH

           SET DA=BQIYY

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

 +12       SET BQIINDF=$$GET1^DIQ(90508.01,IENS,.02,"E")

 +13       SET BQIMEASF=$$GET1^DIQ(90508.01,IENS,.03,"E")

 +14       QUIT 

 +15      ;

HME()     ;EP - Get Home Site

 +1        NEW BHM,BHOME

 +2        IF $GET(U)=""

               DO DT^DICRW

 +3        SET BHM=$ORDER(^BQI(90508,0))

 +4        IF BHM'=""

               SET BHOME=$PIECE($GET(^BQI(90508,BHM,0)),U,1)

 +5        IF $GET(BHOME)=""

               SET BHOME=$PIECE($GET(^XTV(8989.3,1,"XUS")),U,17)

 +6       ;S BHM=$O(^BGPSITE(0)) I BHM'="" S BHOME=$P($G(^BGPSITE(BHM,0)),U,1)

 +7        QUIT $GET(BHOME)

 +8       ;

MEAS(GCODE) ;EP - Get the reverse direction code

 +1        NEW BQIH,BQIYR,BQMEAS,VER

 +2        SET PDIR=""

 +3        IF $PIECE(GCODE,"_",1)'?.N

               QUIT PDIR

 +4        SET YEAR=$PIECE(GCODE,"_",1)

 +5        SET BQMEAS=$PIECE(GCODE,"_",2)

 +6        SET BQIH=$$SPM()

 +7        SET BQIYR=$$LKP(YEAR)

 +8        SET VER=$$VERSION^XPDUTL("BGP")

 +9        IF VER>7.0

               Begin DoDot:1

 +10               DO GFN(BQIH,BQIYR)

 +11               SET PDIR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1705,"E")

               End DoDot:1

 +12       QUIT PDIR