BQIIPUPD ;VNGT/HS/ALA-IPC Update ; 26 May 2011 7:39 AM
;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
;
;
NCRS ;New CRS
; Change BQIGPUPD to change IPC Versions when new version of CRS is released
; take current IPC value and add one
NEW CRIPC,NUM,NWIPC,DA,DIC,Y
S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
F I=$L(CRIPC):-1:1 Q:$E(CRIPC,I,I)'?.N
S NUM=$E(CRIPC,I+1,$L(CRIPC)),NUM=NUM+1
S NWIPC="IPC"_NUM
S DA(1)=1,X=NWIPC,DIC="^BQI(90508,"_DA(1)_",22,",DIC(0)="LMNZ",DLAYGO=90508.022
I $G(^BQI(90508,1,22,0))="" S ^BQI(90508,1,22,0)="^90508.022^^"
D ^DIC
S $P(^BQI(90508,1,11),U,1)=NWIPC
Q
;
CCRS ;Current CRS
NEW CRIPC,CRN
S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
S CRN=$O(^BQI(90508,1,22,"B",CRIPC,"")) I CRN="" Q
I $G(^BQI(90508,1,22,CRN,1,0))="" S ^BQI(90508,1,22,CRN,1,0)="^90508.221^^"
; Add new entries
NEW BI,BJ,BK,BN,BQIUPD,ERROR,IENS,ND,NDATA,TEXT,VAL
F BI=1:1 S TEXT=$P($T(NONC+BI),";;",2) Q:TEXT="" D
. F BJ=1:1:$L(TEXT,"~") D
.. S NDATA=$P(TEXT,"~",BJ)
.. S ND=$P(NDATA,"|",1),VAL=$P(NDATA,"|",2)
.. I ND=0 D
... NEW DIC,X,Y,DA
... S DA(2)=1,DA(1)=CRN
... S DIC(0)="LQZ",DIC="^BQI(90508,"_DA(2)_",22,"_DA(1)_",1,",X=$P(VAL,U,1)
... D ^DIC
... S DA=+Y
... I DA=-1 K DO,DD D FILE^DICN S DA=+Y
... S IENS=$$IENS^DILF(.DA)
.. I ND=1 S BQIUPD(90508.221,IENS,1)=VAL Q
.. F BK=1:1:$L(VAL,"^") D
... S BN=$O(^DD(90508.221,"GL",ND,BK,"")) I BN="" Q
... I $P(VAL,"^",BK)'="" S BQIUPD(90508.221,IENS,BN)=$P(VAL,"^",BK) Q
... I $P(VAL,"^",BK)="" S BQIUPD(90508.221,IENS,BN)="@"
. D FILE^DIE("","BQIUPD","ERROR")
;
GP ; Get fields from CRS
NEW BQIH,BQIYR,BQIYDA,BQIMEASF,IDIN,MDATA,VAL
S BQIH=$$SPM^BQIGPUTL()
S BQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
S BQIYDA=$$LKP^BQIGPUTL(BQIYR)
D GFN^BQIGPUTL(BQIH,BQIYDA)
S BQIINDG=$$ROOT^DILFD(BQIMEASF,"",1)
S IDIN=0
F S IDIN=$O(@BQIINDG@(IDIN)) Q:'IDIN D
. S MDATA=$G(@BQIINDG@(IDIN,17)) I MDATA="" Q
. I +MDATA=0 Q
. I $P(MDATA,U,7)'=1 Q
. S VAL=BQIYR_"_"_IDIN
. D NE(VAL)
. S BQIUPD(90508.221,IENS,.02)="G",BQIUPD(90508.221,IENS,.04)=$P(MDATA,U,3)
. D FILE^DIE("","BQIUPD","ERROR")
Q
;
NE(VALUE) ; New Entry
NEW DIC,X,Y,DA
S DA(2)=1,DA(1)=CRN
S DIC(0)="LQZ",DIC="^BQI(90508,"_DA(2)_",22,"_DA(1)_",1,",X=$P(VALUE,U,1)
D ^DIC
S DA=+Y
I DA=-1 K DO,DD D FILE^DICN S DA=+Y
S IENS=$$IENS^DILF(.DA)
Q
;
NONC ; Non CRS definitions
;;0|IPC_REVG^R^S^Revenue Generated Per Visit~1|D EN^BQIIPRVG
;;0|IPC_CCPR^R^S^Continuity of Care Primary Provider~1|D EN^BQIIPCCP
;;0|IPC_PEMP^R^S^Empanelled Primary Care Provider~1|D EN^BQIIPEMP
;;0|IPC_CANC^R^C^Cancer Screening Bundle~1|
;;0|IPC_HRISK^R^H^Health Risk Screening Bundle~1|
;;0|IPC_OUTC^R^O^Outcome Measures Bundle~1|
BQIIPUPD ;VNGT/HS/ALA-IPC Update ; 26 May 2011 7:39 AM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
+2 ;
+3 ;
NCRS ;New CRS
+1 ; Change BQIGPUPD to change IPC Versions when new version of CRS is released
+2 ; take current IPC value and add one
+3 NEW CRIPC,NUM,NWIPC,DA,DIC,Y
+4 SET CRIPC=$PIECE($GET(^BQI(90508,1,11)),U,1)
+5 FOR I=$LENGTH(CRIPC):-1:1
IF $EXTRACT(CRIPC,I,I)'?.N
QUIT
+6 SET NUM=$EXTRACT(CRIPC,I+1,$LENGTH(CRIPC))
SET NUM=NUM+1
+7 SET NWIPC="IPC"_NUM
+8 SET DA(1)=1
SET X=NWIPC
SET DIC="^BQI(90508,"_DA(1)_",22,"
SET DIC(0)="LMNZ"
SET DLAYGO=90508.022
+9 IF $GET(^BQI(90508,1,22,0))=""
SET ^BQI(90508,1,22,0)="^90508.022^^"
+10 DO ^DIC
+11 SET $PIECE(^BQI(90508,1,11),U,1)=NWIPC
+12 QUIT
+13 ;
CCRS ;Current CRS
+1 NEW CRIPC,CRN
+2 SET CRIPC=$PIECE($GET(^BQI(90508,1,11)),U,1)
+3 SET CRN=$ORDER(^BQI(90508,1,22,"B",CRIPC,""))
IF CRN=""
QUIT
+4 IF $GET(^BQI(90508,1,22,CRN,1,0))=""
SET ^BQI(90508,1,22,CRN,1,0)="^90508.221^^"
+5 ; Add new entries
+6 NEW BI,BJ,BK,BN,BQIUPD,ERROR,IENS,ND,NDATA,TEXT,VAL
+7 FOR BI=1:1
SET TEXT=$PIECE($TEXT(NONC+BI),";;",2)
IF TEXT=""
QUIT
Begin DoDot:1
+8 FOR BJ=1:1:$LENGTH(TEXT,"~")
Begin DoDot:2
+9 SET NDATA=$PIECE(TEXT,"~",BJ)
+10 SET ND=$PIECE(NDATA,"|",1)
SET VAL=$PIECE(NDATA,"|",2)
+11 IF ND=0
Begin DoDot:3
+12 NEW DIC,X,Y,DA
+13 SET DA(2)=1
SET DA(1)=CRN
+14 SET DIC(0)="LQZ"
SET DIC="^BQI(90508,"_DA(2)_",22,"_DA(1)_",1,"
SET X=$PIECE(VAL,U,1)
+15 DO ^DIC
+16 SET DA=+Y
+17 IF DA=-1
KILL DO,DD
DO FILE^DICN
SET DA=+Y
+18 SET IENS=$$IENS^DILF(.DA)
End DoDot:3
+19 IF ND=1
SET BQIUPD(90508.221,IENS,1)=VAL
QUIT
+20 FOR BK=1:1:$LENGTH(VAL,"^")
Begin DoDot:3
+21 SET BN=$ORDER(^DD(90508.221,"GL",ND,BK,""))
IF BN=""
QUIT
+22 IF $PIECE(VAL,"^",BK)'=""
SET BQIUPD(90508.221,IENS,BN)=$PIECE(VAL,"^",BK)
QUIT
+23 IF $PIECE(VAL,"^",BK)=""
SET BQIUPD(90508.221,IENS,BN)="@"
End DoDot:3
End DoDot:2
+24 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:1
+25 ;
GP ; Get fields from CRS
+1 NEW BQIH,BQIYR,BQIYDA,BQIMEASF,IDIN,MDATA,VAL
+2 SET BQIH=$$SPM^BQIGPUTL()
+3 SET BQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
+4 SET BQIYDA=$$LKP^BQIGPUTL(BQIYR)
+5 DO GFN^BQIGPUTL(BQIH,BQIYDA)
+6 SET BQIINDG=$$ROOT^DILFD(BQIMEASF,"",1)
+7 SET IDIN=0
+8 FOR
SET IDIN=$ORDER(@BQIINDG@(IDIN))
IF 'IDIN
QUIT
Begin DoDot:1
+9 SET MDATA=$GET(@BQIINDG@(IDIN,17))
IF MDATA=""
QUIT
+10 IF +MDATA=0
QUIT
+11 IF $PIECE(MDATA,U,7)'=1
QUIT
+12 SET VAL=BQIYR_"_"_IDIN
+13 DO NE(VAL)
+14 SET BQIUPD(90508.221,IENS,.02)="G"
SET BQIUPD(90508.221,IENS,.04)=$PIECE(MDATA,U,3)
+15 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:1
+16 QUIT
+17 ;
NE(VALUE) ; New Entry
+1 NEW DIC,X,Y,DA
+2 SET DA(2)=1
SET DA(1)=CRN
+3 SET DIC(0)="LQZ"
SET DIC="^BQI(90508,"_DA(2)_",22,"_DA(1)_",1,"
SET X=$PIECE(VALUE,U,1)
+4 DO ^DIC
+5 SET DA=+Y
+6 IF DA=-1
KILL DO,DD
DO FILE^DICN
SET DA=+Y
+7 SET IENS=$$IENS^DILF(.DA)
+8 QUIT
+9 ;
NONC ; Non CRS definitions
+1 ;;0|IPC_REVG^R^S^Revenue Generated Per Visit~1|D EN^BQIIPRVG
+2 ;;0|IPC_CCPR^R^S^Continuity of Care Primary Provider~1|D EN^BQIIPCCP
+3 ;;0|IPC_PEMP^R^S^Empanelled Primary Care Provider~1|D EN^BQIIPEMP
+4 ;;0|IPC_CANC^R^C^Cancer Screening Bundle~1|
+5 ;;0|IPC_HRISK^R^H^Health Risk Screening Bundle~1|
+6 ;;0|IPC_OUTC^R^O^Outcome Measures Bundle~1|
