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

AGGWDISP.m

Go to the documentation of this file. 
  1. AGGWDISP ;VNGT/HS/ALA-Build Window Display ; 09 Apr 2010  7:57 AM
  1.  ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  1.  ;
  1.  ;
  1. BLD(DATA,DEF,DFN) ; EP -- AGG BUILD WINDOW DISPLAY
  1.  ;
  1.  ;
  1.  NEW UID,II,AGIEN,AGCN,AGDATA,FLD,TYPE,CODE,DEXEC,ARRAY,AN,DQTY,VAL,VALUE,HEADR,HDATA,FILE,FL,FD
  1.  NEW VHD,J,K,LEN,LG,LN,ECHR,HDR,SECFILE,SECFLD,RET,VAL1,VAL2
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGWDISP",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWDISP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S AGIEN=$$FIND1^DIC(9009068.3,"","BX",DEF,"","","ERROR")
  1.  I AGIEN=0 S BMXSEC="RPC Failed: Passed in window name "_DEF_" not found" Q
  1.  ;
  1.  S FILE=$P(^AGG(9009068.3,AGIEN,0),U,2),SECFILE=$P(^AGG(9009068.3,AGIEN,0),U,14)
  1.  S HEADR="",HDATA=""
  1.  S AGCN=0
  1.  F  S AGCN=$O(^AGG(9009068.3,AGIEN,10,AGCN)) Q:'AGCN  D
  1.  . I $P(^AGG(9009068.3,AGIEN,10,AGCN,0),U,11)'="" Q
  1.  . S AGDATA=$G(^AGG(9009068.3,AGIEN,10,AGCN,0))
  1.  . S FLD=$P($G(^AGG(9009068.3,AGIEN,10,AGCN,3)),U,1),SECFLD=$P($G(^AGG(9009068.3,AGIEN,10,AGCN,3)),U,7)
  1.  . S RET=$P($G(^AGG(9009068.3,AGIEN,10,AGCN,3)),U,2)
  1.  . S TYPE=$P($G(^AGG(9009068.3,AGIEN,10,AGCN,1)),U,1)
  1.  . S CODE=$P(AGDATA,U,7),HDR=$P(AGDATA,U,2)
  1.  . S DEXEC=$G(^AGG(9009068.3,AGIEN,10,AGCN,8))
  1.  . I TYPE="M" S VALUE=""
  1.  . I TYPE="T" D
  1.  .. I DEXEC'="" D  Q
  1.  ... S VAL=""
  1.  ... I DEXEC'["DQTY" X DEXEC Q
  1.  ... S DQTY="I" X DEXEC S VAL=VALUE_$C(28)
  1.  ... S DQTY="E" X DEXEC S VALUE=VAL_VALUE
  1.  .. I FLD'="" S VALUE=$$GET1^DIQ(FILE,DFN_",",FLD,"I")_$C(28)_$$GET1^DIQ(FILE,DFN_",",FLD,"E") Q
  1.  .. S VALUE=$$GET1^DIQ(SECFILE,DFN_",",SECFLD,"I")_$C(28)_$$GET1^DIQ(SECFILE,DFN_",",SECFLD,"E")
  1.  . I (TYPE="C")!(TYPE="K") D
  1.  .. I DEXEC'="" D  Q
  1.  ... S VAL=""
  1.  ... I DEXEC'["DQTY" X DEXEC Q
  1.  ... S DQTY="I" X DEXEC S VAL=VALUE_$C(28)
  1.  ... S DQTY="E" X DEXEC S VALUE=VAL_VALUE
  1.  .. I FLD'="" D  Q
  1.  ... S VAL1=$$GET1^DIQ(FILE,DFN_",",FLD,"I") I VAL1="" Q
  1.  ... S VAL2=$O(^AGG(9009068.3,AGIEN,10,AGCN,5,"C",VAL1,"")) I VAL2="" Q
  1.  ... S VAL2=$P(^AGG(9009068.3,AGIEN,10,AGCN,5,VAL2,0),U,1)
  1.  ... S VALUE=VAL1_$C(28)_VAL2
  1.  .. S VAL1=$$GET1^DIQ(SECFILE,DFN_",",SECFLD,"I") I VAL1="" Q
  1.  .. S VAL2=$O(^AGG(9009068.3,AGIEN,10,AGCN,5,"C",VAL1,"")) I VAL2="" Q
  1.  .. S VAL2=$P(^AGG(9009068.3,AGIEN,10,AGCN,5,VAL2,0),U,1)
  1.  .. S VALUE=VAL1_$C(28)_VAL2
  1.  . I TYPE="X"!(TYPE="N") D
  1.  .. NEW TYPE
  1.  .. I DEXEC'="" X DEXEC Q
  1.  .. I FLD'="",FLD=.001 S VALUE=DFN Q
  1.  .. I FLD'="",RET="I" D  Q
  1.  ... S VALUE=$$GET1^DIQ(FILE,DFN_",",FLD,"I") Q
  1.  ... S VALUE=$$GET1^DIQ(SECFILE,DFN_",",SECFLD,"I")
  1.  .. I FLD'="" S VALUE=$$GET1^DIQ(FILE,DFN_",",FLD,"E") Q
  1.  .. S VALUE=$$GET1^DIQ(SECFILE,DFN_",",SECFLD,"E")
  1.  . I TYPE="D" D
  1.  .. I DEXEC'="" X DEXEC Q
  1.  .. I FLD'="" S VALUE=$$GET1^DIQ(FILE,DFN_",",FLD,"I"),VALUE=$$FMTE^AGGUL1(VALUE) Q
  1.  .. S VALUE=$$GET1^DIQ(SECFILE,DFN_",",SECFLD,"I"),VALUE=$$FMTE^AGGUL1(VALUE)
  1.  . I TYPE="W" D
  1.  .. NEW FL,FD
  1.  .. K ARRAY S VALUE=""
  1.  .. I DEXEC'="" X DEXEC
  1.  .. I DEXEC="" D
  1.  ... I FLD'="" D GETS^DIQ(FILE,DFN_",",FLD,"E","ARRAY") Q
  1.  ... D GETS^DIQ(SECFILE,DFN_",",SECFLD,"E","ARRAY")
  1.  .. S FL=$O(ARRAY("")) I FL="" Q
  1.  .. S FD=$O(ARRAY(FL,DFN_",","")) I FD="" Q
  1.  .. S AN=0,TXT=ARRAY(FL,DFN_",",FD,"E") I TXT="" Q
  1.  .. K @TXT@("E")
  1.  .. F  S AN=$O(@TXT@(AN)) Q:AN=""  S VALUE=VALUE_@TXT@(AN)_$C(10)
  1.  . S HEADR=HEADR_HDR_"^"
  1.  . S HDATA=HDATA_$G(VALUE)_"^",VALUE=""
  1.  S HEADR=$$TKO^AGGUL1(HEADR,"^"),HDATA=$$TKO^AGGUL1(HDATA,"^")
  1.  S @DATA@(II)=HEADR_$C(30)
  1.  I $$STRIP^XLFSTR(HDATA,$C(28)_"^")'="" S II=II+1,@DATA@(II)=HDATA_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  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
  1.  ;
  1. CMP(DFN,WHICH,PART) ;EP - Get component part
  1.  ; Input
  1.  ;   DFN   - Patient IEN
  1.  ;   PART  - Part of name (1=Last, 2=First, 3=Middle, 4=Prefix, 5=Suffix, 6=Degree
  1.  ;   WHICH - Piece of "NAME" node corresponding to type of component
  1.  ;           1=Patient Name, 2=NOK Name, 3=NOK2 Name, 4=Father's Name, 5=Mother's Name
  1.  ;           6=Mother's Maiden Name, 7=EC Name, 8=EC2 Name, 9=Designee name
  1.  ;   ALT   - Alternate place for the data in NODE;PEC format
  1.  ;
  1.  NEW IEN,ALT,REF,NOD,PEC,VALUE,NAME,RESULT
  1.  S RESULT=""
  1.  I DFN="" Q RESULT
  1.  S IEN=$P($G(^DPT(DFN,"NAME")),"^",WHICH)
  1.  S ALT="0;1^.21;1^.211;1^.24;1^.24;2^.24;3^.33;1^.331;1^.34;1"
  1.  I $G(IEN)'="" S RESULT=$P($G(^VA(20,IEN,1)),"^",PART) I RESULT="" S IEN=""
  1.  I $G(IEN)="" D
  1.  . S REF=$P(ALT,"^",WHICH),NOD=$P(REF,";",1),PEC=$P(REF,";",2)
  1.  . S VALUE=$P($G(^DPT(DFN,NOD)),"^",PEC)
  1.  . K NAME
  1.  . S NAME=VALUE
  1.  . D STDNAME^XLFNAME(.NAME,"FC")
  1.  . S RESULT=$S(PART=1:NAME("FAMILY"),PART=2:NAME("GIVEN"),PART=3:NAME("MIDDLE"),PART=4:NAME("SUFFIX"),1:"")
  1.  Q RESULT
  1.  ;
  1. MUL(DFN,FILE,TFLD,LFLD,VAL) ;EP - Returns most recent (last entered) data from a multiple
  1.  ; Input
  1.  ;   FILE - File Number
  1.  ;   TFLD - Top level field number that references the lower fields
  1.  ;   LFLD - Lower level field number where data resides
  1.  ;   DFN  - Patient IEN
  1.  ;   VAL  - "I" for internal value, "E" for external value, "B" for both (pair) value, "D" for dates
  1.  ;
  1.  NEW DA,IENS,GLBREF,ARR,RESULT,SBFIL,NAM,REF,NOD
  1.  S GLBREF=$$ROOT^DILFD(FILE,"",0),RESULT=""
  1.  F NAM="GLOBAL SUBSCRIPT LOCATION","SPECIFIER" D FIELD^DID(FILE,TFLD,"",NAM,"ARR")
  1.  S NOD=$P($G(ARR("GLOBAL SUBSCRIPT LOCATION")),";",1),SBFIL=$G(ARR("SPECIFIER"))
  1.  S SBFIL=$$STRIP^XLFSTR(SBFIL,"ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  I $G(DFN)="" Q RESULT
  1.  S REF=GLBREF_DFN_","_NOD_")"
  1.  S DA=$O(@REF@("A"),-1) I DA=0!(DA="") Q RESULT
  1.  S DA(1)=DFN,IENS=$$IENS^DILF(.DA)
  1.  I VAL="D" S RESULT=$$GET1^DIQ(SBFIL,IENS,LFLD,"I"),RESULT=$$FMTE^AGGUL1(RESULT) Q RESULT
  1.  I VAL'="B" S RESULT=$$GET1^DIQ(SBFIL,IENS,LFLD,VAL)
  1.  I VAL="B" S RESULT=$$GET1^DIQ(SBFIL,IENS,LFLD,"I")_$C(28)_$$GET1^DIQ(SBFIL,IENS,LFLD,"E")
  1.  Q RESULT