- 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
