Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTPWTAB

BTPWTAB.m

Go to the documentation of this file. 
  1. BTPWTAB ;VNGT/HS/ALA-Table Utility ; 10 Jul 2008  3:00 PM
  1.  ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1. TBL(DATA,FILE,INAC) ;EP - Generic table retrieve function
  1.  ;
  1.  ;Description
  1.  ;  Return the values in a table
  1.  ;Input
  1.  ;  FILE - FileMan file number where table resides
  1.  ;  INAC - If file has an inactive field to check, contains
  1.  ;         the node and piece in 'NODE;PIECE' format
  1.  ;  
  1.  NEW GLBREF,IEN,LENGTH,TEST1,DLEN,PEC,NODE,X
  1.  S INAC=$G(INAC,"")
  1.  ;
  1.  S II=0
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIUTB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  I '$$VFILE^DILFD(FILE) S BMXSEC="Table doesn't exist in RPMS" Q
  1.  ;
  1.  S GLBREF=$$ROOT^DILFD(FILE,"",1)
  1.  S LENGTH=$$GET1^DID(FILE,.01,"","FIELD LENGTH","TEST1","ERR")
  1.  S DLEN=$E("00000",$L(LENGTH)+1,5)_LENGTH
  1.  S @DATA@(II)="I00010IEN^T"_DLEN_$C(30)
  1.  ;
  1.  I INAC'="" S NODE=$P(INAC,";",1),PEC=$P(INAC,";",2)
  1.  S IEN=0
  1.  F  S IEN=$O(@GLBREF@(IEN)) Q:'IEN  D
  1.  . I $G(@GLBREF@(IEN,0))="" Q
  1.  . I INAC'="",$P($G(@GLBREF@(IEN,NODE)),"^",PEC)'="" Q
  1.  . S II=II+1,@DATA@(II)=IEN_"^"_$$GET1^DIQ(FILE,IEN_",",.01,"E")_$C(30)
  1.  ;
  1. DONE S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. TAB(DATA,TEXT) ;  EP -- BTPW GET TABLE
  1.  ;
  1.  ;Description
  1.  ;  Get the values of a table, including the internal entry
  1.  ;  number and the text
  1.  ;Input
  1.  ;  TEXT - Value from parameter definition
  1.  ;
  1.  NEW UID,II,X
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWTAB",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  I TEXT="CLIN" D TBL(.DATA,40.7,"")
  1.  ;
  1.  I TEXT="EVENT" D PRC(.DATA)
  1.  ;
  1.  I TEXT="STATUS" D STAT(.DATA)
  1.  ;
  1.  I TEXT="STATE" D STE(.DATA)
  1.  ;
  1.  I TEXT="CLREA" D CLSR(.DATA)
  1.  ;
  1.  I TEXT="CAT" D TBL(.DATA,90621.2,"0;3")
  1.  ;
  1.  I TEXT="COMM" D TAB^BQIUTB(.DATA,TEXT)
  1.  ;
  1.  I TEXT="NOTT" D TBL(.DATA,90622,"0;2")
  1.  ;
  1.  I TEXT="FIND" D FIND(.DATA)
  1.  ;
  1.  K TEXT
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. PRC(DATA) ;EP - CMET Events
  1.  NEW PIEN,BAT,PIEN,PRCNAM,CAT
  1.  S @DATA@(II)="I00010IEN^T00030PROC_NAME^T00030CATEGORY^T00001BATCH"_$C(30)
  1.  S PIEN=0
  1.  F  S PIEN=$O(^BTPW(90621,PIEN)) Q:'PIEN  D
  1.  . I $P(^BTPW(90621,PIEN,0),U,3)'="" Q
  1.  . S PRCNAM=$P(^BTPW(90621,PIEN,0),U,1)
  1.  . S CAT=$$GET1^DIQ(90621,PIEN_",",.1,"E")
  1.  . S BAT=$D(^BTPW(90628,1,2,"B",PIEN))
  1.  . S BAT=$S(BAT:"Y",1:"N")
  1.  . S II=II+1,@DATA@(II)=PIEN_U_PRCNAM_U_CAT_U_BAT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. STAT(DATA) ;EP - CMET Queue Statuses
  1.  NEW VALUE,CODES,TEXT,BI
  1.  S @DATA@(II)="T00001CODE^T00030"_$C(30)
  1.  K VALUE
  1.  D FIELD^DID(90629,.08,"","POINTER","VALUE")
  1.  S CODES=$G(VALUE("POINTER"))
  1.  F BI=1:1:$L(CODES,";") D
  1.  . S TEXT=$P(CODES,";",BI)
  1.  . I TEXT="" Q
  1.  . I TEXT["EXCEPT" Q
  1.  . I $P(TEXT,":",2)="ACCEPTED" Q
  1.  . S II=II+1,@DATA@(II)=$P(TEXT,":",1)_U_$P(TEXT,":",2)_$C(30)
  1.  S II=II+1,@DATA@(II)="A"_U_"ALL"_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. STE(DATA) ;EP - CMET Event States
  1.  NEW CODES,TEXT
  1.  S @DATA@(II)="T00001CODE^T00030"_$C(30)
  1.  K VALUE
  1.  D FIELD^DID(90620,1.01,"","POINTER","VALUE")
  1.  S CODES=$G(VALUE("POINTER"))
  1.  F BI=1:1:$L(CODES,";") D
  1.  . S TEXT=$P(CODES,";",BI)
  1.  . I TEXT="" Q
  1.  . I TEXT["FUTURE" Q
  1.  . S II=II+1,@DATA@(II)=$P(TEXT,":",1)_U_$P(TEXT,":",2)_$C(30)
  1.  S II=II+1,@DATA@(II)="A"_U_"ALL"_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. CLSR(DATA) ; EP - CMET Close Reasons
  1.  NEW CODES,TEXT
  1.  S @DATA@(II)="T00001CODE^T00030"_$C(30)
  1.  K VALUE
  1.  D FIELD^DID(90620,1.04,"","POINTER","VALUE")
  1.  S CODES=$G(VALUE("POINTER"))
  1.  F BI=1:1:$L(CODES,";") D
  1.  . S TEXT=$P(CODES,";",BI)
  1.  . I TEXT="" Q
  1.  . S II=II+1,@DATA@(II)=$P(TEXT,":",1)_U_$P(TEXT,":",2)_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. FIND(DATA) ; EP - Event Findings
  1.  NEW PIEN,PRCNAM,FN,FIND,INTRP,FIEN
  1.  S @DATA@(II)="I00010IEN^T00030PROC_NAME^I00010FIND_IEN^T00060FINDING^T00030INTERPRETATION"_$C(30)
  1.  S PIEN=0
  1.  F  S PIEN=$O(^BTPW(90621,PIEN)) Q:'PIEN  D
  1.  . I $P(^BTPW(90621,PIEN,0),U,3)'="" Q
  1.  . S PRCNAM=$P(^BTPW(90621,PIEN,0),U,1)
  1.  . S FN=0
  1.  . F  S FN=$O(^BTPW(90621,PIEN,6,FN)) Q:'FN  D
  1.  .. NEW IENS,DA,FIND,FIEN,INTRP
  1.  .. S DA(1)=PIEN,DA=FN,IENS=$$IENS^DILF(.DA)
  1.  .. S FIND=$$GET1^DIQ(90621.06,IENS,.01,"E"),INTRP=$$GET1^DIQ(90621.06,IENS,.02,"E")
  1.  .. S FIEN=$$GET1^DIQ(90621.06,IENS,.01,"I")
  1.  .. S II=II+1,@DATA@(II)=PIEN_U_PRCNAM_U_FIEN_U_FIND_U_INTRP_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q