APCDGAP2 ;IHS/CMI/LAB - PATIENT GOALS APIs;11-Nov-2011 11:31;DU
;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
;
;
;
;
ADDREV(APCDGIEN,APCDREVD,APCDREVT,RETVAL) ;PEP - ADD A REVIEW TO A GOAL 9000093.13
;INPUT: ien of goal,review date,review text,return value
;OUTPUT: ien of review entry in multiple or 0^error text
;
I '$G(APCDGIEN) S RETVAL="0^invalid ien" Q
I '$D(^AUPNGOAL(APCDGIEN)) S RETVAL="0^invalid ien, not entry" Q
S APCDREVD=$G(APCDREVD)
S APCDREVT=$G(APCDREVT)
I APCDREVD="" S RETVAL="0^invalid review date" Q
I APCDREVT="" S RETVAL="0^review text null" Q
;edit incoming values
NEW DIE,DA,DR,X,Y,%DT,APCDFU,APCDI,APCDRD,APCDIENS,APCDFDA,APCDERR
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
;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)
S RETVAL=APCDIENS(2)
Q
;
ADDSTEP(APCDGIEN,SDAT,SRETVAL) ;PEP - add a step to a goal
;Add a Step to an existing goal
; SDAT - array of steps to be added if adding steps
; SDAT(n)=facility^step number^step type^step start date^step f/u date^provider^step text
; one entry in array for each step being added
; step number is optional, if not passed the next available step number will be used
; values can be internal or external
; user created / user last update fields auto stuffed with DUZ
; date created / date last updated fields auto stuffed with DT and NOW^XLFDT
;
; Example:
; SDAT(1)="5217^1^NUTRITION^3101029^3101231^1239^EAT LESS THAN 1200 CAAPCDTESTES PER DAY
; SDAT(2)="5217^2^PHYSICAL ACTIVITY^3101029^3101231^1239^WALK 60 MINUTES PER DAY
NEW APCDF,APCDC,APCDSTEX,APCDSIEN,APCDIENS,APCDLOC,APCDE,APCDI,APCDERR,APCDGDAT,APCDSTD,APCDSNUM,APCDSTT,APCDSD,APCDFUD,APCDPROV,APCDNIEN
NEW X,Y,DIC,DA
K SRETVAL
S APCDC=0 F S APCDC=$O(SDAT(APCDC)) Q:APCDC'=+APCDC D
.S SRETVAL(APCDC)=""
SREQ .;Required fields
.F APCDF=1,3:1:7 I $P(SDAT(APCDC),U,1)="" S SRETVAL(APCDC)="0^"_APCDF_" field value missing, required to create a STEP"
.;check all incoming data values and convert all to internal values
.;check facility
.S X=$P(SDAT(APCDC),U,1)
.I X="" S X=DUZ(2)
.I X'?1.N S X=$O(^DIC(4,"B",X,0))
.I X="" S SRETVAL(APCDC)="0^Facility value invalid" Q
.S APCDLOC=X
.;
.S X=$P(SDAT(APCDC),U,2) I X]"" I +X'=X!(X>9999)!(X<1) S SRETVAL(APCDC)="0^Step number invalid, must be a number between 1-9999" Q
.I X="" S X=$$NEXTSN(APCDGIEN,APCDLOC)
.S APCDSNUM=X
.S Y=$O(^AUPNGOAL(APCDGIEN,21,"B",APCDLOC,0))
.I Y,$D(^AUPNGOAL(APCDGIEN,21,Y,11,"B",APCDSNUM)) S SRETVAL(APCDC)="0^Step number already in use" Q
.;check step type
.S Y=$P(SDAT(APCDC),U,3) I Y?1.N,'$D(^APCDTPGT(Y)) D E("invalid patient goal type") Q
.I Y'?1.N S X=Y,DIC="^APCDTPGT(",DIC(0)="" D ^DIC D Q:Y=-1
..I Y=-1 D E("invalid patient goal type") Q
.S APCDSTT=+Y
.;start date
.S X=$P(SDAT(APCDC),U,4)
.S %DT=""
.D ^%DT
.I Y=-1 S SRETVAL(APCDC)="0^start date invalid" Q
.S APCDSD=Y
.;follow up date
.S X=$P(SDAT(APCDC),U,5)
.S %DT=""
.D ^%DT
.I Y=-1 S SRETVAL(APCDC)="0^Goal start date invalid" Q
.I Y<APCDSD S RETVAL="0^Follow up date cannot be prior to start date" Q
.S APCDFUD=Y
.;provider
.S X=$P(SDAT(APCDC),U,6)
.I X=""!(X?1.N) S (APCDPROV,X)=DUZ
.S Y=""
.I X'?1.N D CHK^DIE(9000093.211101,.1,"",X,.Y)
.I Y="^" S SRETVAL(APCDC)="0^Provider value invalid" Q
.I '$G(APCDPROV) S APCDPROV=Y
.;step text
.S X=$P(SDAT(APCDC),U,7)
.D CHK^DIE(9000093.211101,1101,"",X,.Y)
.I Y="^" S RETVAL="0^provider" Q
.S APCDSTEX=Y
.S APCDNIEN=$O(^AUPNGOAL(APCDGIEN,21,"B",APCDLOC,0))
.I APCDNIEN="" S X="`"_APCDLOC,DIC="^AUPNGOAL("_APCDGIEN_",21,",DA(1)=APCDGIEN,DIC(0)="L",DIC("P")=$P(^DD(9000093,2100,0),U,2) D ^DIC K DIC,DA,DR,Y,X S APCDNIEN=$O(^AUPNGOAL(APCDGIEN,21,"B",APCDLOC,0))
.I APCDNIEN="" S SRETVAL(APCDC)="0^ERROR UPDATING STEP LOCATION MULTIPLE" Q
.K DIC
.S X=APCDSNUM,DA(1)=APCDNIEN,DA(2)=APCDGIEN,DIC="^AUPNGOAL("_APCDGIEN_",21,"_APCDNIEN_",11,",DIC("P")=$P(^DD(9000093.21,1101,0),U,2),DIC(0)="L"
.D ^DIC K DA,DR
.I Y=-1 S SRETVAL(APCDC)="0^ERROR when updating step number multiple" Q
.S DIE=DIC K DIC S (APCDSIEN,DA)=+Y
.S DR=".02////^S X=DUZ;.03////^S X=DT;.07////^S X=DUZ;.08////^S X=$$NOW^XLFDT;.04////"_APCDSTT_";.05////"_APCDSD_";.06////"_APCDFUD_";.09////A;.1////^S X=APCDPROV;1101////"_APCDSTEX
.D ^DIE
.I $D(Y) S SRETVAL(APCDC)="0^error updating multiple for step entry" K DIE,DA,DR,Y Q
.S SRETVAL(APCDC)=APCDSIEN
Q
DELSTEP(APCDGIEN,APCDLIEN,APCDSIEN,APCDSPRV,APCDSDTD,APCDSREA,APCDSOTH,RET) ;PEP - DELETE A STEP
;delete a step
; INP = Problem IEN,Location IEN,Note IEN
; OUTPUT = 1 if delete successful or 0^error message
NEW DA
S RET=""
I '$G(APCDGIEN) S RET="0^invalid goal ien" Q
I '$D(^AUPNGOAL(APCDGIEN,0)) S RET="0^invalid goal ien" Q
I '$G(APCDLIEN) S RET="0^invalid location ien" Q
I '$G(APCDSIEN) S RET="0^invalid note ien" Q
S APCDLIEN=$O(^AUPNGOAL(APCDGIEN,21,"B",APCDLIEN,0))
I 'APCDLIEN S RET="0^could not find location entry in multiple" Q
I '$D(^AUPNGOAL(APCDGIEN,21,APCDLIEN,11,APCDSIEN)) S RET="0^invalid step ien, does not exist" Q
S APCDSPRV=$G(APCDSPRV) I 'APCDSPRV S APCDSPRV=DUZ
S APCDSDTD=$G(APCDSDTD) I 'APCDSDTD S APCDSDTD=$$NOW^XLFDT()
S APCDSREA=$G(APCDSREA)
S APCDSOTH=$G(APCDSOTH)
S DA=APCDSIEN
S DA(1)=APCDLIEN
S DA(2)=APCDGIEN
S DIE="^AUPNGOAL("_APCDGIEN_",21,"_APCDLIEN_",11,",DIC("P")=$P(^DD(9000093.21,1101,0),U,2)
S DR=".09////D;2.01////"_APCDSPRV_";2.02////"_APCDSDTD_";2.03///"_APCDSREA_";2.04///"_APCDSOTH D ^DIE K DIE,DR,DA,Y
I $D(Y) S RETVAL="0^error updating step status" Q
S RET=1
Q
EDITSTEP(GIEN,LIEN,SIEN,APCDFUD,APCDSTAT,RET) ;PEP - edit a step entry
;edit a step entry
;per requirements only the followup date and status can be edited
;INPUT: goal ien, location ien, note ien, new f/u date, status
;OUTPUT: 1 if edit successful, 0^error message if not successful
I '$G(GIEN) S RETVAL="0^invalid ien" Q
I '$D(^AUPNGOAL(GIEN)) S RETVAL="0^invalid ien, not entry" Q
S APCDFUD=$G(APCDFUD)
S APCDSTAT=$G(APCDSTAT)
I '$G(LIEN) S RET="0^invalid location ien" Q
I '$G(SIEN) S RET="0^invalid note ien" Q
S LIEN=$O(^AUPNGOAL(GIEN,21,"B",LIEN,0))
I 'LIEN S RET="0^could not find location entry in multiple" Q
I '$D(^AUPNGOAL(GIEN,21,LIEN,11,SIEN)) S RET="0^invalid note ien, does not exist" Q
;edit incoming values
NEW DIE,DA,DR,X,Y,%DT,APCDFU,APCDI,APCDRD,APCDIENS,APCDFDA,APCDERR
S X=$G(APCDFUD)
I X="" G S1
S %DT=""
D ^%DT
I Y=-1 S RETVAL="0^Goal followup date invalid" Q
S APCDFU=Y
S X=$P(^AUPNGOAL(GIEN,21,LIEN,11,SIEN,0),U,5) I X>APCDFU S RETVAL="0^STEP followup date cannot be less than start date" Q
S1 ;
S X=$G(APCDSTAT),APCDI=""
D CHK^DIE(9000093,.11,"",X,.APCDI)
I APCDI="^" S RETVAL="0^invalid status value" Q
S DA=SIEN
S DA(1)=LIEN
S DA(2)=GIEN
S DIE="^AUPNGOAL("_GIEN_",21,"_LIEN_",11,",DIC("P")=$P(^DD(9000093.21,1101,0),U,2)
S DR=".09////"_APCDSTAT_";.06////"_APCDFU_";.07////^S X=DUZ;.08////^S X=$$NOW^XLFDT" D ^DIE K DIE,DR,DA,Y
I $D(Y) S RET="0^error updating step status" Q
S RET=1
Q
NEXTSN(I,F) ;PEP - return next step number for this goal, facility
NEW X,Y,J
S J=$O(^AUPNGOAL(I,21,"B",F,0))
I 'J Q 1
S (Y,X)=0 F S Y=$O(^AUPNGOAL(I,21,J,11,"B",Y)) S:Y X=Y I 'Y S X=X+1 K Y Q
Q X
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 APCDC=APCDC+1,$P(RETVAL,"|",APCDC)=V
Q
APCDGAP2 ;IHS/CMI/LAB - PATIENT GOALS APIs;11-Nov-2011 11:31;DU
+1 ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
+2 ;
+3 ;
+4 ;
+5 ;
ADDREV(APCDGIEN,APCDREVD,APCDREVT,RETVAL) ;PEP - ADD A REVIEW TO A GOAL 9000093.13
+1 ;INPUT: ien of goal,review date,review text,return value
+2 ;OUTPUT: ien of review entry in multiple or 0^error text
+3 ;
+4 IF '$GET(APCDGIEN)
SET RETVAL="0^invalid ien"
QUIT
+5 IF '$DATA(^AUPNGOAL(APCDGIEN))
SET RETVAL="0^invalid ien, not entry"
QUIT
+6 SET APCDREVD=$GET(APCDREVD)
+7 SET APCDREVT=$GET(APCDREVT)
+8 IF APCDREVD=""
SET RETVAL="0^invalid review date"
QUIT
+9 IF APCDREVT=""
SET RETVAL="0^review text null"
QUIT
+10 ;edit incoming values
+11 NEW DIE,DA,DR,X,Y,%DT,APCDFU,APCDI,APCDRD,APCDIENS,APCDFDA,APCDERR
+12 SET X=$GET(APCDREVD)
+13 SET %DT=""
+14 DO ^%DT
+15 IF Y=-1
SET RETVAL="0^review date invalid"
QUIT
+16 SET APCDRD=Y
+17 SET Y=""
+18 DO CHK^DIE(9000093.13,.02,"",APCDREVT,.Y)
+19 IF Y="^"
SET RETVAL="0^invalid review note"
QUIT
+20 ;add review to multiple
+21 SET APCDIENS=""
+22 SET APCDFDA(9000093.13,"+2,"_APCDGIEN_",",.01)=APCDRD
+23 SET APCDFDA(9000093.13,"+2,"_APCDGIEN_",",.02)=APCDREVT
+24 DO UPDATE^DIE("","APCDFDA","APCDIENS","APCDERR(1)")
+25 IF $DATA(APCDERR(1))
SET RETVAL=APCDERR("DIERR",1,"TEXT",1)
+26 SET RETVAL=APCDIENS(2)
+27 QUIT
+28 ;
ADDSTEP(APCDGIEN,SDAT,SRETVAL) ;PEP - add a step to a goal
+1 ;Add a Step to an existing goal
+2 ; SDAT - array of steps to be added if adding steps
+3 ; SDAT(n)=facility^step number^step type^step start date^step f/u date^provider^step text
+4 ; one entry in array for each step being added
+5 ; step number is optional, if not passed the next available step number will be used
+6 ; values can be internal or external
+7 ; user created / user last update fields auto stuffed with DUZ
+8 ; date created / date last updated fields auto stuffed with DT and NOW^XLFDT
+9 ;
+10 ; Example:
+11 ; SDAT(1)="5217^1^NUTRITION^3101029^3101231^1239^EAT LESS THAN 1200 CAAPCDTESTES PER DAY
+12 ; SDAT(2)="5217^2^PHYSICAL ACTIVITY^3101029^3101231^1239^WALK 60 MINUTES PER DAY
+13 NEW APCDF,APCDC,APCDSTEX,APCDSIEN,APCDIENS,APCDLOC,APCDE,APCDI,APCDERR,APCDGDAT,APCDSTD,APCDSNUM,APCDSTT,APCDSD,APCDFUD,APCDPROV,APCDNIEN
+14 NEW X,Y,DIC,DA
+15 KILL SRETVAL
+16 SET APCDC=0
FOR
SET APCDC=$ORDER(SDAT(APCDC))
IF APCDC'=+APCDC
QUIT
Begin DoDot:1
+17 SET SRETVAL(APCDC)=""
SREQ ;Required fields
+1 FOR APCDF=1,3:1:7
IF $PIECE(SDAT(APCDC),U,1)=""
SET SRETVAL(APCDC)="0^"_APCDF_" field value missing, required to create a STEP"
+2 ;check all incoming data values and convert all to internal values
+3 ;check facility
+4 SET X=$PIECE(SDAT(APCDC),U,1)
+5 IF X=""
SET X=DUZ(2)
+6 IF X'?1.N
SET X=$ORDER(^DIC(4,"B",X,0))
+7 IF X=""
SET SRETVAL(APCDC)="0^Facility value invalid"
QUIT
+8 SET APCDLOC=X
+9 ;
+10 SET X=$PIECE(SDAT(APCDC),U,2)
IF X]""
IF +X'=X!(X>9999)!(X<1)
SET SRETVAL(APCDC)="0^Step number invalid, must be a number between 1-9999"
QUIT
+11 IF X=""
SET X=$$NEXTSN(APCDGIEN,APCDLOC)
+12 SET APCDSNUM=X
+13 SET Y=$ORDER(^AUPNGOAL(APCDGIEN,21,"B",APCDLOC,0))
+14 IF Y
IF $DATA(^AUPNGOAL(APCDGIEN,21,Y,11,"B",APCDSNUM))
SET SRETVAL(APCDC)="0^Step number already in use"
QUIT
+15 ;check step type
+16 SET Y=$PIECE(SDAT(APCDC),U,3)
IF Y?1.N
IF '$DATA(^APCDTPGT(Y))
DO E("invalid patient goal type")
QUIT
+17 IF Y'?1.N
SET X=Y
SET DIC="^APCDTPGT("
SET DIC(0)=""
DO ^DIC
Begin DoDot:2
+18 IF Y=-1
DO E("invalid patient goal type")
QUIT
End DoDot:2
IF Y=-1
QUIT
+19 SET APCDSTT=+Y
+20 ;start date
+21 SET X=$PIECE(SDAT(APCDC),U,4)
+22 SET %DT=""
+23 DO ^%DT
+24 IF Y=-1
SET SRETVAL(APCDC)="0^start date invalid"
QUIT
+25 SET APCDSD=Y
+26 ;follow up date
+27 SET X=$PIECE(SDAT(APCDC),U,5)
+28 SET %DT=""
+29 DO ^%DT
+30 IF Y=-1
SET SRETVAL(APCDC)="0^Goal start date invalid"
QUIT
+31 IF Y<APCDSD
SET RETVAL="0^Follow up date cannot be prior to start date"
QUIT
+32 SET APCDFUD=Y
+33 ;provider
+34 SET X=$PIECE(SDAT(APCDC),U,6)
+35 IF X=""!(X?1.N)
SET (APCDPROV,X)=DUZ
+36 SET Y=""
+37 IF X'?1.N
DO CHK^DIE(9000093.211101,.1,"",X,.Y)
+38 IF Y="^"
SET SRETVAL(APCDC)="0^Provider value invalid"
QUIT
+39 IF '$GET(APCDPROV)
SET APCDPROV=Y
+40 ;step text
+41 SET X=$PIECE(SDAT(APCDC),U,7)
+42 DO CHK^DIE(9000093.211101,1101,"",X,.Y)
+43 IF Y="^"
SET RETVAL="0^provider"
QUIT
+44 SET APCDSTEX=Y
+45 SET APCDNIEN=$ORDER(^AUPNGOAL(APCDGIEN,21,"B",APCDLOC,0))
+46 IF APCDNIEN=""
SET X="`"_APCDLOC
SET DIC="^AUPNGOAL("_APCDGIEN_",21,"
SET DA(1)=APCDGIEN
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(9000093,2100,0),U,2)
DO ^DIC
KILL DIC,DA,DR,Y,X
SET APCDNIEN=$ORDER(^AUPNGOAL(APCDGIEN,21,"B",APCDLOC,0))
+47 IF APCDNIEN=""
SET SRETVAL(APCDC)="0^ERROR UPDATING STEP LOCATION MULTIPLE"
QUIT
+48 KILL DIC
+49 SET X=APCDSNUM
SET DA(1)=APCDNIEN
SET DA(2)=APCDGIEN
SET DIC="^AUPNGOAL("_APCDGIEN_",21,"_APCDNIEN_",11,"
SET DIC("P")=$PIECE(^DD(9000093.21,1101,0),U,2)
SET DIC(0)="L"
+50 DO ^DIC
KILL DA,DR
+51 IF Y=-1
SET SRETVAL(APCDC)="0^ERROR when updating step number multiple"
QUIT
+52 SET DIE=DIC
KILL DIC
SET (APCDSIEN,DA)=+Y
+53 SET DR=".02////^S X=DUZ;.03////^S X=DT;.07////^S X=DUZ;.08////^S X=$$NOW^XLFDT;.04////"_APCDSTT_";.05////"_APCDSD_";.06////"_APCDFUD_";.09////A;.1////^S X=APCDPROV;1101////"_APCDSTEX
+54 DO ^DIE
+55 IF $DATA(Y)
SET SRETVAL(APCDC)="0^error updating multiple for step entry"
KILL DIE,DA,DR,Y
QUIT
+56 SET SRETVAL(APCDC)=APCDSIEN
End DoDot:1
+57 QUIT
DELSTEP(APCDGIEN,APCDLIEN,APCDSIEN,APCDSPRV,APCDSDTD,APCDSREA,APCDSOTH,RET) ;PEP - DELETE A STEP
+1 ;delete a step
+2 ; INP = Problem IEN,Location IEN,Note IEN
+3 ; OUTPUT = 1 if delete successful or 0^error message
+4 NEW DA
+5 SET RET=""
+6 IF '$GET(APCDGIEN)
SET RET="0^invalid goal ien"
QUIT
+7 IF '$DATA(^AUPNGOAL(APCDGIEN,0))
SET RET="0^invalid goal ien"
QUIT
+8 IF '$GET(APCDLIEN)
SET RET="0^invalid location ien"
QUIT
+9 IF '$GET(APCDSIEN)
SET RET="0^invalid note ien"
QUIT
+10 SET APCDLIEN=$ORDER(^AUPNGOAL(APCDGIEN,21,"B",APCDLIEN,0))
+11 IF 'APCDLIEN
SET RET="0^could not find location entry in multiple"
QUIT
+12 IF '$DATA(^AUPNGOAL(APCDGIEN,21,APCDLIEN,11,APCDSIEN))
SET RET="0^invalid step ien, does not exist"
QUIT
+13 SET APCDSPRV=$GET(APCDSPRV)
IF 'APCDSPRV
SET APCDSPRV=DUZ
+14 SET APCDSDTD=$GET(APCDSDTD)
IF 'APCDSDTD
SET APCDSDTD=$$NOW^XLFDT()
+15 SET APCDSREA=$GET(APCDSREA)
+16 SET APCDSOTH=$GET(APCDSOTH)
+17 SET DA=APCDSIEN
+18 SET DA(1)=APCDLIEN
+19 SET DA(2)=APCDGIEN
+20 SET DIE="^AUPNGOAL("_APCDGIEN_",21,"_APCDLIEN_",11,"
SET DIC("P")=$PIECE(^DD(9000093.21,1101,0),U,2)
+21 SET DR=".09////D;2.01////"_APCDSPRV_";2.02////"_APCDSDTD_";2.03///"_APCDSREA_";2.04///"_APCDSOTH
DO ^DIE
KILL DIE,DR,DA,Y
+22 IF $DATA(Y)
SET RETVAL="0^error updating step status"
QUIT
+23 SET RET=1
+24 QUIT
EDITSTEP(GIEN,LIEN,SIEN,APCDFUD,APCDSTAT,RET) ;PEP - edit a step entry
+1 ;edit a step entry
+2 ;per requirements only the followup date and status can be edited
+3 ;INPUT: goal ien, location ien, note ien, new f/u date, status
+4 ;OUTPUT: 1 if edit successful, 0^error message if not successful
+5 IF '$GET(GIEN)
SET RETVAL="0^invalid ien"
QUIT
+6 IF '$DATA(^AUPNGOAL(GIEN))
SET RETVAL="0^invalid ien, not entry"
QUIT
+7 SET APCDFUD=$GET(APCDFUD)
+8 SET APCDSTAT=$GET(APCDSTAT)
+9 IF '$GET(LIEN)
SET RET="0^invalid location ien"
QUIT
+10 IF '$GET(SIEN)
SET RET="0^invalid note ien"
QUIT
+11 SET LIEN=$ORDER(^AUPNGOAL(GIEN,21,"B",LIEN,0))
+12 IF 'LIEN
SET RET="0^could not find location entry in multiple"
QUIT
+13 IF '$DATA(^AUPNGOAL(GIEN,21,LIEN,11,SIEN))
SET RET="0^invalid note ien, does not exist"
QUIT
+14 ;edit incoming values
+15 NEW DIE,DA,DR,X,Y,%DT,APCDFU,APCDI,APCDRD,APCDIENS,APCDFDA,APCDERR
+16 SET X=$GET(APCDFUD)
+17 IF X=""
GOTO S1
+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(GIEN,21,LIEN,11,SIEN,0),U,5)
IF X>APCDFU
SET RETVAL="0^STEP followup date cannot be less than start date"
QUIT
S1 ;
+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 SET DA=SIEN
+5 SET DA(1)=LIEN
+6 SET DA(2)=GIEN
+7 SET DIE="^AUPNGOAL("_GIEN_",21,"_LIEN_",11,"
SET DIC("P")=$PIECE(^DD(9000093.21,1101,0),U,2)
+8 SET DR=".09////"_APCDSTAT_";.06////"_APCDFU_";.07////^S X=DUZ;.08////^S X=$$NOW^XLFDT"
DO ^DIE
KILL DIE,DR,DA,Y
+9 IF $DATA(Y)
SET RET="0^error updating step status"
QUIT
+10 SET RET=1
+11 QUIT
NEXTSN(I,F) ;PEP - return next step number for this goal, facility
+1 NEW X,Y,J
+2 SET J=$ORDER(^AUPNGOAL(I,21,"B",F,0))
+3 IF 'J
QUIT 1
+4 SET (Y,X)=0
FOR
SET Y=$ORDER(^AUPNGOAL(I,21,J,11,"B",Y))
IF Y
SET X=Y
IF 'Y
SET X=X+1
KILL Y
QUIT
+5 QUIT X
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 APCDC=APCDC+1
SET $PIECE(RETVAL,"|",APCDC)=V
+2 QUIT
