BQICAVW ;PRXM/HC/ALA-Community Alerts View ; 12 Nov 2007 4:44 PM
;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
;
EN(DATA,FAKE) ;EP -- BQI GET COMM ALERTS VIEW
;Description
; Retrieve all the defined "flags" definitions for an owner
;
;Input
; FAKE - extra 'blank' parameter required by BMXNET async 'feature'
;Output
; DATA - name of global (passed by reference) in which the data
; is stored
;Assumes
; DUZ - User who signed onto iCare
;
NEW UID,II,X,MIEN,SOURCE,PARMS,PIEN,NAME,PTYP,VALUE,PMIEN,SORT,TYP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQICAVW",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQICAVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00045DISPLAY_GROUP^T00030TYPE^T00045LABEL^T00005TMFRAME^T00003STATUS"_$C(30)
;
; If no community alerts definition, pull default
S MIEN=0
F S MIEN=$O(^BQICARE(DUZ,11,MIEN)) Q:'MIEN D
. NEW DA,IENS
. S DA(1)=DUZ,DA=MIEN,IENS=$$IENS^DILF(.DA)
. S LABEL=$$GET1^DIQ(90505.011,IENS,.01,"E")
. S LIEN=$$GET1^DIQ(90505.011,IENS,.01,"I"),GROUP="",TYP=""
. I LIEN'="" D
.. S GROUP=$$GET1^DIQ(90507.8,LIEN_",",.03,"E")
.. S TYP=$$GET1^DIQ(90507.8,LIEN_",",2.01,"E")
. S GRP=GROUP
. S:GROUP="OPTIONAL" GRP="Z"_GROUP
. ;
. S PIEN=0,PARMS=""
. F S PIEN=$O(^BQICARE(DUZ,11,MIEN,1,PIEN)) Q:'PIEN D
.. NEW DA,IENS
.. S DA(2)=DUZ,DA(1)=MIEN,DA=PIEN,IENS=$$IENS^DILF(.DA)
.. S NAME=$$GET1^DIQ(90505.111,IENS,.01,"E")
.. S VALUE=$$GET1^DIQ(90505.111,IENS,.02,"E")
.. ;S PARMS=PARMS_NAME_"="
.. S @NAME=VALUE
. S TMFRAME=$S($G(TMFRAME):TMFRAME,1:"T-30")
. S STATUS=$S($G(STATUS)'="":STATUS,$G(STATUS)=""&GROUP="MANDATORY":"ON",1:"OFF")
. S SORT(GRP,TYP,LABEL)=LIEN_U_TMFRAME_U_STATUS_U_GROUP
;
D DFLT
;
S GRP=""
F S GRP=$O(SORT(GRP)) Q:GRP="" D
. S TYP=""
. F S TYP=$O(SORT(GRP,TYP)) Q:TYP="" D
.. S LABEL=""
.. F S LABEL=$O(SORT(GRP,TYP,LABEL)) Q:LABEL="" D
... S TMFRAME=$P(SORT(GRP,TYP,LABEL),U,2)
... S STATUS=$P(SORT(GRP,TYP,LABEL),U,3)
... S GROUP=$P(SORT(GRP,TYP,LABEL),U,4)
... S II=II+1,@DATA@(II)=GROUP_U_TYP_U_LABEL_U_TMFRAME_U_STATUS_$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,LABEL,PARMS) ; EP - BQI SET COMM ALERTS VIEW
;
;Input
; LABEL - Label name for the alert
; PARMS - Parameter for the alert
;Assumes
; DUZ - User who signed onto iCare
;
NEW UID,II,X,MIEN,PIEN,PMIEN,VALUE,PDATA,ALDA,QFL,BQ,NAME,MVAL,BQII,PPIEN
NEW GRP,GRPP,GROUP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQICAVW",UID))
K @DATA
;
S II=0,PARMS=$G(PARMS,"")
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQICAVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010RESULT"_$C(30)
;
NEW DA,DIC,DLAYGO
S DA(1)=DUZ,X=LABEL
S DLAYGO=90505.011,DIC(0)="LNXZ"
S DIC="^BQICARE("_DA(1)_",11,"
I '$D(^BQICARE(DA(1),11,0)) S ^BQICARE(DA(1),11,0)="^90505.011P^^"
;K DO,DD D FILE^DICN
D ^DIC
S ALDA=+Y
I ALDA=-1 S II=II+1,@DATA@(II)="-1"_$C(30) G DONE
;
; Clean out all the previous parameters
NEW DA,DIK,PN,PDA,BQI,PDATA,NAME,VALUE,ERROR
S DA(2)=DUZ,DA(1)=ALDA,DIK="^BQICARE("_DA(2)_",11,"_DA(1)_",1,",PN=0
F S PN=$O(^BQICARE(DA(2),11,DA(1),1,PN)) Q:'PN S DA=PN D ^DIK
;
F BQI=1:1:$L(PARMS,$C(28)) D
. S PDATA=$P(PARMS,$C(28),BQI)
. S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
. NEW DA,IENS,DIC,DLAYGO
. S DA(2)=DUZ,DA(1)=ALDA,X=NAME
. S DLAYGO=90505.111,DIC(0)="L",DIC("P")=DLAYGO
. S DIC="^BQICARE("_DA(2)_",11,"_DA(1)_",1,"
. I '$D(^BQICARE(DA(2),10,DA(1),1,0)) S ^BQICARE(DA(2),11,DA(1),1,0)="^90505.111A^^"
. K DO,DD D FILE^DICN
. S (DA,PDA)=+Y
. I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30),ERROR=1 Q
. ;
. NEW DA,IENS
. S DA(2)=DUZ,DA(1)=ALDA,DA=PDA
. S IENS=$$IENS^DILF(.DA)
. S BQIUPD(90505.111,IENS,.02)=VALUE
. D FILE^DIE("","BQIUPD","ERROR")
. K BQIUPD
;
S II=II+1,@DATA@(II)="1"_$C(30)
I $D(ERROR) S @DATA@(II)="-1^"_$G(ERROR("DIERR",1,"TEXT",1))_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
DEL ; Delete the previous community alert definitions
NEW DA,DIK
S DA(1)=DUZ,DA=0,DIK="^BQICARE("_DA(1)_",11,"
F S DA=$O(^BQICARE(DUZ,11,DA)) Q:'DA D ^DIK
Q
;
DFLT ; Get default values
NEW LIEN,GRP,LBL,GROUP,GRPP,STATUS,TMFRAME,TYP,INAC
; For the display group of mandatory, recommended, and optional
F GRP="M","R","O" D
. S LIEN=""
. F S LIEN=$O(^BQI(90507.8,"C",GRP,LIEN)) Q:LIEN="" D
.. S LBL=$P(^BQI(90507.8,LIEN,0),U,1)
.. S GROUP=$$GET1^DIQ(90507.8,LIEN_",",.03,"E"),TMFRAME="T-30"
.. S TYP=$$GET1^DIQ(90507.8,LIEN_",",2.01,"E")
.. S GRPP=GROUP
.. S:GROUP="OPTIONAL" GRPP="Z"_GROUP
.. S STATUS=$S(GRP="O":"OFF",1:"ON")
.. S INAC=$P(^BQI(90507.8,LIEN,0),U,5)
.. I INAC=1 K SORT(GRPP,TYP,LBL) Q
.. I $G(SORT(GRPP,TYP,LBL))="" S SORT(GRPP,TYP,LBL)=LIEN_U_TMFRAME_U_STATUS_U_GROUP
;
Q
;
VAL(NDUZ,NDCN) ;EP - Find the values of a community alert
; Input
; NDUZ - User
; NDCN - IEN of the alert
NEW BQUIEN,BQII,DATE,BQUIEN,STAT
S BQUIEN=$O(^BQICARE(NDUZ,11,"B",NDCN,""))
I BQUIEN'="" D
. S BQII=0
. F S BQII=$O(^BQICARE(NDUZ,11,BQUIEN,1,BQII)) Q:'BQII D
.. ; **temporary hardcode for data dates**
.. ;I $P(^BQICARE(NDUZ,11,BQUIEN,1,BQII,0),U,1)="TMFRAME" S DATE=$$DATE^BQIUL1($P(^(0),U,2))
.. I $P(^BQICARE(NDUZ,11,BQUIEN,1,BQII,0),U,1)="TMFRAME" S DATE=$$DATE^BQIUL1("T-30")
.. I $P(^BQICARE(NDUZ,11,BQUIEN,1,BQII,0),U,1)="STATUS" S STAT=$P(^(0),U,2)
I BQUIEN="" D
. S STAT=$P(^BQI(90507.8,NDCN,0),U,3)
. S STAT=$S(STAT="O":"OFF",1:"ON")
. ; **temporary hardcode for data dates**
. S DATE=$$DATE^BQIUL1("T-30")
. ;S DATE=$$DATE^BQIUL1("T-36M")
Q STAT_U_DATE
BQICAVW ;PRXM/HC/ALA-Community Alerts View ; 12 Nov 2007 4:44 PM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
+2 ;
EN(DATA,FAKE) ;EP -- BQI GET COMM ALERTS VIEW
+1 ;Description
+2 ; Retrieve all the defined "flags" definitions for an owner
+3 ;
+4 ;Input
+5 ; FAKE - extra 'blank' parameter required by BMXNET async 'feature'
+6 ;Output
+7 ; DATA - name of global (passed by reference) in which the data
+8 ; is stored
+9 ;Assumes
+10 ; DUZ - User who signed onto iCare
+11 ;
+12 NEW UID,II,X,MIEN,SOURCE,PARMS,PIEN,NAME,PTYP,VALUE,PMIEN,SORT,TYP
+13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+14 SET DATA=$NAME(^TMP("BQICAVW",UID))
+15 KILL @DATA
+16 ;
+17 SET II=0
+18 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQICAVW D UNWIND^%ZTER"
+19 ;
+20 SET @DATA@(II)="T00045DISPLAY_GROUP^T00030TYPE^T00045LABEL^T00005TMFRAME^T00003STATUS"_$CHAR(30)
+21 ;
+22 ; If no community alerts definition, pull default
+23 SET MIEN=0
+24 FOR
SET MIEN=$ORDER(^BQICARE(DUZ,11,MIEN))
IF 'MIEN
QUIT
Begin DoDot:1
+25 NEW DA,IENS
+26 SET DA(1)=DUZ
SET DA=MIEN
SET IENS=$$IENS^DILF(.DA)
+27 SET LABEL=$$GET1^DIQ(90505.011,IENS,.01,"E")
+28 SET LIEN=$$GET1^DIQ(90505.011,IENS,.01,"I")
SET GROUP=""
SET TYP=""
+29 IF LIEN'=""
Begin DoDot:2
+30 SET GROUP=$$GET1^DIQ(90507.8,LIEN_",",.03,"E")
+31 SET TYP=$$GET1^DIQ(90507.8,LIEN_",",2.01,"E")
End DoDot:2
+32 SET GRP=GROUP
+33 IF GROUP="OPTIONAL"
SET GRP="Z"_GROUP
+34 ;
+35 SET PIEN=0
SET PARMS=""
+36 FOR
SET PIEN=$ORDER(^BQICARE(DUZ,11,MIEN,1,PIEN))
IF 'PIEN
QUIT
Begin DoDot:2
+37 NEW DA,IENS
+38 SET DA(2)=DUZ
SET DA(1)=MIEN
SET DA=PIEN
SET IENS=$$IENS^DILF(.DA)
+39 SET NAME=$$GET1^DIQ(90505.111,IENS,.01,"E")
+40 SET VALUE=$$GET1^DIQ(90505.111,IENS,.02,"E")
+41 ;S PARMS=PARMS_NAME_"="
+42 SET @NAME=VALUE
End DoDot:2
+43 SET TMFRAME=$SELECT($GET(TMFRAME):TMFRAME,1:"T-30")
+44 SET STATUS=$SELECT($GET(STATUS)'="":STATUS,$GET(STATUS)=""&GROUP="MANDATORY":"ON",1:"OFF")
+45 SET SORT(GRP,TYP,LABEL)=LIEN_U_TMFRAME_U_STATUS_U_GROUP
End DoDot:1
+46 ;
+47 DO DFLT
+48 ;
+49 SET GRP=""
+50 FOR
SET GRP=$ORDER(SORT(GRP))
IF GRP=""
QUIT
Begin DoDot:1
+51 SET TYP=""
+52 FOR
SET TYP=$ORDER(SORT(GRP,TYP))
IF TYP=""
QUIT
Begin DoDot:2
+53 SET LABEL=""
+54 FOR
SET LABEL=$ORDER(SORT(GRP,TYP,LABEL))
IF LABEL=""
QUIT
Begin DoDot:3
+55 SET TMFRAME=$PIECE(SORT(GRP,TYP,LABEL),U,2)
+56 SET STATUS=$PIECE(SORT(GRP,TYP,LABEL),U,3)
+57 SET GROUP=$PIECE(SORT(GRP,TYP,LABEL),U,4)
+58 SET II=II+1
SET @DATA@(II)=GROUP_U_TYP_U_LABEL_U_TMFRAME_U_STATUS_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+59 ;
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,LABEL,PARMS) ; EP - BQI SET COMM ALERTS VIEW
+1 ;
+2 ;Input
+3 ; LABEL - Label name for the alert
+4 ; PARMS - Parameter for the alert
+5 ;Assumes
+6 ; DUZ - User who signed onto iCare
+7 ;
+8 NEW UID,II,X,MIEN,PIEN,PMIEN,VALUE,PDATA,ALDA,QFL,BQ,NAME,MVAL,BQII,PPIEN
+9 NEW GRP,GRPP,GROUP
+10 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+11 SET DATA=$NAME(^TMP("BQICAVW",UID))
+12 KILL @DATA
+13 ;
+14 SET II=0
SET PARMS=$GET(PARMS,"")
+15 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQICAVW D UNWIND^%ZTER"
+16 ;
+17 SET @DATA@(II)="I00010RESULT"_$CHAR(30)
+18 ;
+19 NEW DA,DIC,DLAYGO
+20 SET DA(1)=DUZ
SET X=LABEL
+21 SET DLAYGO=90505.011
SET DIC(0)="LNXZ"
+22 SET DIC="^BQICARE("_DA(1)_",11,"
+23 IF '$DATA(^BQICARE(DA(1),11,0))
SET ^BQICARE(DA(1),11,0)="^90505.011P^^"
+24 ;K DO,DD D FILE^DICN
+25 DO ^DIC
+26 SET ALDA=+Y
+27 IF ALDA=-1
SET II=II+1
SET @DATA@(II)="-1"_$CHAR(30)
GOTO DONE
+28 ;
+29 ; Clean out all the previous parameters
+30 NEW DA,DIK,PN,PDA,BQI,PDATA,NAME,VALUE,ERROR
+31 SET DA(2)=DUZ
SET DA(1)=ALDA
SET DIK="^BQICARE("_DA(2)_",11,"_DA(1)_",1,"
SET PN=0
+32 FOR
SET PN=$ORDER(^BQICARE(DA(2),11,DA(1),1,PN))
IF 'PN
QUIT
SET DA=PN
DO ^DIK
+33 ;
+34 FOR BQI=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+35 SET PDATA=$PIECE(PARMS,$CHAR(28),BQI)
+36 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2,99)
+37 NEW DA,IENS,DIC,DLAYGO
+38 SET DA(2)=DUZ
SET DA(1)=ALDA
SET X=NAME
+39 SET DLAYGO=90505.111
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+40 SET DIC="^BQICARE("_DA(2)_",11,"_DA(1)_",1,"
+41 IF '$DATA(^BQICARE(DA(2),10,DA(1),1,0))
SET ^BQICARE(DA(2),11,DA(1),1,0)="^90505.111A^^"
+42 KILL DO,DD
DO FILE^DICN
+43 SET (DA,PDA)=+Y
+44 IF DA=-1
SET II=II+1
SET @DATA@(II)="-1"_$CHAR(30)
SET ERROR=1
QUIT
+45 ;
+46 NEW DA,IENS
+47 SET DA(2)=DUZ
SET DA(1)=ALDA
SET DA=PDA
+48 SET IENS=$$IENS^DILF(.DA)
+49 SET BQIUPD(90505.111,IENS,.02)=VALUE
+50 DO FILE^DIE("","BQIUPD","ERROR")
+51 KILL BQIUPD
End DoDot:1
+52 ;
+53 SET II=II+1
SET @DATA@(II)="1"_$CHAR(30)
+54 IF $DATA(ERROR)
SET @DATA@(II)="-1^"_$GET(ERROR("DIERR",1,"TEXT",1))_$CHAR(30)
+55 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+56 QUIT
+57 ;
DEL ; Delete the previous community alert definitions
+1 NEW DA,DIK
+2 SET DA(1)=DUZ
SET DA=0
SET DIK="^BQICARE("_DA(1)_",11,"
+3 FOR
SET DA=$ORDER(^BQICARE(DUZ,11,DA))
IF 'DA
QUIT
DO ^DIK
+4 QUIT
+5 ;
DFLT ; Get default values
+1 NEW LIEN,GRP,LBL,GROUP,GRPP,STATUS,TMFRAME,TYP,INAC
+2 ; For the display group of mandatory, recommended, and optional
+3 FOR GRP="M","R","O"
Begin DoDot:1
+4 SET LIEN=""
+5 FOR
SET LIEN=$ORDER(^BQI(90507.8,"C",GRP,LIEN))
IF LIEN=""
QUIT
Begin DoDot:2
+6 SET LBL=$PIECE(^BQI(90507.8,LIEN,0),U,1)
+7 SET GROUP=$$GET1^DIQ(90507.8,LIEN_",",.03,"E")
SET TMFRAME="T-30"
+8 SET TYP=$$GET1^DIQ(90507.8,LIEN_",",2.01,"E")
+9 SET GRPP=GROUP
+10 IF GROUP="OPTIONAL"
SET GRPP="Z"_GROUP
+11 SET STATUS=$SELECT(GRP="O":"OFF",1:"ON")
+12 SET INAC=$PIECE(^BQI(90507.8,LIEN,0),U,5)
+13 IF INAC=1
KILL SORT(GRPP,TYP,LBL)
QUIT
+14 IF $GET(SORT(GRPP,TYP,LBL))=""
SET SORT(GRPP,TYP,LBL)=LIEN_U_TMFRAME_U_STATUS_U_GROUP
End DoDot:2
End DoDot:1
+15 ;
+16 QUIT
+17 ;
VAL(NDUZ,NDCN) ;EP - Find the values of a community alert
+1 ; Input
+2 ; NDUZ - User
+3 ; NDCN - IEN of the alert
+4 NEW BQUIEN,BQII,DATE,BQUIEN,STAT
+5 SET BQUIEN=$ORDER(^BQICARE(NDUZ,11,"B",NDCN,""))
+6 IF BQUIEN'=""
Begin DoDot:1
+7 SET BQII=0
+8 FOR
SET BQII=$ORDER(^BQICARE(NDUZ,11,BQUIEN,1,BQII))
IF 'BQII
QUIT
Begin DoDot:2
+9 ; **temporary hardcode for data dates**
+10 ;I $P(^BQICARE(NDUZ,11,BQUIEN,1,BQII,0),U,1)="TMFRAME" S DATE=$$DATE^BQIUL1($P(^(0),U,2))
+11 IF $PIECE(^BQICARE(NDUZ,11,BQUIEN,1,BQII,0),U,1)="TMFRAME"
SET DATE=$$DATE^BQIUL1("T-30")
+12 IF $PIECE(^BQICARE(NDUZ,11,BQUIEN,1,BQII,0),U,1)="STATUS"
SET STAT=$PIECE(^(0),U,2)
End DoDot:2
End DoDot:1
+13 IF BQUIEN=""
Begin DoDot:1
+14 SET STAT=$PIECE(^BQI(90507.8,NDCN,0),U,3)
+15 SET STAT=$SELECT(STAT="O":"OFF",1:"ON")
+16 ; **temporary hardcode for data dates**
+17 SET DATE=$$DATE^BQIUL1("T-30")
+18 ;S DATE=$$DATE^BQIUL1("T-36M")
End DoDot:1
+19 QUIT STAT_U_DATE
