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

AGGUTB.m

Go to the documentation of this file. 
  1. AGGUTB ;VNGT/HS/ALA-Table utilities ; 08 Apr 2010  3:45 PM
  1.  ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  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,TXT
  1.  S INAC=$G(INAC,"")
  1.  ;
  1.  S II=0
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGUTB 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 TXT=$$GET1^DIQ(FILE,IEN_",",.01,"E")
  1.  . S II=II+1,@DATA@(II)=IEN_"^"_TXT_$C(30)
  1.  ;
  1. DONE S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. TAB(DATA,TEXT) ;  PEP -- AGG 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("AGGTABLE",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^AGGUTB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  I TEXT="PROV" D USR(.DATA,"P")
  1.  ;
  1.  I TEXT="COMM" D COMM(.DATA,9999999.05,0)
  1.  I TEXT="COMMALL" D COMM(.DATA,9999999.05,1)
  1.  ;
  1.  I TEXT="CLIN" D TBL(.DATA,40.7,"")
  1.  ;
  1.  I TEXT="USER" D USR(.DATA,"")
  1.  ;
  1.  I TEXT="ILOC" D TBL(.DATA,9999999.06,"0;21")
  1.  ;
  1.  ;I TEXT="VFILE" D VFL(.DATA,"V")
  1.  I TEXT="WINDOW" D VFL(.DATA,"C")
  1.  ;
  1.  I TEXT="COMMTX" D COMMTX(.DATA)
  1.  ;
  1.  I TEXT="BEN" D BEN(.DATA)
  1.  ;
  1.  I TEXT="FH9999999.36" D FHREL(.DATA)
  1.  ;
  1.  I TEXT="INS" D INS(.DATA)
  1.  ;
  1.  K TEXT
  1.  Q
  1.  ;
  1. USR(DATA,TYPE) ;EP - Go through the User File
  1.  ;
  1.  ;Input
  1.  ;  TYPE - "P" is for provider, otherwise it's a regular user
  1.  ;
  1.  S II=0
  1.  S LENGTH=$$GET1^DID(200,.01,"","FIELD LENGTH","TEST1","ERR")
  1.  S DLEN=$E("00000",$L(LENGTH)+1,5)_LENGTH
  1.  S @DATA@(II)="I00010IEN^T"_DLEN_"^T00001PROVIDER"_$C(30)
  1.  ;
  1.  I TYPE="P" D  G DONE
  1.  . NEW NAME,IEN
  1.  . S NAME=""
  1.  . F  S NAME=$O(^VA(200,"AK.PROVIDER",NAME)) Q:NAME=""  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^VA(200,"AK.PROVIDER",NAME,IEN)) Q:IEN=""  D
  1.  ... I $G(^VA(200,IEN,0))="" Q
  1.  ... I IEN\1'=IEN Q
  1.  ... I $P($G(^VA(200,IEN,"PS")),U,4)'="",DT'>$P(^("PS"),U,4) Q
  1.  ... I +$P($G(^VA(200,IEN,0)),U,11)'>0,$P(^(0),U,11)'>DT D
  1.  .... S II=II+1,@DATA@(II)=IEN_"^"_NAME_$C(30)
  1.  ;
  1.  NEW IEN,NAME,PFLAG
  1.  S IEN=.6
  1.  F  S IEN=$O(^VA(200,IEN)) Q:'IEN  D
  1.  . I $G(^VA(200,IEN,0))="" Q
  1.  . I IEN\1'=IEN Q
  1.  . I +$P($G(^VA(200,IEN,0)),U,11)'>0,$P(^(0),U,11)'>DT D
  1.  .. S NAME=$$GET1^DIQ(200,IEN_",",.01,"E")
  1.  .. I NAME="" Q
  1.  .. S PFLAG=$S($D(^VA(200,"AK.PROVIDER",NAME,IEN)):"P",1:"")
  1.  .. S II=II+1,@DATA@(II)=IEN_"^"_NAME_"^"_PFLAG_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. COMM(DATA,FILE,FLAG) ;EP - Get the Community Table
  1.  NEW CIEN
  1.  S II=0
  1.  S @DATA@(II)="I00010IEN^T00050"_$C(30)
  1.  ;
  1.  S CIEN=0
  1.  F  S CIEN=$O(^AUTTCOM(CIEN)) Q:'CIEN  D
  1.  . I $P(^AUTTCOM(CIEN,0),U,18)'="" Q
  1.  . S II=II+1,@DATA@(II)=CIEN_U_$P(^AUTTCOM(CIEN,0),U,1)_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. INS(DATA) ; EP - Get Insurance Table
  1.  NEW IIEN,IENS,II
  1.  S II=0
  1.  S @DATA@(II)="I00010IEN^T00030NAME^T00030STREET^T00015CITY^T00030STATE^T00010ZIP^T00025TYPE^T00013PHONE"_$C(30)
  1.  S IIEN=0
  1.  F  S IIEN=$O(^AUTNINS(IIEN)) Q:'IIEN  D
  1.  . I $P($G(^AUTNINS(IIEN,1)),"^",7)=0 Q
  1.  . S INS=^AUTNINS(IIEN,0)
  1.  . S ST=$P(INS,U,4) I ST'="" S ST=$P(^DIC(5,ST,0),U,1)
  1.  . S II=II+1,@DATA@(II)=IIEN_U_$P(INS,U,1)_U_$P(INS,U,2)_U_$P(INS,U,3)_U_ST_U_$P(INS,U,5)_U_$P($G(^AUTNINS(IIEN,2)),U,1)_U_$P(INS,U,6)_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. FHREL(DATA) ;EP - Get the Family History Version Subset of File 9999999.36
  1.  ;
  1.  NEW IEN,II,REL
  1.  ;
  1.  S II=0
  1.  ;
  1.  S @DATA@(II)="I00010IEN^T00070"_$C(30)
  1.  ;
  1.  S REL="" F  S REL=$O(^AUTTRLSH("B",REL)) Q:REL=""  S IEN="" F  S IEN=$O(^AUTTRLSH("B",REL,IEN)) Q:'IEN  D
  1.  . N N,PCC
  1.  . S N=$G(^AUTTRLSH(IEN,0))
  1.  . I $P(N,U,6)=1 Q  ; Quit if inactive
  1.  . S PCC=$P($G(^AUTTRLSH(IEN,21)),U) Q:PCC'=1  ;Filter on USE FOR PCC FAMILY HISTORY field
  1.  . S II=II+1,@DATA@(II)=IEN_U_$P(N,U)_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. COMMTX(DATA) ;EP - Get list of Community Taxonomies
  1.  N TAXIEN,TYPE,COM,ITEM,OK,COMTXNM
  1.  S TAXIEN=0
  1.  S @DATA@(II)="I00010IEN^T00050COMM_TAX_NAME"_$C(30)
  1.  F  S TAXIEN=$O(^ATXAX(TAXIEN)) Q:'TAXIEN  D
  1.  . S TYPE=$P($G(^ATXAX(TAXIEN,0)),"^",15) Q:TYPE'=9999999.05
  1.  . S ITEM=0,OK=0
  1.  . F  S ITEM=$O(^ATXAX(TAXIEN,21,ITEM)) Q:'ITEM  D  Q:OK
  1.  .. S COM=$P(^ATXAX(TAXIEN,21,ITEM,0),U) Q:COM=""
  1.  .. I '$D(^AUTTCOM("B",COM)) Q
  1.  .. S COMTXNM=$$GET1^DIQ(9002226,TAXIEN,.01,"I"),OK=1
  1.  .. S II=II+1,@DATA@(II)=TAXIEN_"^"_COMTXNM_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. BEN(DATA) ;EP - Get list of Beneficiary Codes
  1.  N BENIEN,NAME,CODE
  1.  S BENIEN=0
  1.  S @DATA@(II)="I00010IEN^T00050"_$C(30)
  1.  F  S BENIEN=$O(^AUTTBEN(BENIEN)) Q:'BENIEN  D
  1.  . I '$D(^AUTTBEN(BENIEN,0)) Q
  1.  . S NAME=$P(^AUTTBEN(BENIEN,0),"^")
  1.  . S II=II+1,@DATA@(II)=BENIEN_"^"_NAME_$C(30) ;_"^"_CODE_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. VFL(DATA,FTYP) ;EP - Get list of Vfiles
  1.  S II=0
  1.  S @DATA@(II)="I00010IEN^T00030^T00100SORT_ORDER^T00100SORT_DIR^T00001FILTER"_$C(30)
  1.  NEW IEN,IACT,SORT,SN,SIEN,COLMN,SDIR,DIR
  1.  S IEN=0
  1.  F  S IEN=$O(^AGG(9009068.3,"D",FTYP,IEN)) Q:'IEN  D
  1.  . ; If Window entry is flagged 'Do not display or extract', quit
  1.  . I +$$GET1^DIQ(90506.3,IEN_",",.05,"I") Q
  1.  . S II=II+1
  1.  . S IACT=$$GET1^DIQ(90506.3,IEN_",",.03,"I")
  1.  . S NAME=$$GET1^DIQ(90506.3,IEN_",",.01,"E")
  1.  . ; If a sub-definition, do not pull
  1.  . I $$GET1^DIQ(90506.3,IEN_",",.07,"I")=1 Q
  1.  . S FILTER=$S($D(^AGG(9009068.3,IEN,7)):"Y",1:"N")
  1.  . ;
  1.  . ; Get Sort Order
  1.  . S SORT="",SN="",SDIR=""
  1.  . F  S SN=$O(^AGG(9009068.3,IEN,10,"D",SN)) Q:SN=""  D
  1.  .. S SIEN=""
  1.  .. F  S SIEN=$O(^AGG(9009068.3,IEN,10,"D",SN,SIEN)) Q:SIEN=""  D
  1.  ... ; If the field is inactive, quit
  1.  ... I $P(^AGG(9009068.3,IEN,10,SIEN,0),U,11)=1 Q
  1.  ... S COLMN=$P(^AGG(9009068.3,IEN,10,SIEN,0),U,2)
  1.  ... S DIR=$P(^AGG(9009068.3,IEN,10,SIEN,0),U,13)
  1.  ... ; Strip off the size and only keep the name
  1.  ... S COLMN=$E(COLMN,7,$L(COLMN))
  1.  ... S SORT=SORT_COLMN_$C(29)
  1.  ... S SDIR=SDIR_DIR_$C(29)
  1.  . S SORT=$$TKO^AGGUL1(SORT,$C(29))
  1.  . S SDIR=$$TKO^AGGUL1(SDIR,$C(29))
  1.  . S @DATA@(II)=IEN_U_$S(IACT=1:"*",1:"")_NAME_U_SORT_U_SDIR_U_FILTER_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  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.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q