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

AGGPTDMG.m

Go to the documentation of this file. 
  1. AGGPTDMG ;VNGT/HS/ALA-Patient Registration Special Updates  ; 16 Apr 2010  9:08 AM
  1.  ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  1.  ;
  1.  ;
  1. MANY(DATA,DEF,XREF,DFN) ; EP -- AGG BUILD WINDOW MANY
  1.  ; Input
  1.  ;   DEF  - AGG Window Name
  1.  ;   XREF - Cross-reference ID for the patient (DFN)
  1.  ;   DFN  - Patient IEN
  1.  ; Description - Returns many records at a top level for one patient
  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,IEN,IENS
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGPTDMG",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)
  1.  S GLBREF=$$ROOT^DILFD(FILE,"",1),RESULT=""
  1.  S IEN="",HEADR=""
  1.  F  S IEN=$O(@GLBREF@(XREF,DFN,IEN)) Q:IEN=""  D
  1.  . S HEADR="",HDATA="",IENS=IEN_","
  1.  . D REC(IENS)
  1.  . S @DATA@(0)=HEADR_$C(30)
  1.  . S II=II+1,@DATA@(II)=HDATA_$C(30)
  1.  I HEADR="" D
  1.  . D HDR
  1.  . S @DATA@(0)=HEADR_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. MUL(DATA,DEF,NOD,RIEN,MIEN) ; EP -- AGG BUILD WINDOW MULTIPLE
  1.  ; Input
  1.  ;   DEF  - AGG Window Name
  1.  ;   XREF - Cross-reference ID for the patient (DFN)
  1.  ;   RIEN - Record IEN (could be DFN)
  1.  ;   MIEN - Specific multiple IEN
  1.  ; Description - Returns many records at a top level for one patient
  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,VAL1,VAL2,SBFIL
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGPTMUL",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),SBFIL=$P(^AGG(9009068.3,AGIEN,0),U,10)
  1.  S GLBREF=$$ROOT^DILFD(SBFIL,"",1),RESULT="",HEADR=""
  1.  I $G(MIEN)'="" D  Q
  1.  . S HEADR="",HDATA=""
  1.  . NEW DA,IENS
  1.  . S DA(1)=RIEN,DA=MIEN,IENS=$$IENS^DILF(.DA),IEN=MIEN
  1.  . D REC(IENS)
  1.  . S @DATA@(0)=HEADR_$C(30)
  1.  . S II=II+1,@DATA@(II)=HDATA_$C(30)
  1.  . S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1.  S IEN=0
  1.  F  S IEN=$O(@GLBREF@(RIEN,NOD,IEN)) Q:'IEN  D
  1.  . S HEADR="",HDATA=""
  1.  . NEW DA,IENS
  1.  . S DA(1)=RIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
  1.  . D REC(IENS)
  1.  . S @DATA@(0)=HEADR_$C(30)
  1.  . S II=II+1,@DATA@(II)=HDATA_$C(30)
  1.  I HEADR="" D
  1.  . D HDR
  1.  . S @DATA@(0)=HEADR_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. REC(IENS) ; Each Record
  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)
  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 FLD="",DEXEC="" Q
  1.  . I TYPE="M" S VALUE=""
  1.  . I TYPE="T" D
  1.  .. I DEXEC'="" D  Q
  1.  ... S VAL=""
  1.  ... S DQTY="I" X DEXEC S VAL=VALUE_$C(28)
  1.  ... S DQTY="E" X DEXEC S VAL=VAL_VALUE
  1.  .. S VALUE=$$GET1^DIQ(FILE,IENS,FLD,"I")_$C(28)_$$GET1^DIQ(FILE,IENS,FLD,"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,IENS,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,IENS,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=.001 S VALUE=IEN Q
  1.  .. S VALUE=$$GET1^DIQ(FILE,IENS,FLD,"E")
  1.  . I TYPE="D" D
  1.  .. I DEXEC'="" X DEXEC Q
  1.  .. S VALUE=$$GET1^DIQ(FILE,IENS,FLD,"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 GETS^DIQ(FILE,IENS,FLD,"E","ARRAY")
  1.  .. S FL=$O(ARRAY("")) I FL="" Q
  1.  .. S FD=$O(ARRAY(FL,IENS,"")) I FD="" Q
  1.  .. S AN=0,TXT=ARRAY(FL,IENS,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_VALUE_"^"
  1.  S HEADR=$$TKO^AGGUL1(HEADR,"^"),HDATA=$$TKO^AGGUL1(HDATA,"^")
  1.  Q
  1.  ;
  1. HDR ;
  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 HDR=$P($G(^AGG(9009068.3,AGIEN,10,AGCN,0)),U,2)
  1.  . S HEADR=HEADR_HDR_"^"
  1.  S HEADR=$$TKO^AGGUL1(HEADR,"^")
  1.  Q
  1.  ; 
  1. RACE(DATA,DFN) ; EP -- AGG PATIENT RACE
  1.  ; Input
  1.  ;    DFN    - Patients DFN or internal entry number
  1.  ;
  1.  NEW UID,II,HDR,BN,RACE,METH
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGPTRCE",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTUPD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="I00010AGGRDA^T00030AGRACE^T00030AGRMET"_$C(30)
  1.  S @DATA@(II)=HDR
  1.  S BN=0
  1.  F  S BN=$O(^DPT(DFN,.02,BN)) Q:'BN  D
  1.  . NEW DA,IENS
  1.  . S DA(1)=DFN,DA=BN,IENS=$$IENS^DILF(.DA)
  1.  . S RACE=$$GET1^DIQ(2.02,IENS,.01,"I")_$C(28)_$$GET1^DIQ(2.02,IENS,.01,"E")
  1.  . S METH=$$GET1^DIQ(2.02,IENS,.02,"I")_$C(28)_$$GET1^DIQ(2.02,IENS,.02,"E")
  1.  . S II=II+1,@DATA@(II)=BN_U_RACE_U_METH_$C(30)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ETHN(DFN,FLD) ; EP - Patient's Ethnicity
  1.  NEW BN,VAL
  1.  S BN=0,VAL=""
  1.  F  S BN=$O(^DPT(DFN,.06,BN)) Q:'BN  D
  1.  . NEW DA,IENS
  1.  . S DA(1)=DFN,DA=BN,IENS=$$IENS^DILF(.DA)
  1.  . S VAL=$$GET1^DIQ(2.06,IENS,FLD,"I")_$C(28)_$$GET1^DIQ(2.06,IENS,FLD,"E")
  1.  Q VAL
  1.  ;
  1. RCE(DFN,FLD) ; EP - Patient's Race
  1.  NEW BN,VAL
  1.  S BN=0,VAL=""
  1.  F  S BN=$O(^DPT(DFN,.02,BN)) Q:'BN  D
  1.  . NEW DA,IENS
  1.  . S DA(1)=DFN,DA=BN,IENS=$$IENS^DILF(.DA)
  1.  . S VAL=$$GET1^DIQ(2.02,IENS,FLD,"I")_$C(28)_$$GET1^DIQ(2.02,IENS,FLD,"E")
  1.  Q VAL
  1.  ;
  1. SEQ(DEF,DFN) ;EP - Sequence number
  1.  NEW AGINSN1,AGINS,AGCAT,SEQ,QFL,AGN,INSNM,INSPTR
  1.  D EP^AGINS
  1.  D LOADCAT^AGCAT
  1.  S INSNM=$$UP^XLFSTR(DEF)
  1.  S INSPTR=$$FIND1^DIC(9999999.18,"","BX",INSNM,"","","ERROR")
  1.  I $G(RIEN)="" S RIEN=DFN
  1.  S SEQ="",QFL=0
  1.  F  S SEQ=$O(AGINSNN(SEQ)) Q:SEQ=""  D  Q:QFL
  1.  . I $P($G(AGINSNN(SEQ)),U,2)=INSPTR,$P($G(AGINSNN(SEQ)),U,11)[RIEN S QFL=1 Q
  1.  . S AGN=""
  1.  . F  S AGN=$O(AGINSNN(SEQ,AGN)) Q:AGN=""  D  Q:QFL
  1.  .. I $P(AGINSNN(SEQ,AGN),U,2)=INSPTR,$P(AGINSNN(SEQ,AGN),U,11)[RIEN S QFL=1
  1.  . I DEF="Private Insurance" S INSPTR=$$GET1^DIQ(9000006.11,IENS,.01,"I")
  1.  . I $P($G(AGINSNN(SEQ)),U,2)=INSPTR,$P($G(AGINSNN(SEQ)),U,11)[RIEN S QFL=1 Q
  1.  . S AGN=""
  1.  . F  S AGN=$O(AGINSNN(SEQ,AGN)) Q:AGN=""  D  Q:QFL
  1.  .. I $P(AGINSNN(SEQ,AGN),U,2)=INSPTR,$P(AGINSNN(SEQ,AGN),U,11)[RIEN S QFL=1
  1.  K AGINSN1,AGINS,AGCAT,AGINSNN
  1.  Q SEQ
  1.  ;
  1.  NEW SEQ,SFLD
  1.  S SEQ=""
  1.  S SFLD=$S(FILE=9000006.11:.01,1:.02)
  1.  S INSPTR=$$GET1^DIQ(FILE,IENS,SFLD,"I")
  1.  I $G(DFN)="" S DFN=RIEN
  1.  I '$D(^AUPNICP("C",DFN)) Q SEQ
  1.  S SIEN="",QFL=0
  1.  F  S SIEN=$O(^AUPNICP("C",DFN,SIEN)) Q:SIEN=""!(QFL)  D
  1.  . I $P(^AUPNICP(SIEN,0),U,14)'[IENS Q
  1.  . I $P(^AUPNICP(SIEN,0),U,3)=INSPTR S SEQ=$P(^AUPNICP(SIEN,0),U,5)
  1.  Q SEQ