BQIPLFLD.m

BQIPLFLD ;VNGT/HS/ALA-Panel Folders ; 13 Jul 2011  9:52 AM

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

 ;

 ;

GET(DATA,OWNR) ;EP -- BQI GET PANEL CATEGORIES

 ;

 NEW UID,II,X,MIEN,SOURCE,PARMS,PIEN,NAME,PTYP,VALUE,PMIEN

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPLFLD",UID))

 K @DATA

 ;

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLFLD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 S @DATA@(II)="I00010IEN^T00030NAME^T00030COLOR"_$C(30)

 I $G(OWNR)="" S OWNR=DUZ

 S IEN=0

 F  S IEN=$O(^BQICARE(OWNR,17,IEN)) Q:'IEN  D

 . S II=II+1,@DATA@(II)=IEN_U_^BQICARE(OWNR,17,IEN,0)_$C(30)

 ;

DONE S II=II+1,@DATA@(II)=$C(31)

 Q

 ;

ERR ;

 D ^%ZTER

 NEW Y,ERRDTM

 S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y

 S BMXSEC="Recording that an error occurred at "_ERRDTM

 I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)

 Q

 ;

UPD(DATA,OWNR,TYPE,IEN,PARMS) ;  EP - BQI SET PANEL CATEGORIES

 ;

 ;Input

 ;  OWNR  - User who signed onto iCare

 ;  TYPE  - A=Add, E=Edit, D=Delete

 ;  PARMS - Parameters for the source

 ;

 NEW UID,II,X,MIEN,PIEN,PMIEN,VALUE,PDATA,ALDA,QFL,BQ,NAME,MVAL,BQII,PPIEN

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPLFLG",UID))

 K @DATA

 ;

 S II=0,PARMS=$G(PARMS,"") I $G(OWNR)="" S OWNR=DUZ

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLFLD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 S @DATA@(II)="I00010RESULT"_$C(30)

 ;

 I TYPE="A" D ADD

 I TYPE="D" D DEL

 I TYPE="E" D EDT

 S RESULT=1

 I $D(ERROR) S RESULT=-1

 S II=II+1,@DATA@(II)=RESULT_$C(30)

 S II=II+1,@DATA@(II)=$C(31)

 Q

 ;

ADD ;

 NEW PDATA,BQ,NAME,VALUE,IENS,BQIUPD,COLOR

 F BQ=1:1:$L(PARMS,$C(28)) D

 . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""

 . S PNAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)

 . S @PNAME=VALUE

 NEW DA,DIC,DLAYGO

 S DA(1)=OWNR

 S DIC="^BQICARE("_DA(1)_",17,",DLAYGO=90505.017,DIC(0)="LMNZ"

 I $G(^BQICARE(OWNR,17,0))="" S ^BQICARE(OWNR,17,0)="^90505.017^^"

 S X=NAME D ^DIC S DA=+Y

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

 S BQIUPD(90505.017,IENS,.01)=NAME

 S BQIUPD(90505.017,IENS,.02)=COLOR

 D FILE^DIE("","BQIUPD","ERROR")

 Q

 ;

DEL ;

 NEW NAME,DA,DIK,BN

 S NAME=$P(^BQICARE(OWNR,17,IEN,0),U,1)

 S DA(1)=OWNR,DA=IEN,DIK="^BQICARE("_DA(1)_",17,"

 D ^DIK

 S BN=0

 F  S BN=$O(^BQICARE(OWNR,1,BN)) Q:'BN  D

 . I $P($G(^BQICARE(OWNR,1,BN,2)),U,2)=IEN S $P(^BQICARE(OWNR,1,BN,2),U,2)=""

 Q

 ;

EDT ;

 NEW PDATA,BQ,BN,NAME,VALUE,DA,BQIUPD,ONAME

 F BQ=1:1:$L(PARMS,$C(28)) D

 . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""

 . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)

 . S DA(1)=OWNR,DA=IEN,IENS=$$IENS^DILF(.DA)

 . I NAME="NAME" S BQIUPD(90505.017,IENS,.01)=VALUE

 . I NAME="COLOR" S BQIUPD(90505.017,IENS,.02)=VALUE

 S ONAME=$P(^BQICARE(OWNR,17,IEN,0),U,1)

 D FILE^DIE("","BQIUPD","ERROR")

 ;S NAME=$P(^BQICARE(OWNR,17,IEN,0),U,1)

 ;S BN=0

 ;F  S BN=$O(^BQICARE(OWNR,1,BN)) Q:'BN  D

 ;. I $P($G(^BQICARE(OWNR,1,BN,2)),U,2)=ONAME S $P(^BQICARE(OWNR,1,BN,2),U,2)=NAME

 Q

BQIPLFLD  ;VNGT/HS/ALA-Panel Folders ; 13 Jul 2011  9:52 AM

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

 +2       ;

 +3       ;

GET(DATA,OWNR) ;EP -- BQI GET PANEL CATEGORIES

 +1       ;

 +2        NEW UID,II,X,MIEN,SOURCE,PARMS,PIEN,NAME,PTYP,VALUE,PMIEN

 +3        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +4        SET DATA=$NAME(^TMP("BQIPLFLD",UID))

 +5        KILL @DATA

 +6       ;

 +7        SET II=0

 +8       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIPLFLD D UNWIND^%ZTER"

 +9       ;

 +10       SET @DATA@(II)="I00010IEN^T00030NAME^T00030COLOR"_$CHAR(30)

 +11       IF $GET(OWNR)=""

               SET OWNR=DUZ

 +12       SET IEN=0

 +13       FOR 

               SET IEN=$ORDER(^BQICARE(OWNR,17,IEN))

               IF 'IEN

                   QUIT 

               Begin DoDot:1

 +14               SET II=II+1

                   SET @DATA@(II)=IEN_U_^BQICARE(OWNR,17,IEN,0)_$CHAR(30)

               End DoDot:1

 +15      ;

DONE       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +1        QUIT 

 +2       ;

ERR       ;

 +1        DO ^%ZTER

 +2        NEW Y,ERRDTM

 +3        SET Y=$$NOW^XLFDT()

           XECUTE ^DD("DD")

           SET ERRDTM=Y

 +4        SET BMXSEC="Recording that an error occurred at "_ERRDTM

 +5        IF $DATA(II)

               IF $DATA(DATA)

                   SET II=II+1

                   SET @DATA@(II)=$CHAR(31)

 +6        QUIT 

 +7       ;

UPD(DATA,OWNR,TYPE,IEN,PARMS) ;  EP - BQI SET PANEL CATEGORIES

 +1       ;

 +2       ;Input

 +3       ;  OWNR  - User who signed onto iCare

 +4       ;  TYPE  - A=Add, E=Edit, D=Delete

 +5       ;  PARMS - Parameters for the source

 +6       ;

 +7        NEW UID,II,X,MIEN,PIEN,PMIEN,VALUE,PDATA,ALDA,QFL,BQ,NAME,MVAL,BQII,PPIEN

 +8        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +9        SET DATA=$NAME(^TMP("BQIPLFLG",UID))

 +10       KILL @DATA

 +11      ;

 +12       SET II=0

           SET PARMS=$GET(PARMS,"")

           IF $GET(OWNR)=""

               SET OWNR=DUZ

 +13      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIPLFLD D UNWIND^%ZTER"

 +14      ;

 +15       SET @DATA@(II)="I00010RESULT"_$CHAR(30)

 +16      ;

 +17       IF TYPE="A"

               DO ADD

 +18       IF TYPE="D"

               DO DEL

 +19       IF TYPE="E"

               DO EDT

 +20       SET RESULT=1

 +21       IF $DATA(ERROR)

               SET RESULT=-1

 +22       SET II=II+1

           SET @DATA@(II)=RESULT_$CHAR(30)

 +23       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +24       QUIT 

 +25      ;

ADD       ;

 +1        NEW PDATA,BQ,NAME,VALUE,IENS,BQIUPD,COLOR

 +2        FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))

               Begin DoDot:1

 +3                SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)

                   IF PDATA=""

                       QUIT 

 +4                SET PNAME=$PIECE(PDATA,"=",1)

                   SET VALUE=$PIECE(PDATA,"=",2,99)

 +5                SET @PNAME=VALUE

               End DoDot:1

 +6        NEW DA,DIC,DLAYGO

 +7        SET DA(1)=OWNR

 +8        SET DIC="^BQICARE("_DA(1)_",17,"

           SET DLAYGO=90505.017

           SET DIC(0)="LMNZ"

 +9        IF $GET(^BQICARE(OWNR,17,0))=""

               SET ^BQICARE(OWNR,17,0)="^90505.017^^"

 +10       SET X=NAME

           DO ^DIC

           SET DA=+Y

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

 +12       SET BQIUPD(90505.017,IENS,.01)=NAME

 +13       SET BQIUPD(90505.017,IENS,.02)=COLOR

 +14       DO FILE^DIE("","BQIUPD","ERROR")

 +15       QUIT 

 +16      ;

DEL       ;

 +1        NEW NAME,DA,DIK,BN

 +2        SET NAME=$PIECE(^BQICARE(OWNR,17,IEN,0),U,1)

 +3        SET DA(1)=OWNR

           SET DA=IEN

           SET DIK="^BQICARE("_DA(1)_",17,"

 +4        DO ^DIK

 +5        SET BN=0

 +6        FOR 

               SET BN=$ORDER(^BQICARE(OWNR,1,BN))

               IF 'BN

                   QUIT 

               Begin DoDot:1

 +7                IF $PIECE($GET(^BQICARE(OWNR,1,BN,2)),U,2)=IEN

                       SET $PIECE(^BQICARE(OWNR,1,BN,2),U,2)=""

               End DoDot:1

 +8        QUIT 

 +9       ;

EDT       ;

 +1        NEW PDATA,BQ,BN,NAME,VALUE,DA,BQIUPD,ONAME

 +2        FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))

               Begin DoDot:1

 +3                SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)

                   IF PDATA=""

                       QUIT 

 +4                SET NAME=$PIECE(PDATA,"=",1)

                   SET VALUE=$PIECE(PDATA,"=",2,99)

 +5                SET DA(1)=OWNR

                   SET DA=IEN

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

 +6                IF NAME="NAME"

                       SET BQIUPD(90505.017,IENS,.01)=VALUE

 +7                IF NAME="COLOR"

                       SET BQIUPD(90505.017,IENS,.02)=VALUE

               End DoDot:1

 +8        SET ONAME=$PIECE(^BQICARE(OWNR,17,IEN,0),U,1)

 +9        DO FILE^DIE("","BQIUPD","ERROR")

 +10      ;S NAME=$P(^BQICARE(OWNR,17,IEN,0),U,1)

 +11      ;S BN=0

 +12      ;F  S BN=$O(^BQICARE(OWNR,1,BN)) Q:'BN  D

 +13      ;. I $P($G(^BQICARE(OWNR,1,BN,2)),U,2)=ONAME S $P(^BQICARE(OWNR,1,BN,2),U,2)=NAME

 +14       QUIT