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
