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

APCDFHA.m

Go to the documentation of this file. 
  1. APCDFHA ;cmi/flag/maw - APCD Family History API 12/9/2009 11:30:27 AM
  1.  ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
  1.  ;
  1.  ;
  1.  ;
  1. FH(APCDIE,APCDPT,APCDFIEN,APCDRIEN,APCDFDAT,APCDRDAT,RETVAL) ;-- add/edit family history
  1.  ;APCDIE = "I" all values are internal, "E" all values are external
  1.  ;APCDPT = Patient DFN
  1.  ;APCDFIEN - IEN of entry in family history file to edit, null if adding
  1.  ;APCDRIEN = IEN of entry in family history member to file in .09
  1.  ;APCDRDAT = array of field data in the format RDAT(field#)=value
  1.  ;APCDFDAT = array of field data in the format FDAT(field#)=value
  1.  ;RETVAL = string that returns value of call success/failure
  1.  S APCDC=0
  1.  D EDTR(APCDIE,APCDPT,APCDRIEN,.APCDRDAT,.RETVAL)
  1.  I '+$G(RETVAL) Q
  1.  D EDTF(APCDIE,APCDPT,APCDFIEN,APCDRIEN,1,.APCDFDAT,.RETVAL)
  1.  Q
  1.  ;
  1. EDTR(IE,PT,RIEN,RDAT,RETVAL) ;-- update entry in the family history member file
  1.  ;IE = "I" all values are internal, "E" all values are external
  1.  ;PT = Patient DFN
  1.  ;RIEN = IEN of entry in family history member file to edit, null if adding
  1.  ;RDAT = array of field data in the format RDAT(field#)=value
  1.  I '$G(RIEN) D ADDR(.APCDRIEN,IE,PT,.RDAT)
  1.  I $G(RIEN) S APCDRIEN=RIEN
  1.  I '$G(APCDRIEN) S RETVAL="0^error adding entry to FAMILY HISTORY FAMILY MEMBERS file" Q
  1.  I IE="E" D VAL(9000014.1,.RDAT,APCDRIEN)
  1.  I '$G(RDAT(.09)) S RDAT(.09)=DT
  1.  D FILE(9000014.1,.RDAT,APCDRIEN)
  1.  Q
  1.  ;
  1. EDTF(IE,PT,FIEN,RIEN,COMB,FDAT,RETVAL) ;-- update entry in the family history file
  1.  ;IE = "I" all values are internal, "E" all values are external
  1.  ;PT = Patient DFN
  1.  ;FIEN - IEN of entry in family history file to edit, null if adding
  1.  ;RIEN = IEN of entry in family history member to file in .09
  1.  ;COMB = flag indicating this is called from FH tag above
  1.  ;FDAT = array of field data in the format FDAT(field#)=value
  1.  I $G(RIEN)="",'$G(COMB) S RETVAL="0^cannot add entry, add entry to FAMILY HISTORY FAMILY MEMBERS file first" Q
  1.  I '$G(FIEN) D ADDF(.APCDFIEN,IE,PT,.FDAT)
  1.  I $G(FIEN) S APCDFIEN=FIEN
  1.  I '$G(APCDFIEN) S RETVAL="0^error adding entry to FAMILY HISTORY file" Q
  1.  I $G(RIEN),'$G(FDAT(.09)) S FDAT(.09)=RIEN
  1.  S FDAT(.04)=$$FNDNARR(FDAT(.04))  ;file the provider narrative
  1.  I IE="E" D VAL(9000014,.FDAT,APCDFIEN)
  1.  I '$G(FDAT(.03)) S FDAT(.03)=DT
  1.  D FILE(9000014,.FDAT,APCDFIEN)
  1.  Q
  1.  ;
  1. ADDR(APCDRIEN,IE,P,FDAT) ;-- add a person to the Family History Member file
  1.  N FDA,FIENS,FERR,REL
  1.  S FIENS=""
  1.  I $G(IE)="E" S REL=$O(^AUTTRLSH("B",RDAT(.01),0))
  1.  I $G(IE)="I" S REL=$G(RDAT(.01))
  1.  I '$G(REL) S RETVAL="0^invalid relationship passed in" Q
  1.  S FDA(9000014.1,"+1,",.01)=REL
  1.  S FDA(9000014.1,"+1,",.02)=P
  1.  D UPDATE^DIE("","FDA","FIENS","FERR(1)")
  1.  I '$D(FERR(1)) S APCDRIEN=+$G(FIENS(1)) Q
  1.  S RETVAL="0^error adding entry to FAMILY HISTORY FAMILY MEMBERS file"
  1.  Q
  1.  ;
  1. ADDF(APCDFIEN,IE,P,FDAT) ;-- add a person to the Family History Member file
  1.  N FDA,FIENS,FERR,DX,DXI
  1.  S FIENS=""
  1.  I $G(IE)="E" D CHK^DIE(9000014,.01,"E",FDAT(.01),.DXI,"APCDERR(0)")
  1.  I $G(IE)="I" S DXI=$G(FDAT(.01))
  1.  I '+$G(DXI) S RETVAL="0^invalid DX passed in" Q
  1.  S FDA(9000014,"+1,",.01)=DXI
  1.  S FDA(9000014,"+1,",.02)=P
  1.  D UPDATE^DIE("","FDA","FIENS","FERR(1)")
  1.  I '$D(FERR(1)) S APCDFIEN=+$G(FIENS(1)) Q
  1.  S RETVAL="0^error adding entry to FAMILY HISTORY file"
  1.  Q
  1.  ;
  1. DELFM(VAL,RETVAL) ;-- delete the family member
  1.  ;VAL=ien of entry in FAMILY HISTORY MEMBER file to delete
  1.  I $O(^AUPNFH("AE",VAL,0)) S RETVAL="0^Cannot delete because entry is being pointed to by FAMILY HISTORY file IEN "_$O(^AUPNFH("AE",VAL,0)) Q
  1.  S DIK="^AUPNFHR(",DA=VAL D ^DIK
  1.  S RETVAL=VAL_"^entry deleted successfully"
  1.  Q
  1.  ;
  1. DELFH(VAL,RETVAL) ;-- delete family history
  1.  ;VAL=ien of entry in FAMILY HISTORY file to delete
  1.  ;N FM
  1.  ;S FM=$P($G(^AUPNFH(VAL,0)),U,9)
  1.  ;I $G(FM),$D(^AUPNFHR(FM,0)) S RETVAL="0^Cannot delete because entry has a pointer to FAMILY HISTORY FAMILY MEMBERS file" Q
  1.  S DIK="^AUPNFH(",DA=VAL D ^DIK
  1.  S RETVAL=VAL_"^entry deleted successfully"
  1.  Q
  1.  ;
  1. FNDNARR(NARR) ;EP -- find the provider narrative based on input
  1.  S APCDOVRR=1
  1.  S X=NARR
  1.  S DIC="^AUTNPOV(",DIC(0)="L",DLAYGO=9999999.27 D ^DIC
  1.  K DLAYGO
  1.  Q $S($G(Y)>0:+Y,1:"")
  1.  ;
  1. FILE(FL,APCDDATA,APCDIN) ;-- file the data
  1.  S APCDIENS=APCDIN_","
  1.  K APCDFDA
  1.  S APCDF="" F  S APCDF=$O(APCDDATA(APCDF)) Q:APCDF=""  D
  1.  .S APCDFDA(FL,APCDIENS,APCDF)=APCDDATA(APCDF)
  1.  ;CALL FILE^DIE
  1.  K APCDE
  1.  D FILE^DIE("K","APCDFDA","APCDE(0)")
  1.  S APCDI=0 F  S APCDI=$O(APCDE(0,"DIERR",APCDI)) Q:APCDI'=+APCDI  D
  1.  .Q:'$D(APCDE(0,"DIERR",APCDI,"TEXT"))
  1.  .D E(APCDE(0,"DIERR",APCDI,"TEXT"))
  1.  S RETVAL=APCDIN_"^"_$G(RETVAL)
  1.  Q
  1.  ;
  1. VAL(FL,DAT,DIENS) ;-- validate data passed in
  1.  S DIENS=DIENS_","
  1.  S APCDF="" F  S APCDF=$O(DAT(APCDF)) Q:APCDF=""  D
  1.  .I APCDF=".02" Q  ;you can't edit the .01, it's dinum'ed
  1.  .I FL=9000014,APCDF=.04 Q  ;don't validate provider narrative, its done separately
  1.  .I FL=9000014,APCDF=.09 Q  ;don't validate pointer to family member file
  1.  .I '$D(^DD(FL,APCDF,0)) K DAT(APCDF) D E("field number not valid") Q
  1.  .S APCDV=DAT(APCDF)
  1.  .Q:APCDV=""
  1.  .K APCDE,APCDI
  1.  .S APCDI=""
  1.  .D VAL^DIE(FL,DIENS,APCDF,"E",APCDV,.APCDI,,"APCDE")
  1.  .I $D(APCDE("DIERR",1,"TEXT",1)) D E(APCDE("DIERR",1,"TEXT",1)) K DAT(APCDF) Q
  1.  .S DAT(APCDF)=APCDI
  1.  Q
  1.  ;
  1. E(V) ;
  1.  S APCDC=APCDC+1,$P(RETVAL,"|",APCDC)=V
  1.  Q
  1.  ;
  1. TESTALL ;
  1.  S P=478
  1.  S AREL(.01)=28
  1.  S AREL(.02)=P
  1.  S AREL(.03)="SECOND COUSIN"
  1.  S AREL(.04)="L"
  1.  S AREL(.07)="N"
  1.  S AREL(.09)="3091208"
  1.  S AREL(.11)="3091209"
  1.  S AF(.01)="11377"
  1.  S AF(.02)=P
  1.  S AF(.03)="3091209"
  1.  S AF(.04)="TEST NARRATIVE"
  1.  S AF(.08)="240"
  1.  S AF(.11)=5
  1.  S AF(.12)="3091212"
  1.  D FH("I",P,177,166,.AF,.AREL,.LORIERR)
  1.  ;ZW LORIERR
  1.  Q
  1.  ;
  1. TESTFH ;
  1.  S P=478
  1.  S AF(.01)="11377"
  1.  S AF(.02)=P
  1.  S AF(.03)="3091209"
  1.  S AF(.04)="TEST NARRATIVE"
  1.  S AF(.08)="240"
  1.  S AF(.11)=5
  1.  S AF(.12)="3091213"
  1.  D EDTF("I",P,177,166,,.AF,.LORIERR)
  1.  ;ZW LORIERR
  1.  Q
  1.  ;
  1. TESTFM ;
  1.  S P=478
  1.  S AREL(.01)=28
  1.  S AREL(.02)=P
  1.  S AREL(.03)="SECOND COUSIN"
  1.  S AREL(.04)="L"
  1.  S AREL(.07)="N"
  1.  S AREL(.09)="3091207"
  1.  S AREL(.11)="3091207"
  1.  D EDTR("I",P,166,.AREL,.LORIERR)
  1.  ;ZW LORIERR
  1.  Q
  1.  ;