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