APCDGAPI ;IHS/CMI/LAB - PATIENT GOALS APIs;05-Dec-2011 14:28;DU
;;2.0;IHS PCC SUITE;**7,10,11**;MAY 14, 2009;Build 58
;
;
;
ADDGOAL(APCDPT,GDAT,RETVAL) ;PEP -- add Patient Goal
;This API is called to add a new entry to the PATIENT GOALS file
;Input:
; - APCDPT = Patient DFN
; - DAT = array of field data in the format DAT(field#,counter)=value
; note the counter will always be 1 except for field 1000 which is
; a multiple valued field so the counter will be 1,2 etc.
; Details:
; DAT(".01",1)=this is the goal set status, .01 field value
; (".06",1)=facility where goal was added, optional, if not passed DUZ(2) is used
; (".07",1)=goal number, must be a number 99.999 and must not already be used. Use
; "AA" xref to determine allowable goal numbers for this facility:
; ^AUPNGOAL("AA",1090,5217," 001.00",3)=""
; ^AUPNGOAL("AA",1090,5217," 002.00",11)=""
; (".08",1)=provider documenting, managing this goal, if not passed, DUZ is used
; (".09",1)=goal start date, required, date only
; (".1",1)=goal followup date, required, date only
; (".12",1)=user last update, if not passed, DUZ will be used
; ("1000",1)=goal type from file PATIENT GOAL TYPES - at least 1 is required, this is a multiple field
; ("1000",2)=goal type 2, etc
; ("1101",1)=goal name, required, free text 2-120 characters
; ("1201",1)=reason for goal, free text 2-120 characters, optional
; note: field .11 is always stuffed with A (Active) on an add so no need to pass in that field value
; note: field .02 is always stuffed with the value of APCDPT
; note: fields .03 and .05 are stuffed with DT and $$NOW
; note: fields .04 and .12 area stuffed with DUZ
;
; - RETVAL = string that returns value of call success/failure
;
;RETURN VALUE - RETVAL=ien of patient goal entry created OR 0^error message
;
;
NEW APCDF,APCDC,APCDFDA,APCDIENS,APCDCNTR,APCDTY,APCDLOC,APCDE,APCDI,APCDLOC,APCDERR,APCDGDAT,APCDSTD,APCDGIEN,APCDEC
NEW X,Y,%DT,Z,DIC,DIE,DR,DIK
S RETVAL=""
E02 ;
I '$G(APCDPT) S RETVAL="0^patient pointer (DFN) invalid" Q
I '$D(^AUPNPAT(APCDPT)) S RETVAL="0^patient pointer (DFN) invalid" Q
REQ ;these field values are required to create an entry
F APCDF=".07",".09",".01",".1","1000","1101" I $G(GDAT(APCDF,1))="" S RETVAL="0^"_APCDF_" field value missing, required to create a GOAL"
I RETVAL]"" Q
S APCDIENS="+1,"
;check all incoming data values and set fda array for call to Update^DIE
E01 ;.01 VALUE
S APCDI=""
K APCDE
S X=GDAT(.01,1) I $L(X)=1 S X=$$EXTERNAL^DILFD(9000093,.01,"",$G(GDAT(".01",1)))
D VAL^DIE(9000093,APCDIENS,.01,"EF",X,.APCDI,"APCDFDA","APCDE") I $D(APCDE("DIERR",1,"TEXT",1)) D E(APCDE("DIERR",1,"TEXT",1)) Q
E06 ;
S X=$G(GDAT(.06,1))
I X="" S X=DUZ(2)
I X?1.N S X=$$EXTERNAL^DILFD(9000093,".06","",X)
D VAL^DIE(9000093,APCDIENS,.06,"EF",X,.APCDI,"APCDFDA","APCDE")
S APCDLOC=APCDI
I $D(APCDE("DIERR",1,"TEXT",1)) D E(APCDE("DIERR",1,"TEXT",1)) Q
E07 ;
S X=$G(GDAT(.07,1))
I +X'=X!(X>999.99)!(X<1)!(X?.E1"."3N.N) S RETVAL="0^Goal number invalid, must be a number between 1-999.99" Q
S Y=" "_$E("000",1,4-$L($P(X,".",1))-1)_$P(X,".",1)_"."_$P(X,".",2)_$E("00",1,3-$L($P(X,".",2))-1)
I $D(^AUPNGOAL("AA",APCDPT,APCDLOC,Y)) S RETVAL="0^Goal number already in use - .07 value invalid" Q
S APCDFDA(9000093,APCDIENS,.07)=X
E08 ;
S X=$G(GDAT(".08",1))
I X="" S X=DUZ
I X?1.N S X=$$EXTERNAL^DILFD(9000093,".08","",X)
D VAL^DIE(9000093,APCDIENS,.08,"EF",X,.APCDI,"APCDFDA","APCDE")
I $D(APCDE("DIERR",1,"TEXT",1)) D E(APCDE("DIERR",1,"TEXT",1)) Q
E09 ;
S X=$G(GDAT(".09",1))
S %DT=""
D ^%DT
I Y=-1 S RETVAL="0^Goal start date invalid" Q
S APCDFDA(9000093,APCDIENS,.09)=Y
S APCDSTD=Y
E10 ;
S X=$G(GDAT(".1",1))
S %DT=""
D ^%DT
I Y=-1 S RETVAL="0^Goal start date invalid" Q
I Y<APCDSTD S RETVAL="0^Follow up date cannot be prior to start date" Q
S APCDFDA(9000093,APCDIENS,.1)=Y
E1000 ;
;now check goal type
S C=0,APCDC=0 F S C=$O(GDAT(1000,C)) Q:C'=+C D
.S Z=GDAT(1000,C)
.I Z?1.N,'$D(^APCDTPGT(Z)) D E("invalid patient goal type") Q
.I Z'?1.N S X=Z,DIC="^APCDTPGT(",DIC(0)="" D ^DIC D Q:Y=-1
..I Y=-1 D E("invalid patient goal type") Q
;if RETVAL then quit with the error
I RETVAL]"" Q
E1101 ;
S X=$G(GDAT("1101",1))
D VAL^DIE(9000093,APCDIENS,1101,"EF",X,.APCDI,"APCDFDA","APCDE")
I $D(APCDE("DIERR",1,"TEXT",1)) D E(APCDE("DIERR",1,"TEXT",1)) Q
E1201 ;
S X=$G(GDAT("1201",1))
D VAL^DIE(9000093,APCDIENS,1201,"EF",X,.APCDI,"APCDFDA","APCDE")
I $D(APCDE("DIERR",1,"TEXT",1)) D E(APCDE("DIERR",1,"TEXT",1)) Q
E03 ;set other data values into the FDA array
S APCDFDA(9000093,APCDIENS,.02)=APCDPT
S APCDFDA(9000093,APCDIENS,.03)=DT
S APCDFDA(9000093,APCDIENS,.04)=DUZ
S APCDFDA(9000093,APCDIENS,.05)=$$NOW^XLFDT
S APCDFDA(9000093,APCDIENS,.11)="A"
S APCDFDA(9000093,APCDIENS,.12)=DUZ
ADD1 D UPDATE^DIE("","APCDFDA","APCDIENS","APCDERR(1)")
I $D(APCDERR(1)) S RETVAL="0^error adding entry to Patient Goals file "_APCDERR(1) Q
S APCDGIEN=+$G(APCDIENS(1))
K APCDFDA
;set in multiple goal type
S APCDI="",APCDC=0
F S APCDC=$O(GDAT(1000,APCDC)) Q:APCDC'=+APCDC D
.S DIE="^AUPNGOAL(",DA=APCDGIEN,DR="1000////"_GDAT(1000,APCDC) D ^DIE K DIE,DA,DR
.I $D(Y) S RETVAL="0^error adding goal type" S DA=APCDGIEN,DIK="^AUPNGOAL(" D ^DIK Q
I RETVAL]"" Q
S RETVAL=APCDGIEN
Q
;
DELGOAL(APCDGIEN,APCDGPRV,APCDGDTD,APCDGREA,APCDGOTH,RETVAL) ;PEP - called to delete a goal
;marks the goal status as "deleted", does not physically delete the goal
;INPUT - goal ien
;APCDGREA - REASON FOR DELETION, SET OF CODES, FIELD 2.03 -
;APCDGPRV - PROVIDER DELETING GOAL, IF NOT PASSED USES DUZ FIELD 2.01 PASS IEN PLEASE
;APCDGOTH - COMMENT IF OTHER IS REASON FIELD 2.04
;APCDGDTD - DATE/TIME DELETED 2.02 - USES $$NOW^XLFDT IF NOTHING PASSED, PASS INTERNAL VALUE PLEASE
;OUTPUT - return value is 1 if delete successful or 0^error message if not successful
I '$G(APCDGIEN) S RETVAL="0^invalid ien" Q
I '$D(^AUPNGOAL(APCDGIEN)) S RETVAL="0^invalid ien, not entry" Q
S APCDGPRV=$G(APCDGPRV) I 'APCDGPRV S APCDGPRV=DUZ
S APCDGDTD=$G(APCDGDTD) I 'APCDGDTD S APCDGDTD=$$NOW^XLFDT()
S APCDGREA=$G(APCDGREA)
S APCDGOTH=$G(APCDGOTH)
NEW DIE,DA,DR,X,Y,DIC
S DA=APCDGIEN,DR=".11///D;2.01////"_APCDGPRV_";2.02////"_APCDGDTD_";2.03///"_APCDGREA_";2.04///"_APCDGOTH,DIE="^AUPNGOAL(" D ^DIE K DIE,DA,DR
I $D(Y) S RETVAL="0^error updating status field, goal not deleted" Q
S RETVAL=1
Q
EDITGOAL(APCDGIEN,APCDFUD,APCDSTAT,APCDREVD,APCDREVT,RETVAL) ;PEP- edit a goal entry
;only the following fields can be edited per requirements: F/U DATE (.09), STATUS (.11)
;you can also add a review date and review/follow up text, to edit a review comment use EDITREV API
;INPUT : ien of goal, new followup date, new status, review date (optional), review comment (optional)
; if adding a review both review date and comment are required, if both are not passed they
; are ignored
;OUTPUT : 1 if edit successful, 0^error message if not successful
;
I '$G(APCDGIEN) S RETVAL="0^invalid ien" Q
I '$D(^AUPNGOAL(APCDGIEN)) S RETVAL="0^invalid ien, not entry" Q
S APCDFUD=$G(APCDFUD)
S APCDSTAT=$G(APCDSTAT)
S APCDREVD=$G(APCDREVD)
S APCDREVT=$G(APCDREVT)
;edit incoming values
NEW DIE,DA,DR,X,Y,%DT,APCDFU,APCDI,APCDRD,APCDIENS,APCDFDA,APCDERR,DIC
S X=$G(APCDFUD)
I X="" G E1
S %DT=""
D ^%DT
I Y=-1 S RETVAL="0^Goal followup date invalid" Q
S APCDFU=Y
S X=$P(^AUPNGOAL(APCDGIEN,0),U,9) I X>APCDFU S RETVAL="0^goal followup date cannot be less than start date" Q
E1 ;
S X=$G(APCDSTAT),APCDI=""
D CHK^DIE(9000093,.11,"",X,.APCDI)
I APCDI="^" S RETVAL="0^invalid status value" Q
;if adding a review/fu edit those field values
I APCDREVD=""!(APCDREVT="") G ED
S X=$G(APCDREVD)
S %DT=""
D ^%DT
I Y=-1 S RETVAL="0^review date invalid" Q
S APCDRD=Y
S Y=""
D CHK^DIE(9000093.13,.02,"",APCDREVT,.Y)
I Y="^" S RETVAL="0^invalid review note" Q
ED ;
S DA=APCDGIEN,DR=".1////"_APCDFU_";.11///"_APCDI_";.05////"_$$NOW^XLFDT()_";.12////"_DUZ,DIE="^AUPNGOAL(" D ^DIE K DIE,DA,DR
I $D(Y) S RETVAL="0^error updating status field, goal not deleted" Q
I APCDREVT]"",APCDREVD]"" D
.;add review to multiple
.S APCDIENS=""
.S APCDFDA(9000093.13,"+2,"_APCDGIEN_",",.01)=APCDRD
.S APCDFDA(9000093.13,"+2,"_APCDGIEN_",",.02)=APCDREVT
.D UPDATE^DIE("","APCDFDA","APCDIENS","APCDERR(1)")
.I $D(APCDERR(1)) S RETVAL=APCDERR("DIERR",1,"TEXT",1)
I RETVAL]"" Q
S RETVAL=1
Q
;
NEXTGN(P,F) ;PEP - return next available goal number for patient P, facility F
I $G(P)="" Q ""
I $G(F)="" Q ""
I '$D(^AUPNPAT(P)) Q ""
I '$D(^AUTTLOC(F)) Q ""
Q $E($O(^AUPNGOAL("AA",P,F,""),-1),2,999)\1+1
;
E(V) ;
S APCDEC=$G(APCDEC)+1,$P(RETVAL,"|",APCDEC)=V
Q
APCDGAPI ;IHS/CMI/LAB - PATIENT GOALS APIs;05-Dec-2011 14:28;DU
+1 ;;2.0;IHS PCC SUITE;**7,10,11**;MAY 14, 2009;Build 58
+2 ;
+3 ;
+4 ;
ADDGOAL(APCDPT,GDAT,RETVAL) ;PEP -- add Patient Goal
+1 ;This API is called to add a new entry to the PATIENT GOALS file
+2 ;Input:
+3 ; - APCDPT = Patient DFN
+4 ; - DAT = array of field data in the format DAT(field#,counter)=value
+5 ; note the counter will always be 1 except for field 1000 which is
+6 ; a multiple valued field so the counter will be 1,2 etc.
+7 ; Details:
+8 ; DAT(".01",1)=this is the goal set status, .01 field value
+9 ; (".06",1)=facility where goal was added, optional, if not passed DUZ(2) is used
+10 ; (".07",1)=goal number, must be a number 99.999 and must not already be used. Use
+11 ; "AA" xref to determine allowable goal numbers for this facility:
+12 ; ^AUPNGOAL("AA",1090,5217," 001.00",3)=""
+13 ; ^AUPNGOAL("AA",1090,5217," 002.00",11)=""
+14 ; (".08",1)=provider documenting, managing this goal, if not passed, DUZ is used
+15 ; (".09",1)=goal start date, required, date only
+16 ; (".1",1)=goal followup date, required, date only
+17 ; (".12",1)=user last update, if not passed, DUZ will be used
+18 ; ("1000",1)=goal type from file PATIENT GOAL TYPES - at least 1 is required, this is a multiple field
+19 ; ("1000",2)=goal type 2, etc
+20 ; ("1101",1)=goal name, required, free text 2-120 characters
+21 ; ("1201",1)=reason for goal, free text 2-120 characters, optional
+22 ; note: field .11 is always stuffed with A (Active) on an add so no need to pass in that field value
+23 ; note: field .02 is always stuffed with the value of APCDPT
+24 ; note: fields .03 and .05 are stuffed with DT and $$NOW
+25 ; note: fields .04 and .12 area stuffed with DUZ
+26 ;
+27 ; - RETVAL = string that returns value of call success/failure
+28 ;
+29 ;RETURN VALUE - RETVAL=ien of patient goal entry created OR 0^error message
+30 ;
+31 ;
+32 NEW APCDF,APCDC,APCDFDA,APCDIENS,APCDCNTR,APCDTY,APCDLOC,APCDE,APCDI,APCDLOC,APCDERR,APCDGDAT,APCDSTD,APCDGIEN,APCDEC
+33 NEW X,Y,%DT,Z,DIC,DIE,DR,DIK
+34 SET RETVAL=""
E02 ;
+1 IF '$GET(APCDPT)
SET RETVAL="0^patient pointer (DFN) invalid"
QUIT
+2 IF '$DATA(^AUPNPAT(APCDPT))
SET RETVAL="0^patient pointer (DFN) invalid"
QUIT
REQ ;these field values are required to create an entry
+1 FOR APCDF=".07",".09",".01",".1","1000","1101"
IF $GET(GDAT(APCDF,1))=""
SET RETVAL="0^"_APCDF_" field value missing, required to create a GOAL"
+2 IF RETVAL]""
QUIT
+3 SET APCDIENS="+1,"
+4 ;check all incoming data values and set fda array for call to Update^DIE
E01 ;.01 VALUE
+1 SET APCDI=""
+2 KILL APCDE
+3 SET X=GDAT(.01,1)
IF $LENGTH(X)=1
SET X=$$EXTERNAL^DILFD(9000093,.01,"",$GET(GDAT(".01",1)))
+4 DO VAL^DIE(9000093,APCDIENS,.01,"EF",X,.APCDI,"APCDFDA","APCDE")
IF $DATA(APCDE("DIERR",1,"TEXT",1))
DO E(APCDE("DIERR",1,"TEXT",1))
QUIT
E06 ;
+1 SET X=$GET(GDAT(.06,1))
+2 IF X=""
SET X=DUZ(2)
+3 IF X?1.N
SET X=$$EXTERNAL^DILFD(9000093,".06","",X)
+4 DO VAL^DIE(9000093,APCDIENS,.06,"EF",X,.APCDI,"APCDFDA","APCDE")
+5 SET APCDLOC=APCDI
+6 IF $DATA(APCDE("DIERR",1,"TEXT",1))
DO E(APCDE("DIERR",1,"TEXT",1))
QUIT
E07 ;
+1 SET X=$GET(GDAT(.07,1))
+2 IF +X'=X!(X>999.99)!(X<1)!(X?.E1"."3N.N)
SET RETVAL="0^Goal number invalid, must be a number between 1-999.99"
QUIT
+3 SET Y=" "_$EXTRACT("000",1,4-$LENGTH($PIECE(X,".",1))-1)_$PIECE(X,".",1)_"."_$PIECE(X,".",2)_$EXTRACT("00",1,3-$LENGTH($PIECE(X,".",2))-1)
+4 IF $DATA(^AUPNGOAL("AA",APCDPT,APCDLOC,Y))
SET RETVAL="0^Goal number already in use - .07 value invalid"
QUIT
+5 SET APCDFDA(9000093,APCDIENS,.07)=X
E08 ;
+1 SET X=$GET(GDAT(".08",1))
+2 IF X=""
SET X=DUZ
+3 IF X?1.N
SET X=$$EXTERNAL^DILFD(9000093,".08","",X)
+4 DO VAL^DIE(9000093,APCDIENS,.08,"EF",X,.APCDI,"APCDFDA","APCDE")
+5 IF $DATA(APCDE("DIERR",1,"TEXT",1))
DO E(APCDE("DIERR",1,"TEXT",1))
QUIT
E09 ;
+1 SET X=$GET(GDAT(".09",1))
+2 SET %DT=""
+3 DO ^%DT
+4 IF Y=-1
SET RETVAL="0^Goal start date invalid"
QUIT
+5 SET APCDFDA(9000093,APCDIENS,.09)=Y
+6 SET APCDSTD=Y
E10 ;
+1 SET X=$GET(GDAT(".1",1))
+2 SET %DT=""
+3 DO ^%DT
+4 IF Y=-1
SET RETVAL="0^Goal start date invalid"
QUIT
+5 IF Y<APCDSTD
SET RETVAL="0^Follow up date cannot be prior to start date"
QUIT
+6 SET APCDFDA(9000093,APCDIENS,.1)=Y
E1000 ;
+1 ;now check goal type
+2 SET C=0
SET APCDC=0
FOR
SET C=$ORDER(GDAT(1000,C))
IF C'=+C
QUIT
Begin DoDot:1
+3 SET Z=GDAT(1000,C)
+4 IF Z?1.N
IF '$DATA(^APCDTPGT(Z))
DO E("invalid patient goal type")
QUIT
+5 IF Z'?1.N
SET X=Z
SET DIC="^APCDTPGT("
SET DIC(0)=""
DO ^DIC
Begin DoDot:2
+6 IF Y=-1
DO E("invalid patient goal type")
QUIT
End DoDot:2
IF Y=-1
QUIT
End DoDot:1
+7 ;if RETVAL then quit with the error
+8 IF RETVAL]""
QUIT
E1101 ;
+1 SET X=$GET(GDAT("1101",1))
+2 DO VAL^DIE(9000093,APCDIENS,1101,"EF",X,.APCDI,"APCDFDA","APCDE")
+3 IF $DATA(APCDE("DIERR",1,"TEXT",1))
DO E(APCDE("DIERR",1,"TEXT",1))
QUIT
E1201 ;
+1 SET X=$GET(GDAT("1201",1))
+2 DO VAL^DIE(9000093,APCDIENS,1201,"EF",X,.APCDI,"APCDFDA","APCDE")
+3 IF $DATA(APCDE("DIERR",1,"TEXT",1))
DO E(APCDE("DIERR",1,"TEXT",1))
QUIT
E03 ;set other data values into the FDA array
+1 SET APCDFDA(9000093,APCDIENS,.02)=APCDPT
+2 SET APCDFDA(9000093,APCDIENS,.03)=DT
+3 SET APCDFDA(9000093,APCDIENS,.04)=DUZ
+4 SET APCDFDA(9000093,APCDIENS,.05)=$$NOW^XLFDT
+5 SET APCDFDA(9000093,APCDIENS,.11)="A"
+6 SET APCDFDA(9000093,APCDIENS,.12)=DUZ
ADD1 DO UPDATE^DIE("","APCDFDA","APCDIENS","APCDERR(1)")
+1 IF $DATA(APCDERR(1))
SET RETVAL="0^error adding entry to Patient Goals file "_APCDERR(1)
QUIT
+2 SET APCDGIEN=+$GET(APCDIENS(1))
+3 KILL APCDFDA
+4 ;set in multiple goal type
+5 SET APCDI=""
SET APCDC=0
+6 FOR
SET APCDC=$ORDER(GDAT(1000,APCDC))
IF APCDC'=+APCDC
QUIT
Begin DoDot:1
+7 SET DIE="^AUPNGOAL("
SET DA=APCDGIEN
SET DR="1000////"_GDAT(1000,APCDC)
DO ^DIE
KILL DIE,DA,DR
+8 IF $DATA(Y)
SET RETVAL="0^error adding goal type"
SET DA=APCDGIEN
SET DIK="^AUPNGOAL("
DO ^DIK
QUIT
End DoDot:1
+9 IF RETVAL]""
QUIT
+10 SET RETVAL=APCDGIEN
+11 QUIT
+12 ;
DELGOAL(APCDGIEN,APCDGPRV,APCDGDTD,APCDGREA,APCDGOTH,RETVAL) ;PEP - called to delete a goal
+1 ;marks the goal status as "deleted", does not physically delete the goal
+2 ;INPUT - goal ien
+3 ;APCDGREA - REASON FOR DELETION, SET OF CODES, FIELD 2.03 -
+4 ;APCDGPRV - PROVIDER DELETING GOAL, IF NOT PASSED USES DUZ FIELD 2.01 PASS IEN PLEASE
+5 ;APCDGOTH - COMMENT IF OTHER IS REASON FIELD 2.04
+6 ;APCDGDTD - DATE/TIME DELETED 2.02 - USES $$NOW^XLFDT IF NOTHING PASSED, PASS INTERNAL VALUE PLEASE
+7 ;OUTPUT - return value is 1 if delete successful or 0^error message if not successful
+8 IF '$GET(APCDGIEN)
SET RETVAL="0^invalid ien"
QUIT
+9 IF '$DATA(^AUPNGOAL(APCDGIEN))
SET RETVAL="0^invalid ien, not entry"
QUIT
+10 SET APCDGPRV=$GET(APCDGPRV)
IF 'APCDGPRV
SET APCDGPRV=DUZ
+11 SET APCDGDTD=$GET(APCDGDTD)
IF 'APCDGDTD
SET APCDGDTD=$$NOW^XLFDT()
+12 SET APCDGREA=$GET(APCDGREA)
+13 SET APCDGOTH=$GET(APCDGOTH)
+14 NEW DIE,DA,DR,X,Y,DIC
+15 SET DA=APCDGIEN
SET DR=".11///D;2.01////"_APCDGPRV_";2.02////"_APCDGDTD_";2.03///"_APCDGREA_";2.04///"_APCDGOTH
SET DIE="^AUPNGOAL("
DO ^DIE
KILL DIE,DA,DR
+16 IF $DATA(Y)
SET RETVAL="0^error updating status field, goal not deleted"
QUIT
+17 SET RETVAL=1
+18 QUIT
EDITGOAL(APCDGIEN,APCDFUD,APCDSTAT,APCDREVD,APCDREVT,RETVAL) ;PEP- edit a goal entry
+1 ;only the following fields can be edited per requirements: F/U DATE (.09), STATUS (.11)
+2 ;you can also add a review date and review/follow up text, to edit a review comment use EDITREV API
+3 ;INPUT : ien of goal, new followup date, new status, review date (optional), review comment (optional)
+4 ; if adding a review both review date and comment are required, if both are not passed they
+5 ; are ignored
+6 ;OUTPUT : 1 if edit successful, 0^error message if not successful
+7 ;
+8 IF '$GET(APCDGIEN)
SET RETVAL="0^invalid ien"
QUIT
+9 IF '$DATA(^AUPNGOAL(APCDGIEN))
SET RETVAL="0^invalid ien, not entry"
QUIT
+10 SET APCDFUD=$GET(APCDFUD)
+11 SET APCDSTAT=$GET(APCDSTAT)
+12 SET APCDREVD=$GET(APCDREVD)
+13 SET APCDREVT=$GET(APCDREVT)
+14 ;edit incoming values
+15 NEW DIE,DA,DR,X,Y,%DT,APCDFU,APCDI,APCDRD,APCDIENS,APCDFDA,APCDERR,DIC
+16 SET X=$GET(APCDFUD)
+17 IF X=""
GOTO E1
+18 SET %DT=""
+19 DO ^%DT
+20 IF Y=-1
SET RETVAL="0^Goal followup date invalid"
QUIT
+21 SET APCDFU=Y
+22 SET X=$PIECE(^AUPNGOAL(APCDGIEN,0),U,9)
IF X>APCDFU
SET RETVAL="0^goal followup date cannot be less than start date"
QUIT
E1 ;
+1 SET X=$GET(APCDSTAT)
SET APCDI=""
+2 DO CHK^DIE(9000093,.11,"",X,.APCDI)
+3 IF APCDI="^"
SET RETVAL="0^invalid status value"
QUIT
+4 ;if adding a review/fu edit those field values
+5 IF APCDREVD=""!(APCDREVT="")
GOTO ED
+6 SET X=$GET(APCDREVD)
+7 SET %DT=""
+8 DO ^%DT
+9 IF Y=-1
SET RETVAL="0^review date invalid"
QUIT
+10 SET APCDRD=Y
+11 SET Y=""
+12 DO CHK^DIE(9000093.13,.02,"",APCDREVT,.Y)
+13 IF Y="^"
SET RETVAL="0^invalid review note"
QUIT
ED ;
+1 SET DA=APCDGIEN
SET DR=".1////"_APCDFU_";.11///"_APCDI_";.05////"_$$NOW^XLFDT()_";.12////"_DUZ
SET DIE="^AUPNGOAL("
DO ^DIE
KILL DIE,DA,DR
+2 IF $DATA(Y)
SET RETVAL="0^error updating status field, goal not deleted"
QUIT
+3 IF APCDREVT]""
IF APCDREVD]""
Begin DoDot:1
+4 ;add review to multiple
+5 SET APCDIENS=""
+6 SET APCDFDA(9000093.13,"+2,"_APCDGIEN_",",.01)=APCDRD
+7 SET APCDFDA(9000093.13,"+2,"_APCDGIEN_",",.02)=APCDREVT
+8 DO UPDATE^DIE("","APCDFDA","APCDIENS","APCDERR(1)")
+9 IF $DATA(APCDERR(1))
SET RETVAL=APCDERR("DIERR",1,"TEXT",1)
End DoDot:1
+10 IF RETVAL]""
QUIT
+11 SET RETVAL=1
+12 QUIT
+13 ;
NEXTGN(P,F) ;PEP - return next available goal number for patient P, facility F
+1 IF $GET(P)=""
QUIT ""
+2 IF $GET(F)=""
QUIT ""
+3 IF '$DATA(^AUPNPAT(P))
QUIT ""
+4 IF '$DATA(^AUTTLOC(F))
QUIT ""
+5 QUIT $EXTRACT($ORDER(^AUPNGOAL("AA",P,F,""),-1),2,999)\1+1
+6 ;
E(V) ;
+1 SET APCDEC=$GET(APCDEC)+1
SET $PIECE(RETVAL,"|",APCDEC)=V
+2 QUIT
