BTPWTAB ;VNGT/HS/ALA-Table Utility ; 10 Jul 2008 3:00 PM
;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
;
;
Q
;
TBL(DATA,FILE,INAC) ;EP - Generic table retrieve function
;
;Description
; Return the values in a table
;Input
; FILE - FileMan file number where table resides
; INAC - If file has an inactive field to check, contains
; the node and piece in 'NODE;PIECE' format
;
NEW GLBREF,IEN,LENGTH,TEST1,DLEN,PEC,NODE,X
S INAC=$G(INAC,"")
;
S II=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIUTB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
I '$$VFILE^DILFD(FILE) S BMXSEC="Table doesn't exist in RPMS" Q
;
S GLBREF=$$ROOT^DILFD(FILE,"",1)
S LENGTH=$$GET1^DID(FILE,.01,"","FIELD LENGTH","TEST1","ERR")
S DLEN=$E("00000",$L(LENGTH)+1,5)_LENGTH
S @DATA@(II)="I00010IEN^T"_DLEN_$C(30)
;
I INAC'="" S NODE=$P(INAC,";",1),PEC=$P(INAC,";",2)
S IEN=0
F S IEN=$O(@GLBREF@(IEN)) Q:'IEN D
. I $G(@GLBREF@(IEN,0))="" Q
. I INAC'="",$P($G(@GLBREF@(IEN,NODE)),"^",PEC)'="" Q
. S II=II+1,@DATA@(II)=IEN_"^"_$$GET1^DIQ(FILE,IEN_",",.01,"E")_$C(30)
;
DONE S II=II+1,@DATA@(II)=$C(31)
Q
;
TAB(DATA,TEXT) ; EP -- BTPW GET TABLE
;
;Description
; Get the values of a table, including the internal entry
; number and the text
;Input
; TEXT - Value from parameter definition
;
NEW UID,II,X
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWTAB",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
I TEXT="CLIN" D TBL(.DATA,40.7,"")
;
I TEXT="EVENT" D PRC(.DATA)
;
I TEXT="STATUS" D STAT(.DATA)
;
I TEXT="STATE" D STE(.DATA)
;
I TEXT="CLREA" D CLSR(.DATA)
;
I TEXT="CAT" D TBL(.DATA,90621.2,"0;3")
;
I TEXT="COMM" D TAB^BQIUTB(.DATA,TEXT)
;
I TEXT="NOTT" D TBL(.DATA,90622,"0;2")
;
I TEXT="FIND" D FIND(.DATA)
;
K TEXT
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
S II=II+1,@DATA@(II)=$C(31)
Q
;
PRC(DATA) ;EP - CMET Events
NEW PIEN,BAT,PIEN,PRCNAM,CAT
S @DATA@(II)="I00010IEN^T00030PROC_NAME^T00030CATEGORY^T00001BATCH"_$C(30)
S PIEN=0
F S PIEN=$O(^BTPW(90621,PIEN)) Q:'PIEN D
. I $P(^BTPW(90621,PIEN,0),U,3)'="" Q
. S PRCNAM=$P(^BTPW(90621,PIEN,0),U,1)
. S CAT=$$GET1^DIQ(90621,PIEN_",",.1,"E")
. S BAT=$D(^BTPW(90628,1,2,"B",PIEN))
. S BAT=$S(BAT:"Y",1:"N")
. S II=II+1,@DATA@(II)=PIEN_U_PRCNAM_U_CAT_U_BAT_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
STAT(DATA) ;EP - CMET Queue Statuses
NEW VALUE,CODES,TEXT,BI
S @DATA@(II)="T00001CODE^T00030"_$C(30)
K VALUE
D FIELD^DID(90629,.08,"","POINTER","VALUE")
S CODES=$G(VALUE("POINTER"))
F BI=1:1:$L(CODES,";") D
. S TEXT=$P(CODES,";",BI)
. I TEXT="" Q
. I TEXT["EXCEPT" Q
. I $P(TEXT,":",2)="ACCEPTED" Q
. S II=II+1,@DATA@(II)=$P(TEXT,":",1)_U_$P(TEXT,":",2)_$C(30)
S II=II+1,@DATA@(II)="A"_U_"ALL"_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
STE(DATA) ;EP - CMET Event States
NEW CODES,TEXT
S @DATA@(II)="T00001CODE^T00030"_$C(30)
K VALUE
D FIELD^DID(90620,1.01,"","POINTER","VALUE")
S CODES=$G(VALUE("POINTER"))
F BI=1:1:$L(CODES,";") D
. S TEXT=$P(CODES,";",BI)
. I TEXT="" Q
. I TEXT["FUTURE" Q
. S II=II+1,@DATA@(II)=$P(TEXT,":",1)_U_$P(TEXT,":",2)_$C(30)
S II=II+1,@DATA@(II)="A"_U_"ALL"_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
CLSR(DATA) ; EP - CMET Close Reasons
NEW CODES,TEXT
S @DATA@(II)="T00001CODE^T00030"_$C(30)
K VALUE
D FIELD^DID(90620,1.04,"","POINTER","VALUE")
S CODES=$G(VALUE("POINTER"))
F BI=1:1:$L(CODES,";") D
. S TEXT=$P(CODES,";",BI)
. I TEXT="" Q
. S II=II+1,@DATA@(II)=$P(TEXT,":",1)_U_$P(TEXT,":",2)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
FIND(DATA) ; EP - Event Findings
NEW PIEN,PRCNAM,FN,FIND,INTRP,FIEN
S @DATA@(II)="I00010IEN^T00030PROC_NAME^I00010FIND_IEN^T00060FINDING^T00030INTERPRETATION"_$C(30)
S PIEN=0
F S PIEN=$O(^BTPW(90621,PIEN)) Q:'PIEN D
. I $P(^BTPW(90621,PIEN,0),U,3)'="" Q
. S PRCNAM=$P(^BTPW(90621,PIEN,0),U,1)
. S FN=0
. F S FN=$O(^BTPW(90621,PIEN,6,FN)) Q:'FN D
.. NEW IENS,DA,FIND,FIEN,INTRP
.. S DA(1)=PIEN,DA=FN,IENS=$$IENS^DILF(.DA)
.. S FIND=$$GET1^DIQ(90621.06,IENS,.01,"E"),INTRP=$$GET1^DIQ(90621.06,IENS,.02,"E")
.. S FIEN=$$GET1^DIQ(90621.06,IENS,.01,"I")
.. S II=II+1,@DATA@(II)=PIEN_U_PRCNAM_U_FIEN_U_FIND_U_INTRP_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
BTPWTAB ;VNGT/HS/ALA-Table Utility ; 10 Jul 2008 3:00 PM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
+2 ;
+3 ;
+4 QUIT
+5 ;
TBL(DATA,FILE,INAC) ;EP - Generic table retrieve function
+1 ;
+2 ;Description
+3 ; Return the values in a table
+4 ;Input
+5 ; FILE - FileMan file number where table resides
+6 ; INAC - If file has an inactive field to check, contains
+7 ; the node and piece in 'NODE;PIECE' format
+8 ;
+9 NEW GLBREF,IEN,LENGTH,TEST1,DLEN,PEC,NODE,X
+10 SET INAC=$GET(INAC,"")
+11 ;
+12 SET II=0
+13 ;
+14 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIUTB D UNWIND^%ZTER"
+15 ;
+16 IF '$$VFILE^DILFD(FILE)
SET BMXSEC="Table doesn't exist in RPMS"
QUIT
+17 ;
+18 SET GLBREF=$$ROOT^DILFD(FILE,"",1)
+19 SET LENGTH=$$GET1^DID(FILE,.01,"","FIELD LENGTH","TEST1","ERR")
+20 SET DLEN=$EXTRACT("00000",$LENGTH(LENGTH)+1,5)_LENGTH
+21 SET @DATA@(II)="I00010IEN^T"_DLEN_$CHAR(30)
+22 ;
+23 IF INAC'=""
SET NODE=$PIECE(INAC,";",1)
SET PEC=$PIECE(INAC,";",2)
+24 SET IEN=0
+25 FOR
SET IEN=$ORDER(@GLBREF@(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+26 IF $GET(@GLBREF@(IEN,0))=""
QUIT
+27 IF INAC'=""
IF $PIECE($GET(@GLBREF@(IEN,NODE)),"^",PEC)'=""
QUIT
+28 SET II=II+1
SET @DATA@(II)=IEN_"^"_$$GET1^DIQ(FILE,IEN_",",.01,"E")_$CHAR(30)
End DoDot:1
+29 ;
DONE SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
TAB(DATA,TEXT) ; EP -- BTPW GET TABLE
+1 ;
+2 ;Description
+3 ; Get the values of a table, including the internal entry
+4 ; number and the text
+5 ;Input
+6 ; TEXT - Value from parameter definition
+7 ;
+8 NEW UID,II,X
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("BTPWTAB",UID))
+11 KILL @DATA
+12 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+13 ;
+14 SET II=0
+15 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWTAB D UNWIND^%ZTER"
+16 ;
+17 IF TEXT="CLIN"
DO TBL(.DATA,40.7,"")
+18 ;
+19 IF TEXT="EVENT"
DO PRC(.DATA)
+20 ;
+21 IF TEXT="STATUS"
DO STAT(.DATA)
+22 ;
+23 IF TEXT="STATE"
DO STE(.DATA)
+24 ;
+25 IF TEXT="CLREA"
DO CLSR(.DATA)
+26 ;
+27 IF TEXT="CAT"
DO TBL(.DATA,90621.2,"0;3")
+28 ;
+29 IF TEXT="COMM"
DO TAB^BQIUTB(.DATA,TEXT)
+30 ;
+31 IF TEXT="NOTT"
DO TBL(.DATA,90622,"0;2")
+32 ;
+33 IF TEXT="FIND"
DO FIND(.DATA)
+34 ;
+35 KILL TEXT
+36 QUIT
+37 ;
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 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
PRC(DATA) ;EP - CMET Events
+1 NEW PIEN,BAT,PIEN,PRCNAM,CAT
+2 SET @DATA@(II)="I00010IEN^T00030PROC_NAME^T00030CATEGORY^T00001BATCH"_$CHAR(30)
+3 SET PIEN=0
+4 FOR
SET PIEN=$ORDER(^BTPW(90621,PIEN))
IF 'PIEN
QUIT
Begin DoDot:1
+5 IF $PIECE(^BTPW(90621,PIEN,0),U,3)'=""
QUIT
+6 SET PRCNAM=$PIECE(^BTPW(90621,PIEN,0),U,1)
+7 SET CAT=$$GET1^DIQ(90621,PIEN_",",.1,"E")
+8 SET BAT=$DATA(^BTPW(90628,1,2,"B",PIEN))
+9 SET BAT=$SELECT(BAT:"Y",1:"N")
+10 SET II=II+1
SET @DATA@(II)=PIEN_U_PRCNAM_U_CAT_U_BAT_$CHAR(30)
End DoDot:1
+11 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+12 QUIT
+13 ;
STAT(DATA) ;EP - CMET Queue Statuses
+1 NEW VALUE,CODES,TEXT,BI
+2 SET @DATA@(II)="T00001CODE^T00030"_$CHAR(30)
+3 KILL VALUE
+4 DO FIELD^DID(90629,.08,"","POINTER","VALUE")
+5 SET CODES=$GET(VALUE("POINTER"))
+6 FOR BI=1:1:$LENGTH(CODES,";")
Begin DoDot:1
+7 SET TEXT=$PIECE(CODES,";",BI)
+8 IF TEXT=""
QUIT
+9 IF TEXT["EXCEPT"
QUIT
+10 IF $PIECE(TEXT,":",2)="ACCEPTED"
QUIT
+11 SET II=II+1
SET @DATA@(II)=$PIECE(TEXT,":",1)_U_$PIECE(TEXT,":",2)_$CHAR(30)
End DoDot:1
+12 SET II=II+1
SET @DATA@(II)="A"_U_"ALL"_$CHAR(30)
+13 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+14 QUIT
+15 ;
STE(DATA) ;EP - CMET Event States
+1 NEW CODES,TEXT
+2 SET @DATA@(II)="T00001CODE^T00030"_$CHAR(30)
+3 KILL VALUE
+4 DO FIELD^DID(90620,1.01,"","POINTER","VALUE")
+5 SET CODES=$GET(VALUE("POINTER"))
+6 FOR BI=1:1:$LENGTH(CODES,";")
Begin DoDot:1
+7 SET TEXT=$PIECE(CODES,";",BI)
+8 IF TEXT=""
QUIT
+9 IF TEXT["FUTURE"
QUIT
+10 SET II=II+1
SET @DATA@(II)=$PIECE(TEXT,":",1)_U_$PIECE(TEXT,":",2)_$CHAR(30)
End DoDot:1
+11 SET II=II+1
SET @DATA@(II)="A"_U_"ALL"_$CHAR(30)
+12 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+13 QUIT
+14 ;
CLSR(DATA) ; EP - CMET Close Reasons
+1 NEW CODES,TEXT
+2 SET @DATA@(II)="T00001CODE^T00030"_$CHAR(30)
+3 KILL VALUE
+4 DO FIELD^DID(90620,1.04,"","POINTER","VALUE")
+5 SET CODES=$GET(VALUE("POINTER"))
+6 FOR BI=1:1:$LENGTH(CODES,";")
Begin DoDot:1
+7 SET TEXT=$PIECE(CODES,";",BI)
+8 IF TEXT=""
QUIT
+9 SET II=II+1
SET @DATA@(II)=$PIECE(TEXT,":",1)_U_$PIECE(TEXT,":",2)_$CHAR(30)
End DoDot:1
+10 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+11 QUIT
+12 ;
FIND(DATA) ; EP - Event Findings
+1 NEW PIEN,PRCNAM,FN,FIND,INTRP,FIEN
+2 SET @DATA@(II)="I00010IEN^T00030PROC_NAME^I00010FIND_IEN^T00060FINDING^T00030INTERPRETATION"_$CHAR(30)
+3 SET PIEN=0
+4 FOR
SET PIEN=$ORDER(^BTPW(90621,PIEN))
IF 'PIEN
QUIT
Begin DoDot:1
+5 IF $PIECE(^BTPW(90621,PIEN,0),U,3)'=""
QUIT
+6 SET PRCNAM=$PIECE(^BTPW(90621,PIEN,0),U,1)
+7 SET FN=0
+8 FOR
SET FN=$ORDER(^BTPW(90621,PIEN,6,FN))
IF 'FN
QUIT
Begin DoDot:2
+9 NEW IENS,DA,FIND,FIEN,INTRP
+10 SET DA(1)=PIEN
SET DA=FN
SET IENS=$$IENS^DILF(.DA)
+11 SET FIND=$$GET1^DIQ(90621.06,IENS,.01,"E")
SET INTRP=$$GET1^DIQ(90621.06,IENS,.02,"E")
+12 SET FIEN=$$GET1^DIQ(90621.06,IENS,.01,"I")
+13 SET II=II+1
SET @DATA@(II)=PIEN_U_PRCNAM_U_FIEN_U_FIND_U_INTRP_$CHAR(30)
End DoDot:2
End DoDot:1
+14 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+15 QUIT
