APCDGAP2.m

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