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

AGGPTADD.m

Go to the documentation of this file. 
  1. AGGPTADD ;VNGT/HS/ALA-Add new patient ; 19 Apr 2010  12:30 PM
  1.  ;;1.0;PATIENT REGISTRATION GUI;**1**;Nov 15, 2010
  1.  ;
  1.  ;
  1. ADD(DATA,DEF,DFN,PARMS) ; EP - AGG ADD NEW PATIENT
  1.  ; Input
  1.  ;   DEF   = Mini Registration or New Patient
  1.  ;   DFN   = if patient already created, null if new
  1.  ;   PARMS = Parameters
  1.  ; 
  1.  NEW UID,II,AGIEN,PDATA,FILE,LIST,NARRAY,BQ,NAME,VALUE,PFIEN,PTYP,CHIEN,AGI,AGJ,AGWP,PTNAME
  1.  NEW AGGPTLNM,AGGPTFNM,AGGPTMNM,AGGPTSFX,AGGPTSSN,AGGNOSSN,AGGPTHRN,AGGPTDOB,AGGPTSEX,AGGPTMAR
  1.  NEW EXEC,FIELD,TXT,FLAG,WDATA,FILE,SECFILE,AGGPTCOM,AGGPTCDT,ERROR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGPTADD",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 FLAG=0 I $G(DFN)="" S FLAG=1
  1.  S @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010DFN"_$C(30)
  1.  S AGIEN=$$FIND1^DIC(9009068.3,"","BX",DEF,"","","ERROR")
  1.  I AGIEN=0 D  Q
  1.  . S II=II+1,@DATA@(II)="-1^RPC Failed: Passed in window name "_DEF_" not found^"_$C(30)
  1.  . S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1.  S FILE=$P(^AGG(9009068.3,AGIEN,0),U,2),SECFILE=$P(^AGG(9009068.3,AGIEN,0),U,14)
  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.  K NARRAY
  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.  . S PFIEN=$O(^AGG(9009068.3,AGIEN,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,AGIEN,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,AGIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
  1.  .. S VALUE=$P(^AGG(9009068.3,AGIEN,10,PFIEN,5,CHIEN,0),U,2)
  1.  . I PTYP="W" K AGGWP 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.  . S @NAME=VALUE
  1.  . I NAME="AGGPTLNM" S NARRAY("FAMILY")=@NAME
  1.  . I NAME="AGGPTFNM" S NARRAY("GIVEN")=@NAME
  1.  . I NAME="AGGPTMNM" S NARRAY("MIDDLE")=@NAME
  1.  . I NAME="AGGPTSFX" S NARRAY("SUFFIX")=@NAME
  1.  ;
  1.  F TXT="FAMILY","GIVEN","MIDDLE","SUFFIX" I $G(NARRAY(TXT))="" S NARRAY(TXT)=""
  1.  S PTNAME=$$F^XLFNAME1(.NARRAY,"C")
  1.  ;
  1.  I $G(DFN)="" D
  1.  . NEW DIC,DLAYGO,DIADD,X,NWONE
  1.  . S X=PTNAME,DIC="^AUPNPAT(",DIC(0)="MLQ"
  1.  . D ^DIC
  1.  . S DFN=+Y,NWONE=$P(Y,U,3) I NWONE Q
  1.  . K AUPNPAT,AUPNDOB,AUPNDAYS,AUPNDOD,AUPNSEX
  1.  . S DIC="^DPT("
  1.  . K DO,DD D FILE^DICN
  1.  . S DFN=+Y,NWONE=$P(Y,U,3)
  1.  . I NWONE S ^AUPNPAT(DFN,0)=DFN,^AUPNPAT("B",DFN,DFN)=""
  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,AGIEN,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,AGIEN,10,PFIEN,3)),U,1),SECFLD=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,7)
  1.  . S EXEC=$G(^AGG(9009068.3,AGIEN,10,PFIEN,7))
  1.  . I EXEC'="" X EXEC Q
  1.  . I FIELD="",SECFLD="" Q
  1.  . S PTYP=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,1)),U,1)
  1.  . I PTYP="C"!(PTYP="K")!(PTYP="T") D  Q
  1.  .. I FIELD'="" S AGGDATAI(FILE,DFN_",",FIELD)=@NAME Q
  1.  .. I SECFLD'="" S AGGDATAI(SECFILE,DFN_",",SECFLD)=@NAME
  1.  . I FIELD'="" S AGGDATA(FILE,DFN_",",FIELD)=@NAME Q
  1.  . I SECFLD'="" S AGGDATA(SECFILE,DFN_",",SECFLD)=@NAME
  1.  ;
  1.  I $D(AGGWP) D
  1.  . NEW FL,FD,IENS,WFLAG
  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 WFLAG="" I FL=9000001,FD=1301 S WFLAG="A"
  1.  .... I $D(WDATA) D WP^DIE(FL,IENS,FD,WFLAG,WDATA,"ERROR")
  1.  ;
  1.  I $G(AGGPTSSN)'="" S AGGDATAI(9000001,DFN_",",.23)=$O(^AUTTSSN("B","P",""))
  1.  I $D(AGGDATA) D FILE^DIE("","AGGDATA","ERROR")
  1.  I $D(AGGDATAI) D FILE^DIE("I","AGGDATAI","ERROR")
  1.  K AGGDATA,AGGDATAI
  1.  ;
  1.  ; Set the HRN
  1.  I '$D(ERROR) D
  1.  . NEW DIE,DR,DA
  1.  . I $G(AGGPTHRN)="" Q
  1.  . S DIE="^AUPNPAT(",DA=DFN
  1.  . S DR="4101///"_"`"_DUZ(2)
  1.  . S DR(2,9000001.41)=".02///"_AGGPTHRN
  1.  . D ^DIE
  1.  ;
  1.  ; Set the Previous community history
  1.  I $G(AGGPTCDT)'="" D COMM(DFN,AGGPTCDT,AGGPTCOM)
  1.  ;
  1.  K AGGWP,AGWP
  1.  S RESULT=1_U
  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_U_DFN
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  ;
  1.  ; Set last date updated and updated by
  1.  I $P(RESULT,U,1)=1 D
  1.  . S AGGDATAI(9000001,DFN_",",.03)=DT,AGGDATAI(9000001,DFN_",",.12)=DUZ
  1.  . D FILE^DIE("I","AGGDATAI","ERROR")
  1.  . I FLAG D
  1.  .. D ADD^AGGEXPRT(DFN)
  1.  .. S ^AGPATCH($$NOW^XLFDT(),DUZ(2),DFN)="NEW",$P(^AUPNPAT(DFN,0),U,11)=DUZ
  1.  . I 'FLAG D EDIT^AGGEXPRT(DFN)
  1.  ;
  1.  S NAME=""
  1.  F  S NAME=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME)) Q:NAME=""  K @NAME
  1.  K ERROR
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. NAME(AGGPTLNM,AGGPTFNM,AGGPTMNM,AGGPTSFX) ;EP
  1.  S NARRAY("FAMILY")=$G(AGGPTLNM)
  1.  S NARRAY("GIVEN")=$G(AGGPTFNM)
  1.  S NARRAY("MIDDLE")=$G(AGGPTMNM)
  1.  S NARRAY("SUFFIX")=$G(AGGPTSFX)
  1.  S NAME=$$F^XLFNAME1(.NARRAY,"C")
  1.  Q NAME
  1.  ;
  1. COMM(DFN,AGGPTCDT,AGGPTCOM) ;
  1.  NEW DIC,DA
  1.  I AGGPTCDT'?.N S AGGPTCDT=$$DATE^AGGUL1(AGGPTCDT)
  1.  S DIC("P")=9000001.51,DIC="^AUPNPAT("_DFN_",51,",DIC(0)="QML",(DINUM,X)=AGGPTCDT
  1.  S DA(1)=DFN,DIC("DR")=".02////"_DT_";.03////"_AGGPTCOM K DD,DO D FILE^DICN
  1.  Q