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

AGGDCUPD.m

Go to the documentation of this file.
  1. AGGDCUPD ;VNGT/HS/ALA-Document Update ; 19 May 2010 3:32 PM
  1. ;;1.0;PATIENT REGISTRATION GUI;**1**;Nov 15, 2010
  1. ;
  1. ;
  1. UPD(DATA,DEF,DFN,PARMS) ; EP - AGG UPDATE DOCUMENTS
  1. ; Input
  1. ; DEF - Definition Name
  1. ; DFN - Patient IEN
  1. ; PARMS - Parameters
  1. NEW UID,II,BN,LIST,PDATA,NAME,VALUE,VFIEN,FILE,PTYP,CHIEN,FIELD,EXEC,WDATA
  1. NEW AGGDATA,ERROR,RESULT,AGGINT,PTYP,AGGPTRSI,AGGRHIDT,AGGRHIO,AGGRHTXT
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("AGGDCUPD",UID))
  1. K @DATA
  1. ;
  1. S II=0
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTUPD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
  1. ;
  1. S VFIEN=$O(^AGG(9009068.3,"B",DEF,""))
  1. I VFIEN="" S BMXSEC="RPC Call Failed: "_DEF_" Definition does not exist." Q
  1. S FILE=$P(^AGG(9009068.3,VFIEN,0),U,2),SECFILE=$P(^AGG(9009068.3,VFIEN,0),U,14)
  1. ;
  1. I $G(^AUPNNPP(DFN,0))="" D NEWP
  1. ;
  1. ; Get previous data
  1. NEW FLD,LIST
  1. S FLD="",LIST="" F S FLD=$O(^AGG(9009068.3,VFIEN,10,"AD",FLD)) Q:FLD="" S LIST=LIST_FLD_";"
  1. S LIST=$$TKO^AGGUL1(LIST,";")
  1. D GETS^DIQ(FILE,DFN_",",LIST,"I","AGGINT")
  1. ;
  1. NEW FLD,LIST
  1. S DA=$O(^AUPNRHI("B",DFN,""))
  1. I DA'="" D
  1. . S FLD="",LIST="" F S FLD=$O(^AGG(9009068.3,VFIEN,10,"AG",FLD)) Q:FLD="" S LIST=LIST_FLD_";"
  1. . D GETS^DIQ(SECFILE,DA_",",LIST,"I","AGGINT")
  1. ;
  1. S PARMS=$G(PARMS,"")
  1. I PARMS="" D
  1. . S LIST="",BN=""
  1. . F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
  1. . K PARMS
  1. . S PARMS=LIST
  1. . K LIST
  1. ;
  1. F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
  1. . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1. . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1. . ;I VALUE="" S VALUE="@"
  1. . ;I VALUE="" Q
  1. . S PFIEN=$O(^AGG(9009068.3,VFIEN,10,"AC",NAME,""))
  1. . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
  1. . S PTYP=$P($G(^AGG(9009068.3,VFIEN,10,PFIEN,1)),U,1)
  1. . I PTYP="D" S VALUE=$$DATE^AGGUL1(VALUE)
  1. . ;I PTYP="T" S VALUE=VALUE
  1. . I PTYP="C"!(PTYP="K") D
  1. .. I VALUE="" Q
  1. .. S CHIEN=$O(^AGG(9009068.3,VFIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
  1. .. S VALUE=$P(^AGG(9009068.3,VFIEN,10,PFIEN,5,CHIEN,0),U,2)
  1. . I PTYP="W" D Q
  1. .. F AGI=1:1 S AGJ=$P(VALUE,$C(10),AGI) Q:AGJ="" D
  1. ... S AGWP(AGI,0)=$$CTRL^AGGUL1(AGJ)
  1. . ;
  1. . S FIELD=$P($G(^AGG(9009068.3,VFIEN,10,PFIEN,3)),U,1),SECFLD=$P($G(^AGG(9009068.3,VFIEN,10,PFIEN,3)),U,7)
  1. . I FIELD'="",$G(AGGINT(FILE,DFN_",",FIELD,"I"))'="",VALUE="" S VALUE="@"
  1. . I SECFLD'="",$G(AGGINT(SECFILE,DA_",",SECFLD,"I"))'="",VALUE="" S VALUE="@"
  1. . S @NAME=VALUE
  1. ;
  1. F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
  1. . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1. . S NAME=$P(PDATA,"=",1)
  1. . S PFIEN=$O(^AGG(9009068.3,VFIEN,10,"AC",NAME,""))
  1. . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
  1. . S FIELD=$P($G(^AGG(9009068.3,VFIEN,10,PFIEN,3)),U,1),SECFLD=$P($G(^AGG(9009068.3,VFIEN,10,PFIEN,3)),U,7)
  1. . S PTYP=$P($G(^AGG(9009068.3,VFIEN,10,PFIEN,1)),U,1)
  1. . S EXEC=$G(^AGG(9009068.3,VFIEN,10,PFIEN,7))
  1. . I EXEC'="" X EXEC Q
  1. . I FIELD="",SECFLD="" Q
  1. . S PTYP=$P($G(^AGG(9009068.3,VFIEN,10,PFIEN,1)),U,1)
  1. . I PTYP="C"!(PTYP="T")!(PTYP="K") D Q
  1. .. I FIELD'="" S AGGDATAI(FILE,DFN_",",FIELD)=@NAME Q
  1. .. I SECFLD'="" S AGGDATAI(SECFILE,DA_",",SECFLD)=@NAME
  1. . I FIELD'="" S AGGDATA(FILE,DFN_",",FIELD)=@NAME Q
  1. . I SECFLD'="" S AGGDATA(SECFILE,DA_",",SECFLD)=@NAME
  1. ;
  1. S RESULT=1_U
  1. ;
  1. I $D(AGGWP) D
  1. . NEW FL,FD,IENS,FLAG
  1. . S FL=""
  1. . F S FL=$O(AGGWP(FL)) Q:FL="" D
  1. .. S IENS=""
  1. .. F S IENS=$O(AGGWP(FL,IENS)) Q:IENS="" D
  1. ... S FD=""
  1. ... F S FD=$O(AGGWP(FL,IENS,FD)) Q:FD="" D
  1. .... S FLAG=""
  1. .... ;I FL=9000001,FD=1301 S FLAG="A"
  1. .... I $D(WDATA) D WP^DIE(FL,IENS,FD,FLAG,WDATA,"ERROR")
  1. ;
  1. K AGGWP,AGWP
  1. I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR",1,"TEXT",1))
  1. K ERROR
  1. I $D(AGGDATA)>0 D FILE^DIE("","AGGDATA","ERROR")
  1. I $D(AGGDATAI)>0 D FILE^DIE("I","AGGDATAI","ERROR")
  1. I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR",1,"TEXT",1))
  1. I $P(RESULT,U,1)'=-1 S RESULT=1_U
  1. S II=II+1,@DATA@(II)=RESULT_$C(30)
  1. ;
  1. I $P(RESULT,U,1)=1 D
  1. . S AGGDATAI(9000001,DFN_",",.03)=DT,AGGDATAI(9000001,DFN_",",.12)=DUZ
  1. . D FILE^DIE("","AGGDATAI","ERROR")
  1. . D EDIT^AGGEXPRT(DFN)
  1. ;
  1. K AGGDATA,AGGDATAI
  1. S NAME=""
  1. F S NAME=$O(^AGG(9009068.3,VFIEN,10,"AC",NAME)) Q:NAME="" K @NAME
  1. ;
  1. DONE ;
  1. S II=II+1,@DATA@(II)=$C(31)
  1. Q
  1. ;
  1. NEWP ;
  1. NEW DIC,DLAYGO,Y,X,DINUM
  1. S DIC="^AUPNNPP("
  1. S DIC(0)="L"
  1. S DLAYGO=9000038
  1. ;S X="`"_DFN
  1. S (X,DINUM)=DFN
  1. ;D ^DIC
  1. ;I Y=-1 K DO,DD D FILE^DICN
  1. K DO,DD D FILE^DICN
  1. S DA=+Y
  1. S AGGDATAI(FILE,DA_",",.06)=$$NOW^XLFDT()
  1. S AGGDATAI(FILE,DA_",",.07)=DUZ
  1. Q
  1. ;
  1. NEWR ;
  1. NEW DIC,DLAYGO,Y,X
  1. S DIC="^AUPNRHI("
  1. S DIC(0)="L"
  1. S DLAYGO=9000039
  1. S X=DFN
  1. D ^DIC
  1. I Y=-1 K DO,DD D FILE^DICN
  1. S DA=+Y
  1. Q
  1. ;
  1. RHI ; EP
  1. I $G(AGGPTRSI)="" Q
  1. NEW FLD,DA,STAT
  1. S DA=$O(^AUPNRHI("B",DFN,""))
  1. I DA="" D NEWR
  1. S DA=$O(^AUPNRHI("B",DFN,""))
  1. S STAT=AGGPTRSI
  1. S AGGDATA(9000039,DA_",",.03)=AGGPTRSI
  1. S FLD=$S(STAT="P":.11,STAT="A":.21,STAT="R":.41,STAT="N":.31,1:"")
  1. I $G(AGGRHIDT)="",FLD'="" S AGGDATAI(9000039,DA_",",FLD)=$$DT^XLFDT()
  1. I $G(AGGRHIDT)'="",FLD'="" S AGGDATAI(9000039,DA_",",FLD)=AGGRHIDT
  1. S FLD=$S(STAT="A":.22,STAT="R":.42,STAT="N":.32,1:"")
  1. I $G(AGGRHIO)'="",FLD'="" S AGGDATA(9000039,DA_",",FLD)=AGGRHIO
  1. I $G(AGGRHTXT)'="" S AGGDATA(9000039,DA_",",.02)=AGGRHTXT
  1. S FLD=$S(STAT="P":.12,STAT="A":.23,STAT="R":.43,STAT="N":.33,STAT="E":.51,1:"")
  1. I FLD'="" S AGGDATAI(9000039,DA_",",FLD)=DUZ
  1. S FLD=$S(STAT="E":.52,STAT="P":.13,STAT="A":.24,STAT="R":.44,STAT="N":.34,1:"")
  1. I FLD'="" S AGGDATAI(9000039,DA_",",FLD)=$$NOW^XLFDT()
  1. Q
  1. ;
  1. MRECU(DFN,AGGPTMRS) ; EP
  1. I $G(AGGPTMRS)="" Q
  1. I $G(DFN)="" Q
  1. I $G(^AUPNPAT(DFN,41,DUZ(2),0))="" Q
  1. NEW DA,IENS
  1. S DA(1)=DFN,DA=DUZ(2),IENS=$$IENS^DILF(.DA)
  1. S AGGDATAI(9000001.41,IENS,.04)=$G(AGGPTMRS)
  1. Q