BQIUTB4 ;GDIT/HS/ALA-Tables ; 05 Dec 2012 12:40 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
ACM(DATA) ;EP - ACM Registers
NEW RN
S II=0,RN=0
S @DATA@(II)="T00010IEN^T00030"_$C(30)
F S RN=$O(^ACM(41.1,RN)) Q:'RN D
. I $G(^ACM(41.1,RN,0))="" Q
. I $P(^ACM(41.1,RN,0),U,14)'=1 Q
. I '$D(^ACM(41.1,RN,"AU",DUZ)) Q
. S II=II+1,@DATA@(II)=RN_U_$P(^ACM(41.1,RN,0),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
WARD(DATA) ;EP - Ward
NEW RN
S II=0,RN=0
S @DATA@(II)="T00010IEN^T00030"_$C(30)
F S RN=$O(^DIC(42,RN)) Q:'RN D
. S II=II+1,@DATA@(II)=RN_U_$P(^DIC(42,RN,0),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
FSPEC(DATA) ;EP - Treating Specialty
NEW RN,N
S II=0,RN=0
S @DATA@(II)="T00010IEN^T00030"_$C(30)
F S RN=$O(^DIC(45.7,RN)) Q:'RN D
. I '$D(^DIC(45.7,RN,"E")) Q
. S N=0
. F S N=$O(^DIC(45.7,RN,"E",N)) Q:'N D
.. I $P(^DIC(45.7,RN,"E",N,0),"^",2)'=1 Q
.. S II=II+1,@DATA@(II)=RN_U_$P(^DIC(45.7,RN,0),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
IATYP(DATA) ; EP - Admit Type
NEW RN
S II=0,RN=0
S @DATA@(II)="T00010IEN^T00030"_$C(30)
F S RN=$O(^DG(405.1,RN)) Q:'RN D
. I $$GET1^DIQ(405.1,RN_",",.02,"E")'="ADMISSION" Q
. I $P(^DG(405.1,RN,0),U,4)'=1 Q
. S II=II+1,@DATA@(II)=RN_U_$P(^DG(405.1,RN,0),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
IDTYP(DATA) ; EP - Discharge type
NEW RN
S II=0,RN=0
S @DATA@(II)="T00010IEN^T00030"_$C(30)
F S RN=$O(^DG(405.1,RN)) Q:'RN D
. I $$GET1^DIQ(405.1,RN_",",.02,"E")'="DISCHARGE" Q
. I $P(^DG(405.1,RN,0),U,4)'=1 Q
. S II=II+1,@DATA@(II)=RN_U_$P(^DG(405.1,RN,0),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
EDTYP(DATA) ; EP - ER Disposition type
NEW RN,ETY
S II=0,RN=""
S @DATA@(II)="T00010IEN^T00030"_$C(30)
S ETY=$$FIND1^DIC(9009082,"","MOX","DISPOSITION","","","ERROR")
F S RN=$O(^AMER(3,"AC",ETY,RN)) Q:RN="" D
. S II=II+1,@DATA@(II)=RN_U_$P(^AMER(3,RN,0),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
EVTYP(DATA) ; EP - ER Visit type
NEW RN,ETY
S II=0,RN=""
S @DATA@(II)="T00010IEN^T00030"_$C(30)
S ETY=$$FIND1^DIC(9009082,"","MOX","VISIT TYPE","","","ERROR")
F S RN=$O(^AMER(3,"AC",ETY,RN)) Q:RN="" D
. S II=II+1,@DATA@(II)=RN_U_$P(^AMER(3,RN,0),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
EDACU(DATA) ;EP - ER Acuity
S II=0,@DATA@(II)="T00010IEN^T00060"_$C(30)
F I=1:1:5 S II=II+1,@DATA@(II)=I_U_"Acuity Level "_I_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
PRFC(DATA) ; EP - Preferred Communication
NEW FLAG,VALUE,BJ,CODE,TEXT
S II=0
S @DATA@(II)="T00001CODE^T00030"_$C(30)
S VALUE=$P(^DD(9000001,4002,0),U,3)
F BJ=1:1:$L(VALUE,";") D
. S CODE=$P(VALUE,";",BJ) Q:CODE=""
. S TEXT=$P(CODE,":",2)
. S II=II+1,@DATA@(II)=$P(CODE,":",1)_"^"_TEXT_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
ETOP(DATA) ; EP - Education Topics
NEW LN,VALUE,TOP
S II=0,LN=0
S @DATA@(II)="T00030IEN^T00060"_$C(30)
F S LN=$O(^AUTTEDMT(LN)) Q:'LN D
. S II=II+1,@DATA@(II)=LN_U_$P(^AUTTEDMT(LN,0),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
EDUC(DATA) ;EP - Education
NEW LN
S II=0,LN=0
S @DATA@(II)="T00010IEN^T00060"_$C(30)
F S LN=$O(^AUPNVPED("B",LN)) Q:LN="" D
. I $G(^AUTTEDT(LN,0))="" Q
. I $P(^AUTTEDT(LN,0),U,3)'="" Q
. S II=II+1,@DATA@(II)=LN_U_$P(^AUTTEDT(LN,0),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
TMFRAM(DATA,PARM) ;EP - List of timeframes by parameter
NEW LN,BZ
K BZ
S II=0,LN=""
S @DATA@(II)="T00010IEN^T00060"_$C(30)
S II=II+1,@DATA@(II)="0^"_$C(30)
S ORD=""
F S ORD=$O(^BQI(90506.9,"D",PARM,ORD)) Q:ORD="" D
. S LN=$O(^BQI(90506.9,"D",PARM,ORD,""))
. S II=II+1,@DATA@(II)=LN_U_$P(^BQI(90506.9,LN,0),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
EPICK(DATA) ;EP - EHR Education Picklists
NEW RET,INP,LN
S $P(INP,U,3)=DUZ,$P(INP,U,5)=0
D GETCATS^BGOEDTPR(.RET,INP)
S II=0,@DATA@(II)="T00010IEN^T00060"_$C(30)
S LN=0
F S LN=$O(@RET@(LN)) Q:LN="" D
. S II=II+1,@DATA@(II)=$P(@RET@(LN),U,2)_U_$P(@RET@(LN),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
K @RET
Q
;
PKIT(DATA,PICK) ;EP - BQI GET PICKLIST ITEMS
NEW UID,II,LN,RET
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIUTB4P",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIUTB1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010IEN^T00030ED_ITEM"_$C(30)
D GETITEMS^BGOEDTPR(.RET,PICK)
S LN=0
F S LN=$O(@RET@(LN)) Q:LN="" D
. S II=II+1,@DATA@(II)=$P(@RET@(LN),U,1)_U_$P(@RET@(LN),U,2)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
K @RET
Q
;
MTIT(DATA,TOP) ;EP - BQI GET ED TOPIC ITEMS
NEW UID,II,LN,RET,ZZ,TEXT,TOPN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIUTB4T",UID))
K @DATA,ZZ
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIUTB1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010IEN^T00060"_$C(30)
S TOPN=TOP,TOP=$P(^AUTTEDMT(TOPN,0),U,2)
S LN=0
F S LN=$O(^AUTTEDT(LN)) Q:'LN D
. S RET=$G(^AUTTEDT(LN,0))
. I RET="" Q
. I $P(RET,U,3)'="" Q
. I $P(RET,U,6)'=TOP Q
. S TEXT=$P($P(RET,U,1),"-",2,99),ZZ(TEXT)=LN
S TEXT=""
F S TEXT=$O(ZZ(TEXT)) Q:TEXT="" D
. S LN=ZZ(TEXT)
. S II=II+1,@DATA@(II)=LN_U_TEXT_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
CRM(DATA) ;EP - Care Management Layout Sources
NEW CIEN,TGIEN,RGIEN,REG,TAG,FMIEN,FORM,VIEW,REM,REPORT,KEY,PNDROP,PTDROP,MTDROP
S @DATA@(II)="I00010IEN^T00030LAYOUT^T00030FORM^T00030TAG^I00010TAG_IEN^T00030REGISTER^T00001PAT_VIEW^T00001REMINDERS^T00030REPORT^T00001PAT_DROPDOWN^T00001PAN_DROPDOWN^T00001MAT_DROPDOWN"_$C(30)
S CIEN=0
F S CIEN=$O(^BQI(90506.5,CIEN)) Q:'CIEN D
. NEW TGIEN,RGIEN,REG,TAG,FMIEN,FORM,VIEW,REM,REPORT,KEY,PNDROP,PTDROP
. I $P(^BQI(90506.5,CIEN,0),U,4)'=1 Q
. I $P(^BQI(90506.5,CIEN,0),U,10)=1 Q
. S KEY=$P(^BQI(90506.5,CIEN,0),U,12)
. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
. S RGIEN=$P(^BQI(90506.5,CIEN,0),U,3)
. I RGIEN'="" S REG=$$GET1^DIQ(90507,RGIEN_",",.01,"E")
. I RGIEN'="" S TGIEN=$O(^BQI(90506.2,"AD",RGIEN,""))
. I $G(TGIEN)'="" S TAG=$$GET1^DIQ(90506.2,TGIEN_",",.01,"E")
. I $G(TAG)="" S TAG=$$GET1^DIQ(90506.5,CIEN_",",.11,"E"),TGIEN=$$GET1^DIQ(90506.5,CIEN_",",.11,"I")
. S FMIEN=$O(^BQI(90506.3,"AC",CIEN,""))
. I FMIEN'="",$P(^BQI(90506.3,FMIEN,0),U,3)'=1 S FORM=$$GET1^DIQ(90506.3,FMIEN_",",.01,"E")
. ;S VIEW=$S($P(^BQI(90506.5,CIEN,0),U,7)'="":"Y",1:"N")
. S REM=$S($P(^BQI(90506.5,CIEN,0),U,5)'="":"Y",1:"N")
. S REPORT=$P(^BQI(90506.5,CIEN,0),U,8)
. S VIEW=$S($G(FORM)'="":"F",$G(REPORT)'="":"R",1:"")
. I $G(REG)="" S REG=$P(^BQI(90506.5,CIEN,0),U,1)
. S PTDROP=$S($P(^BQI(90506.5,CIEN,0),U,13)'="":"Y",1:"")
. S PNDROP=$S($P(^BQI(90506.5,CIEN,0),U,14)'="":"Y",1:"")
. S MTDROP=$S($P(^BQI(90506.5,CIEN,0),U,15)'="":"Y",1:"")
. ;
. S II=II+1,@DATA@(II)=CIEN_U_$P(^BQI(90506.5,CIEN,0),U,1)_U_$G(FORM)_U_$G(TAG)_U_$G(TGIEN)_U_$G(REG)_U_$G(VIEW)_U_$G(REM)_U_$G(REPORT)_U_$G(PTDROP)_U_$G(PNDROP)_U_$G(MTDROP)_$C(30)
. K REG,TGIEN,TAG,FMIEN,FORM,VIEW,RGIEN
S II=II+1,@DATA@(II)=$C(31)
Q
BQIUTB4 ;GDIT/HS/ALA-Tables ; 05 Dec 2012 12:40 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 ;
ACM(DATA) ;EP - ACM Registers
+1 NEW RN
+2 SET II=0
SET RN=0
+3 SET @DATA@(II)="T00010IEN^T00030"_$CHAR(30)
+4 FOR
SET RN=$ORDER(^ACM(41.1,RN))
IF 'RN
QUIT
Begin DoDot:1
+5 IF $GET(^ACM(41.1,RN,0))=""
QUIT
+6 IF $PIECE(^ACM(41.1,RN,0),U,14)'=1
QUIT
+7 IF '$DATA(^ACM(41.1,RN,"AU",DUZ))
QUIT
+8 SET II=II+1
SET @DATA@(II)=RN_U_$PIECE(^ACM(41.1,RN,0),U,1)_$CHAR(30)
End DoDot:1
+9 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+10 QUIT
+11 ;
WARD(DATA) ;EP - Ward
+1 NEW RN
+2 SET II=0
SET RN=0
+3 SET @DATA@(II)="T00010IEN^T00030"_$CHAR(30)
+4 FOR
SET RN=$ORDER(^DIC(42,RN))
IF 'RN
QUIT
Begin DoDot:1
+5 SET II=II+1
SET @DATA@(II)=RN_U_$PIECE(^DIC(42,RN,0),U,1)_$CHAR(30)
End DoDot:1
+6 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+7 QUIT
+8 ;
FSPEC(DATA) ;EP - Treating Specialty
+1 NEW RN,N
+2 SET II=0
SET RN=0
+3 SET @DATA@(II)="T00010IEN^T00030"_$CHAR(30)
+4 FOR
SET RN=$ORDER(^DIC(45.7,RN))
IF 'RN
QUIT
Begin DoDot:1
+5 IF '$DATA(^DIC(45.7,RN,"E"))
QUIT
+6 SET N=0
+7 FOR
SET N=$ORDER(^DIC(45.7,RN,"E",N))
IF 'N
QUIT
Begin DoDot:2
+8 IF $PIECE(^DIC(45.7,RN,"E",N,0),"^",2)'=1
QUIT
+9 SET II=II+1
SET @DATA@(II)=RN_U_$PIECE(^DIC(45.7,RN,0),U,1)_$CHAR(30)
End DoDot:2
End DoDot:1
+10 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+11 QUIT
+12 ;
IATYP(DATA) ; EP - Admit Type
+1 NEW RN
+2 SET II=0
SET RN=0
+3 SET @DATA@(II)="T00010IEN^T00030"_$CHAR(30)
+4 FOR
SET RN=$ORDER(^DG(405.1,RN))
IF 'RN
QUIT
Begin DoDot:1
+5 IF $$GET1^DIQ(405.1,RN_",",.02,"E")'="ADMISSION"
QUIT
+6 IF $PIECE(^DG(405.1,RN,0),U,4)'=1
QUIT
+7 SET II=II+1
SET @DATA@(II)=RN_U_$PIECE(^DG(405.1,RN,0),U,1)_$CHAR(30)
End DoDot:1
+8 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+9 QUIT
+10 ;
IDTYP(DATA) ; EP - Discharge type
+1 NEW RN
+2 SET II=0
SET RN=0
+3 SET @DATA@(II)="T00010IEN^T00030"_$CHAR(30)
+4 FOR
SET RN=$ORDER(^DG(405.1,RN))
IF 'RN
QUIT
Begin DoDot:1
+5 IF $$GET1^DIQ(405.1,RN_",",.02,"E")'="DISCHARGE"
QUIT
+6 IF $PIECE(^DG(405.1,RN,0),U,4)'=1
QUIT
+7 SET II=II+1
SET @DATA@(II)=RN_U_$PIECE(^DG(405.1,RN,0),U,1)_$CHAR(30)
End DoDot:1
+8 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+9 QUIT
+10 ;
EDTYP(DATA) ; EP - ER Disposition type
+1 NEW RN,ETY
+2 SET II=0
SET RN=""
+3 SET @DATA@(II)="T00010IEN^T00030"_$CHAR(30)
+4 SET ETY=$$FIND1^DIC(9009082,"","MOX","DISPOSITION","","","ERROR")
+5 FOR
SET RN=$ORDER(^AMER(3,"AC",ETY,RN))
IF RN=""
QUIT
Begin DoDot:1
+6 SET II=II+1
SET @DATA@(II)=RN_U_$PIECE(^AMER(3,RN,0),U,1)_$CHAR(30)
End DoDot:1
+7 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+8 QUIT
+9 ;
EVTYP(DATA) ; EP - ER Visit type
+1 NEW RN,ETY
+2 SET II=0
SET RN=""
+3 SET @DATA@(II)="T00010IEN^T00030"_$CHAR(30)
+4 SET ETY=$$FIND1^DIC(9009082,"","MOX","VISIT TYPE","","","ERROR")
+5 FOR
SET RN=$ORDER(^AMER(3,"AC",ETY,RN))
IF RN=""
QUIT
Begin DoDot:1
+6 SET II=II+1
SET @DATA@(II)=RN_U_$PIECE(^AMER(3,RN,0),U,1)_$CHAR(30)
End DoDot:1
+7 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+8 QUIT
+9 ;
EDACU(DATA) ;EP - ER Acuity
+1 SET II=0
SET @DATA@(II)="T00010IEN^T00060"_$CHAR(30)
+2 FOR I=1:1:5
SET II=II+1
SET @DATA@(II)=I_U_"Acuity Level "_I_$CHAR(30)
+3 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+4 QUIT
+5 ;
PRFC(DATA) ; EP - Preferred Communication
+1 NEW FLAG,VALUE,BJ,CODE,TEXT
+2 SET II=0
+3 SET @DATA@(II)="T00001CODE^T00030"_$CHAR(30)
+4 SET VALUE=$PIECE(^DD(9000001,4002,0),U,3)
+5 FOR BJ=1:1:$LENGTH(VALUE,";")
Begin DoDot:1
+6 SET CODE=$PIECE(VALUE,";",BJ)
IF CODE=""
QUIT
+7 SET TEXT=$PIECE(CODE,":",2)
+8 SET II=II+1
SET @DATA@(II)=$PIECE(CODE,":",1)_"^"_TEXT_$CHAR(30)
End DoDot:1
+9 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+10 QUIT
+11 ;
ETOP(DATA) ; EP - Education Topics
+1 NEW LN,VALUE,TOP
+2 SET II=0
SET LN=0
+3 SET @DATA@(II)="T00030IEN^T00060"_$CHAR(30)
+4 FOR
SET LN=$ORDER(^AUTTEDMT(LN))
IF 'LN
QUIT
Begin DoDot:1
+5 SET II=II+1
SET @DATA@(II)=LN_U_$PIECE(^AUTTEDMT(LN,0),U,1)_$CHAR(30)
End DoDot:1
+6 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+7 QUIT
+8 ;
EDUC(DATA) ;EP - Education
+1 NEW LN
+2 SET II=0
SET LN=0
+3 SET @DATA@(II)="T00010IEN^T00060"_$CHAR(30)
+4 FOR
SET LN=$ORDER(^AUPNVPED("B",LN))
IF LN=""
QUIT
Begin DoDot:1
+5 IF $GET(^AUTTEDT(LN,0))=""
QUIT
+6 IF $PIECE(^AUTTEDT(LN,0),U,3)'=""
QUIT
+7 SET II=II+1
SET @DATA@(II)=LN_U_$PIECE(^AUTTEDT(LN,0),U,1)_$CHAR(30)
End DoDot:1
+8 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+9 QUIT
+10 ;
TMFRAM(DATA,PARM) ;EP - List of timeframes by parameter
+1 NEW LN,BZ
+2 KILL BZ
+3 SET II=0
SET LN=""
+4 SET @DATA@(II)="T00010IEN^T00060"_$CHAR(30)
+5 SET II=II+1
SET @DATA@(II)="0^"_$CHAR(30)
+6 SET ORD=""
+7 FOR
SET ORD=$ORDER(^BQI(90506.9,"D",PARM,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+8 SET LN=$ORDER(^BQI(90506.9,"D",PARM,ORD,""))
+9 SET II=II+1
SET @DATA@(II)=LN_U_$PIECE(^BQI(90506.9,LN,0),U,1)_$CHAR(30)
End DoDot:1
+10 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+11 QUIT
+12 ;
EPICK(DATA) ;EP - EHR Education Picklists
+1 NEW RET,INP,LN
+2 SET $PIECE(INP,U,3)=DUZ
SET $PIECE(INP,U,5)=0
+3 DO GETCATS^BGOEDTPR(.RET,INP)
+4 SET II=0
SET @DATA@(II)="T00010IEN^T00060"_$CHAR(30)
+5 SET LN=0
+6 FOR
SET LN=$ORDER(@RET@(LN))
IF LN=""
QUIT
Begin DoDot:1
+7 SET II=II+1
SET @DATA@(II)=$PIECE(@RET@(LN),U,2)_U_$PIECE(@RET@(LN),U,1)_$CHAR(30)
End DoDot:1
+8 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+9 KILL @RET
+10 QUIT
+11 ;
PKIT(DATA,PICK) ;EP - BQI GET PICKLIST ITEMS
+1 NEW UID,II,LN,RET
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIUTB4P",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIUTB1 D UNWIND^%ZTER"
+7 SET @DATA@(II)="I00010IEN^T00030ED_ITEM"_$CHAR(30)
+8 DO GETITEMS^BGOEDTPR(.RET,PICK)
+9 SET LN=0
+10 FOR
SET LN=$ORDER(@RET@(LN))
IF LN=""
QUIT
Begin DoDot:1
+11 SET II=II+1
SET @DATA@(II)=$PIECE(@RET@(LN),U,1)_U_$PIECE(@RET@(LN),U,2)_$CHAR(30)
End DoDot:1
+12 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+13 KILL @RET
+14 QUIT
+15 ;
MTIT(DATA,TOP) ;EP - BQI GET ED TOPIC ITEMS
+1 NEW UID,II,LN,RET,ZZ,TEXT,TOPN
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIUTB4T",UID))
+4 KILL @DATA,ZZ
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIUTB1 D UNWIND^%ZTER"
+7 SET @DATA@(II)="I00010IEN^T00060"_$CHAR(30)
+8 SET TOPN=TOP
SET TOP=$PIECE(^AUTTEDMT(TOPN,0),U,2)
+9 SET LN=0
+10 FOR
SET LN=$ORDER(^AUTTEDT(LN))
IF 'LN
QUIT
Begin DoDot:1
+11 SET RET=$GET(^AUTTEDT(LN,0))
+12 IF RET=""
QUIT
+13 IF $PIECE(RET,U,3)'=""
QUIT
+14 IF $PIECE(RET,U,6)'=TOP
QUIT
+15 SET TEXT=$PIECE($PIECE(RET,U,1),"-",2,99)
SET ZZ(TEXT)=LN
End DoDot:1
+16 SET TEXT=""
+17 FOR
SET TEXT=$ORDER(ZZ(TEXT))
IF TEXT=""
QUIT
Begin DoDot:1
+18 SET LN=ZZ(TEXT)
+19 SET II=II+1
SET @DATA@(II)=LN_U_TEXT_$CHAR(30)
End DoDot:1
+20 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+21 QUIT
+22 ;
CRM(DATA) ;EP - Care Management Layout Sources
+1 NEW CIEN,TGIEN,RGIEN,REG,TAG,FMIEN,FORM,VIEW,REM,REPORT,KEY,PNDROP,PTDROP,MTDROP
+2 SET @DATA@(II)="I00010IEN^T00030LAYOUT^T00030FORM^T00030TAG^I00010TAG_IEN^T00030REGISTER^T00001PAT_VIEW^T00001REMINDERS^T00030REPORT^T00001PAT_DROPDOWN^T00001PAN_DROPDOWN^T00001MAT_DROPDOWN"_$CHAR(30)
+3 SET CIEN=0
+4 FOR
SET CIEN=$ORDER(^BQI(90506.5,CIEN))
IF 'CIEN
QUIT
Begin DoDot:1
+5 NEW TGIEN,RGIEN,REG,TAG,FMIEN,FORM,VIEW,REM,REPORT,KEY,PNDROP,PTDROP
+6 IF $PIECE(^BQI(90506.5,CIEN,0),U,4)'=1
QUIT
+7 IF $PIECE(^BQI(90506.5,CIEN,0),U,10)=1
QUIT
+8 SET KEY=$PIECE(^BQI(90506.5,CIEN,0),U,12)
+9 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+10 SET RGIEN=$PIECE(^BQI(90506.5,CIEN,0),U,3)
+11 IF RGIEN'=""
SET REG=$$GET1^DIQ(90507,RGIEN_",",.01,"E")
+12 IF RGIEN'=""
SET TGIEN=$ORDER(^BQI(90506.2,"AD",RGIEN,""))
+13 IF $GET(TGIEN)'=""
SET TAG=$$GET1^DIQ(90506.2,TGIEN_",",.01,"E")
+14 IF $GET(TAG)=""
SET TAG=$$GET1^DIQ(90506.5,CIEN_",",.11,"E")
SET TGIEN=$$GET1^DIQ(90506.5,CIEN_",",.11,"I")
+15 SET FMIEN=$ORDER(^BQI(90506.3,"AC",CIEN,""))
+16 IF FMIEN'=""
IF $PIECE(^BQI(90506.3,FMIEN,0),U,3)'=1
SET FORM=$$GET1^DIQ(90506.3,FMIEN_",",.01,"E")
+17 ;S VIEW=$S($P(^BQI(90506.5,CIEN,0),U,7)'="":"Y",1:"N")
+18 SET REM=$SELECT($PIECE(^BQI(90506.5,CIEN,0),U,5)'="":"Y",1:"N")
+19 SET REPORT=$PIECE(^BQI(90506.5,CIEN,0),U,8)
+20 SET VIEW=$SELECT($GET(FORM)'="":"F",$GET(REPORT)'="":"R",1:"")
+21 IF $GET(REG)=""
SET REG=$PIECE(^BQI(90506.5,CIEN,0),U,1)
+22 SET PTDROP=$SELECT($PIECE(^BQI(90506.5,CIEN,0),U,13)'="":"Y",1:"")
+23 SET PNDROP=$SELECT($PIECE(^BQI(90506.5,CIEN,0),U,14)'="":"Y",1:"")
+24 SET MTDROP=$SELECT($PIECE(^BQI(90506.5,CIEN,0),U,15)'="":"Y",1:"")
+25 ;
+26 SET II=II+1
SET @DATA@(II)=CIEN_U_$PIECE(^BQI(90506.5,CIEN,0),U,1)_U_$GET(FORM)_U_$GET(TAG)_U_$GET(TGIEN)_U_$GET(REG)_U_$GET(VIEW)_U_$GET(REM)_U_$GET(REPORT)_U_$GET(PTDROP)_U_$GET(PNDROP)_U_$GET(MTDROP)_$CHAR(30)
+27 KILL REG,TGIEN,TAG,FMIEN,FORM,VIEW,RGIEN
End DoDot:1
+28 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+29 QUIT
