APCDPG2 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
;
NO1 ;EP
W:$D(IOF) @IOF
NEW APCDSD,APCDFUD
I $P(^AUPNGOAL(APCDPIEN,0),U,1)="N" W !!,"You cannot add a step to a goal that was Not Set.",!! G NOX
W !!,"Adding a Step to the following GOAL on ",$P($P(^DPT(DFN,0),U),",",2)," ",$P($P(^(0),U),","),"'s GOAL List.",!
D DISPGOAL
I $O(^AUPNGOAL(APCDPIEN,21,0)) D
.S APCDC=0
.W !," Steps: " S APCDL=0 F S APCDL=$O(^AUPNGOAL(APCDPIEN,21,APCDL)) Q:APCDL'=+APCDL I $O(^AUPNGOAL(APCDPIEN,21,APCDL,11,0)) W !?3,$P(^DIC(4,$P(^AUPNGOAL(APCDPIEN,21,APCDL,0),U),0),U) D
..S APCDX=0 F S APCDX=$O(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX)) Q:APCDX'=+APCDX D
...Q:$P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,9)="D"
...S APCDC=APCDC+1
...W !?5,"Step#",APCDC," ",$P($G(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,11)),U,1)
...W !?12,"Status: ",$$SS^APCDPG($P($G(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0)),U,9)),?39,"Start: ",$$DATE^APCDPG($P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,5))
...W ?56,"F/U: ",$$DATE^APCDPG($P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,6))
W ! S DIR(0)="Y",DIR("A")="Add a new Step for this Goal",DIR("B")="Y" K DA D ^DIR K DIR
G:$D(DIRUT) NOX
G:Y=0 NOX
NUM ;
;add location multiple if necessary, otherwise get ien in multiple
S APCDNIEN=$O(^AUPNGOAL(APCDPIEN,21,"B",APCDLOC,0))
I APCDNIEN="" S X="`"_APCDLOC,DIC="^AUPNGOAL("_APCDPIEN_",21,",DA(1)=APCDPIEN,DIC(0)="L",DIC("P")=$P(^DD(9000093,2100,0),U,2) D ^DIC K DIC,DA,DR,Y,X S APCDNIEN=$O(^AUPNGOAL(APCDPIEN,21,"B",APCDLOC,0))
I APCDNIEN="" W $C(7),$C(7),"ERROR UPDATING STEP LOCATION MULTIPLE" G NOX
S (Y,X)=0 F S Y=$O(^AUPNGOAL(APCDPIEN,21,APCDNIEN,11,"B",Y)) S:Y X=Y I 'Y S X=X+1 K Y Q
S APCDNUM=X
W !!,"Adding ",$P(^DIC(4,APCDLOC,0),U)," Step"
K DIC S X=APCDNUM,DA(1)=APCDNIEN,DA(2)=APCDPIEN,DIC="^AUPNGOAL("_APCDPIEN_",21,"_APCDNIEN_",11,",DIC("P")=$P(^DD(9000093.21,1101,0),U,2),DIC(0)="L" D ^DIC K DA,DR
I Y=-1 W !!,$C(7),$C(7),"ERROR when updating step number multiple",! G NOX
S DIE=DIC K DIC W ?10 S %=$S($G(APCDDATE):$P(APCDDATE,"."),1:DT),(APCDDA,DA)=+Y,DR=".02////^S X=DUZ;.03////^S X=%;.07////^S X=DUZ;.08////^S X=$$NOW^XLFDT;1101;.04" D ^DIE K DIE,DR,DA,Y
;GET START AND FOLLOWUP DATES
SSD S APCDSD=""
S DIR(0)="9000093,.09",DIR("A")="START DATE" KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !!,"value is required" G SSD
S APCDSD=Y
SFD S APCDFUD=""
S DIR(0)="9000093,.1",DIR("A")="FOLLOW UP DATE" KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !!,"value is required" G SFD
S APCDFUD=Y
I APCDFUD<APCDSD W !!,"followup date cannot be less than the start date" G SSD
S DIE="^AUPNGOAL("_APCDPIEN_",21,"_APCDNIEN_",11,",DIC("P")=$P(^DD(9000093.21,1101,0),U,2)
S DA=APCDDA,DR=".05////^S X=APCDSD;.06////^S X=APCDFUD;.09////A;.1"
D ^DIE
K DA,DR,DIE
G NO1
NOX ;
K Y,APCDPIEN,X,L,APCDNUM,APCDL,DIC,DA,DD,APCDC,APCDN,APCDNIEN,DR,DIADD
Q
RNO1 ;EP - called from APCDPG1 - remove a step
W:$D(IOF) @IOF
K APCDN,APCDL,APCDX,APCDC
I $P(^AUPNGOAL(APCDPIEN,0),U,1)="N" W !!,"You cannot REMOVE a step from a goal that was Not Set.",!! G RNO1X
W !!,"Removing a Step from the following GOAL on ",$P($P(^DPT(DFN,0),U),",",2)," ",$P($P(^(0),U),","),"'s GOAL List.",!
D DISPGOAL
S APCDC=0
I $O(^AUPNGOAL(APCDPIEN,21,0)) D
.W !," Steps: " S APCDL=0 F S APCDL=$O(^AUPNGOAL(APCDPIEN,21,APCDL)) Q:APCDL'=+APCDL I $O(^AUPNGOAL(APCDPIEN,21,APCDL,11,0)) W !?3,$P(^DIC(4,$P(^AUPNGOAL(APCDPIEN,21,APCDL,0),U),0),U) D
..S APCDX=0 F S APCDX=$O(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX)) Q:APCDX'=+APCDX D
...Q:$P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,9)="D"
...S APCDC=APCDC+1,APCDN(APCDC)=APCDL_U_APCDX
...W !?5,"Step#",APCDC," ",$P($G(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,11)),U,1)
...W !?12,"Status: ",$$SS^APCDPG($P($G(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0)),U,9)),?39,"Start: ",$$DATE^APCDPG($P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,5))
...W ?56,"F/U: ",$$DATE^APCDPG($P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,6))
I APCDC=0 W !?8,"No step on file for this GOAL" G RNO1X
W ! K DIR S DIR(0)="N^1:"_APCDC_":",DIR("A")="Remove which one" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"Okay, bye." G RNO1X
I 'Y W !,"No Step selected" G RNO1X
S APCDY=+Y
RSURE ;
W !! S DIR(0)="Y",DIR("A")="Are you sure you want to delete this STEP",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"okay, not deleted." G RNO1X
I 'Y W !,"Okay, not deleted." G RNO1X
S DA(1)=$P(APCDN(APCDY),U),DA(2)=APCDPIEN,DIE="^AUPNGOAL("_APCDPIEN_",21,"_$P(APCDN(APCDY),U)_",11,",DIC("P")=$P(^DD(9000093.21,1101,0),U,2)
S DA=$P(APCDN(APCDY),U,2),DR=".09///D;.07///^S X=DUZ;.08///^S X=$$NOW^XLFDT;2.01////^S X=DUZ;2.02////^S X=$$NOW^XLFDT;2.03",DIE("NO^")=1 D ^DIE K DIE,DR,DA,Y
I $P($G(^AUPNGOAL(APCDPIEN,21,$P(APCDN(APCDY),U),11,$P(APCDN(APCDY),U,2),2)),U,3)="O" D
.S DA(1)=$P(APCDN(APCDY),U),DA(2)=APCDPIEN,DIE="^AUPNGOAL("_APCDPIEN_",21,"_$P(APCDN(APCDY),U)_",11,",DIC("P")=$P(^DD(9000093.21,1101,0),U,2)
.S DA=$P(APCDN(APCDY),U,2),DR="2.04R",DIE("NO^")=1 D ^DIE K DIE,DR,DA,Y
W !!
RNO1X ;xit
K APCDPIEN,APCDL,APCDX,APCDN,APCDY
Q
MN1 ;EP - called to modify a step
W:$D(IOF) @IOF
K APCDN,APCDL,APCDX,APCDC
I $P(^AUPNGOAL(APCDPIEN,0),U,1)="N" W !!,"You cannot EDIT a step on a goal that was Not Set.",!! G NOX
W !!,"Editing a Step on the following GOAL on ",$P($P(^DPT(DFN,0),U),",",2)," ",$P($P(^(0),U),","),"'s GOAL List.",!
D DISPGOAL
S APCDC=0
I $O(^AUPNGOAL(APCDPIEN,21,0)) D
.W !," Steps: " S APCDL=0 F S APCDL=$O(^AUPNGOAL(APCDPIEN,21,APCDL)) Q:APCDL'=+APCDL I $O(^AUPNGOAL(APCDPIEN,21,APCDL,11,0)) W !?3,$P(^DIC(4,$P(^AUPNGOAL(APCDPIEN,21,APCDL,0),U),0),U) D
..S APCDX=0 F S APCDX=$O(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX)) Q:APCDX'=+APCDX D
...Q:$P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,9)="D"
...S APCDC=APCDC+1,APCDN(APCDC)=APCDL_U_APCDX
...W !?5,APCDC,") ","Step#",APCDC," ",$P($G(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,11)),U,1)
...W !?12,"Status: ",$$SS^APCDPG($P($G(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0)),U,9)),?39,"Start: ",$$DATE^APCDPG($P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,5))
...W ?56,"F/U: ",$$DATE^APCDPG($P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,6))
I APCDC=0 W !?8,"No step on file for this GOAL" G MNO1X
W ! K DIR S DIR(0)="N^1:"_APCDC_":",DIR("A")="Edit which one" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"Okay, bye." G MNO1X
I 'Y W !,"No Step selected" G MNO1X
S APCDY=+Y
MSURE ;
S DA(1)=$P(APCDN(APCDY),U),DA(2)=APCDPIEN,DIE="^AUPNGOAL("_APCDPIEN_",21,"_$P(APCDN(APCDY),U)_",11,",DIC("P")=$P(^DD(9000093.21,1101,0),U,2)
S DA=$P(APCDN(APCDY),U,2)
S DR=".07////^S X=DUZ;.08////^S X=$$NOW^XLFDT" D ^DIE K DIE,DR,DA,Y
S APCDSS=$P(^AUPNGOAL(APCDPIEN,21,$P(APCDN(APCDY),U),11,$P(APCDN(APCDY),U,2),0),U,9)
S DIR(0)="S^ME:STEP MET;MA:MAINTAINING STEP;S:STEP STOPPED",DIR("A")="STEP STATUS",DIR("B")=APCDSS KILL DA D ^DIR KILL DIR
I $D(DIRUT) G MNO1X
S APCDSS=Y
S DR=".09////"_APCDSS_$S(APCDSS="MA":";.06",1:"")
S DA(1)=$P(APCDN(APCDY),U),DA(2)=APCDPIEN,DIE="^AUPNGOAL("_APCDPIEN_",21,"_$P(APCDN(APCDY),U)_",11,",DIC("P")=$P(^DD(9000093.21,1101,0),U,2)
S DA=$P(APCDN(APCDY),U,2)
D ^DIE
K DIE,DR,DA
MNO1X ;
K APCDPIEN,APCDL,APCDX,APCDN,APCDY,APCDSS
Q
DISPGOAL ;
NEW APCDX,APCDP0,APCDF
S APCDP0=^AUPNGOAL(APCDPIEN,0)
S APCDF=$P(APCDP0,U,6)
S APCDX=""
S APCDX=$$SETSTR^VALM1("GOAL ID: ",APCDX,3,11)
S X=$S($P(^AUTTLOC(APCDF,0),U,7)]"":$J($P(^(0),U,7),4),1:"??")_$P(APCDP0,U,7),APCDX=$$SETSTR^VALM1(X,APCDX,13,10)
S APCDX=$$SETSTR^VALM1("Status: ",APCDX,24,8),X=$$VAL^XBDIQ1(9000093,APCDPIEN,.01)_$S($P(APCDP0,U,11)]"":" - "_$$VAL^XBDIQ1(9000093,APCDPIEN,.11),1:""),APCDX=$$SETSTR^VALM1(X,APCDX,33,26)
W !,APCDX
I $P(^AUPNGOAL(APCDPIEN,0),U,1)="S" S APCDX=" Goal Start Date: "_$$DATE^APCDPG($P(APCDP0,U,9))_" Goal Follow up Date: "_$$DATE^APCDPG($P(APCDP0,U,10))
I $P(^AUPNGOAL(APCDPIEN,0),U,1)="N" S APCDX=" Goal Created Date: "_$$DATE^APCDPG($P(APCDP0,U,3))
W !,APCDX
;goal name, reason
S APCDX=" Goal Name: "_$$VAL^XBDIQ1(9000093,APCDPIEN,1101)
W !?2,APCDX
S APCDX=" Goal Reason: "_$$VAL^XBDIQ1(9000093,APCDPIEN,1201)
W !?2,APCDX
Q
APCDPG2 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
+1 ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
+2 ;
NO1 ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 NEW APCDSD,APCDFUD
+3 IF $PIECE(^AUPNGOAL(APCDPIEN,0),U,1)="N"
WRITE !!,"You cannot add a step to a goal that was Not Set.",!!
GOTO NOX
+4 WRITE !!,"Adding a Step to the following GOAL on ",$PIECE($PIECE(^DPT(DFN,0),U),",",2)," ",$PIECE($PIECE(^(0),U),","),"'s GOAL List.",!
+5 DO DISPGOAL
+6 IF $ORDER(^AUPNGOAL(APCDPIEN,21,0))
Begin DoDot:1
+7 SET APCDC=0
+8 WRITE !," Steps: "
SET APCDL=0
FOR
SET APCDL=$ORDER(^AUPNGOAL(APCDPIEN,21,APCDL))
IF APCDL'=+APCDL
QUIT
IF $ORDER(^AUPNGOAL(APCDPIEN,21,APCDL,11,0))
WRITE !?3,$PIECE(^DIC(4,$PIECE(^AUPNGOAL(APCDPIEN,21,APCDL,0),U),0),U)
Begin DoDot:2
+9 SET APCDX=0
FOR
SET APCDX=$ORDER(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX))
IF APCDX'=+APCDX
QUIT
Begin DoDot:3
+10 IF $PIECE(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,9)="D"
QUIT
+11 SET APCDC=APCDC+1
+12 WRITE !?5,"Step#",APCDC," ",$PIECE($GET(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,11)),U,1)
+13 WRITE !?12,"Status: ",$$SS^APCDPG($PIECE($GET(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0)),U,9)),?39,"Start: ",$$DATE^APCDPG($PIECE(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,5))
+14 WRITE ?56,"F/U: ",$$DATE^APCDPG($PIECE(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,6))
End DoDot:3
End DoDot:2
End DoDot:1
+15 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Add a new Step for this Goal"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+16 IF $DATA(DIRUT)
GOTO NOX
+17 IF Y=0
GOTO NOX
NUM ;
+1 ;add location multiple if necessary, otherwise get ien in multiple
+2 SET APCDNIEN=$ORDER(^AUPNGOAL(APCDPIEN,21,"B",APCDLOC,0))
+3 IF APCDNIEN=""
SET X="`"_APCDLOC
SET DIC="^AUPNGOAL("_APCDPIEN_",21,"
SET DA(1)=APCDPIEN
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(APCDPIEN,21,"B",APCDLOC,0))
+4 IF APCDNIEN=""
WRITE $CHAR(7),$CHAR(7),"ERROR UPDATING STEP LOCATION MULTIPLE"
GOTO NOX
+5 SET (Y,X)=0
FOR
SET Y=$ORDER(^AUPNGOAL(APCDPIEN,21,APCDNIEN,11,"B",Y))
IF Y
SET X=Y
IF 'Y
SET X=X+1
KILL Y
QUIT
+6 SET APCDNUM=X
+7 WRITE !!,"Adding ",$PIECE(^DIC(4,APCDLOC,0),U)," Step"
+8 KILL DIC
SET X=APCDNUM
SET DA(1)=APCDNIEN
SET DA(2)=APCDPIEN
SET DIC="^AUPNGOAL("_APCDPIEN_",21,"_APCDNIEN_",11,"
SET DIC("P")=$PIECE(^DD(9000093.21,1101,0),U,2)
SET DIC(0)="L"
DO ^DIC
KILL DA,DR
+9 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"ERROR when updating step number multiple",!
GOTO NOX
+10 SET DIE=DIC
KILL DIC
WRITE ?10
SET %=$SELECT($GET(APCDDATE):$PIECE(APCDDATE,"."),1:DT)
SET (APCDDA,DA)=+Y
SET DR=".02////^S X=DUZ;.03////^S X=%;.07////^S X=DUZ;.08////^S X=$$NOW^XLFDT;1101;.04"
DO ^DIE
KILL DIE,DR,DA,Y
+11 ;GET START AND FOLLOWUP DATES
SSD SET APCDSD=""
+1 SET DIR(0)="9000093,.09"
SET DIR("A")="START DATE"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
WRITE !!,"value is required"
GOTO SSD
+3 SET APCDSD=Y
SFD SET APCDFUD=""
+1 SET DIR(0)="9000093,.1"
SET DIR("A")="FOLLOW UP DATE"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
WRITE !!,"value is required"
GOTO SFD
+3 SET APCDFUD=Y
+4 IF APCDFUD<APCDSD
WRITE !!,"followup date cannot be less than the start date"
GOTO SSD
+5 SET DIE="^AUPNGOAL("_APCDPIEN_",21,"_APCDNIEN_",11,"
SET DIC("P")=$PIECE(^DD(9000093.21,1101,0),U,2)
+6 SET DA=APCDDA
SET DR=".05////^S X=APCDSD;.06////^S X=APCDFUD;.09////A;.1"
+7 DO ^DIE
+8 KILL DA,DR,DIE
+9 GOTO NO1
NOX ;
+1 KILL Y,APCDPIEN,X,L,APCDNUM,APCDL,DIC,DA,DD,APCDC,APCDN,APCDNIEN,DR,DIADD
+2 QUIT
RNO1 ;EP - called from APCDPG1 - remove a step
+1 IF $DATA(IOF)
WRITE @IOF
+2 KILL APCDN,APCDL,APCDX,APCDC
+3 IF $PIECE(^AUPNGOAL(APCDPIEN,0),U,1)="N"
WRITE !!,"You cannot REMOVE a step from a goal that was Not Set.",!!
GOTO RNO1X
+4 WRITE !!,"Removing a Step from the following GOAL on ",$PIECE($PIECE(^DPT(DFN,0),U),",",2)," ",$PIECE($PIECE(^(0),U),","),"'s GOAL List.",!
+5 DO DISPGOAL
+6 SET APCDC=0
+7 IF $ORDER(^AUPNGOAL(APCDPIEN,21,0))
Begin DoDot:1
+8 WRITE !," Steps: "
SET APCDL=0
FOR
SET APCDL=$ORDER(^AUPNGOAL(APCDPIEN,21,APCDL))
IF APCDL'=+APCDL
QUIT
IF $ORDER(^AUPNGOAL(APCDPIEN,21,APCDL,11,0))
WRITE !?3,$PIECE(^DIC(4,$PIECE(^AUPNGOAL(APCDPIEN,21,APCDL,0),U),0),U)
Begin DoDot:2
+9 SET APCDX=0
FOR
SET APCDX=$ORDER(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX))
IF APCDX'=+APCDX
QUIT
Begin DoDot:3
+10 IF $PIECE(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,9)="D"
QUIT
+11 SET APCDC=APCDC+1
SET APCDN(APCDC)=APCDL_U_APCDX
+12 WRITE !?5,"Step#",APCDC," ",$PIECE($GET(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,11)),U,1)
+13 WRITE !?12,"Status: ",$$SS^APCDPG($PIECE($GET(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0)),U,9)),?39,"Start: ",$$DATE^APCDPG($PIECE(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,5))
+14 WRITE ?56,"F/U: ",$$DATE^APCDPG($PIECE(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,6))
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF APCDC=0
WRITE !?8,"No step on file for this GOAL"
GOTO RNO1X
+16 WRITE !
KILL DIR
SET DIR(0)="N^1:"_APCDC_":"
SET DIR("A")="Remove which one"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+17 IF $DATA(DIRUT)
WRITE !,"Okay, bye."
GOTO RNO1X
+18 IF 'Y
WRITE !,"No Step selected"
GOTO RNO1X
+19 SET APCDY=+Y
RSURE ;
+1 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to delete this STEP"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
WRITE !,"okay, not deleted."
GOTO RNO1X
+3 IF 'Y
WRITE !,"Okay, not deleted."
GOTO RNO1X
+4 SET DA(1)=$PIECE(APCDN(APCDY),U)
SET DA(2)=APCDPIEN
SET DIE="^AUPNGOAL("_APCDPIEN_",21,"_$PIECE(APCDN(APCDY),U)_",11,"
SET DIC("P")=$PIECE(^DD(9000093.21,1101,0),U,2)
+5 SET DA=$PIECE(APCDN(APCDY),U,2)
SET DR=".09///D;.07///^S X=DUZ;.08///^S X=$$NOW^XLFDT;2.01////^S X=DUZ;2.02////^S X=$$NOW^XLFDT;2.03"
SET DIE("NO^")=1
DO ^DIE
KILL DIE,DR,DA,Y
+6 IF $PIECE($GET(^AUPNGOAL(APCDPIEN,21,$PIECE(APCDN(APCDY),U),11,$PIECE(APCDN(APCDY),U,2),2)),U,3)="O"
Begin DoDot:1
+7 SET DA(1)=$PIECE(APCDN(APCDY),U)
SET DA(2)=APCDPIEN
SET DIE="^AUPNGOAL("_APCDPIEN_",21,"_$PIECE(APCDN(APCDY),U)_",11,"
SET DIC("P")=$PIECE(^DD(9000093.21,1101,0),U,2)
+8 SET DA=$PIECE(APCDN(APCDY),U,2)
SET DR="2.04R"
SET DIE("NO^")=1
DO ^DIE
KILL DIE,DR,DA,Y
End DoDot:1
+9 WRITE !!
RNO1X ;xit
+1 KILL APCDPIEN,APCDL,APCDX,APCDN,APCDY
+2 QUIT
MN1 ;EP - called to modify a step
+1 IF $DATA(IOF)
WRITE @IOF
+2 KILL APCDN,APCDL,APCDX,APCDC
+3 IF $PIECE(^AUPNGOAL(APCDPIEN,0),U,1)="N"
WRITE !!,"You cannot EDIT a step on a goal that was Not Set.",!!
GOTO NOX
+4 WRITE !!,"Editing a Step on the following GOAL on ",$PIECE($PIECE(^DPT(DFN,0),U),",",2)," ",$PIECE($PIECE(^(0),U),","),"'s GOAL List.",!
+5 DO DISPGOAL
+6 SET APCDC=0
+7 IF $ORDER(^AUPNGOAL(APCDPIEN,21,0))
Begin DoDot:1
+8 WRITE !," Steps: "
SET APCDL=0
FOR
SET APCDL=$ORDER(^AUPNGOAL(APCDPIEN,21,APCDL))
IF APCDL'=+APCDL
QUIT
IF $ORDER(^AUPNGOAL(APCDPIEN,21,APCDL,11,0))
WRITE !?3,$PIECE(^DIC(4,$PIECE(^AUPNGOAL(APCDPIEN,21,APCDL,0),U),0),U)
Begin DoDot:2
+9 SET APCDX=0
FOR
SET APCDX=$ORDER(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX))
IF APCDX'=+APCDX
QUIT
Begin DoDot:3
+10 IF $PIECE(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,9)="D"
QUIT
+11 SET APCDC=APCDC+1
SET APCDN(APCDC)=APCDL_U_APCDX
+12 WRITE !?5,APCDC,") ","Step#",APCDC," ",$PIECE($GET(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,11)),U,1)
+13 WRITE !?12,"Status: ",$$SS^APCDPG($PIECE($GET(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0)),U,9)),?39,"Start: ",$$DATE^APCDPG($PIECE(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,5))
+14 WRITE ?56,"F/U: ",$$DATE^APCDPG($PIECE(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,6))
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF APCDC=0
WRITE !?8,"No step on file for this GOAL"
GOTO MNO1X
+16 WRITE !
KILL DIR
SET DIR(0)="N^1:"_APCDC_":"
SET DIR("A")="Edit which one"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+17 IF $DATA(DIRUT)
WRITE !,"Okay, bye."
GOTO MNO1X
+18 IF 'Y
WRITE !,"No Step selected"
GOTO MNO1X
+19 SET APCDY=+Y
MSURE ;
+1 SET DA(1)=$PIECE(APCDN(APCDY),U)
SET DA(2)=APCDPIEN
SET DIE="^AUPNGOAL("_APCDPIEN_",21,"_$PIECE(APCDN(APCDY),U)_",11,"
SET DIC("P")=$PIECE(^DD(9000093.21,1101,0),U,2)
+2 SET DA=$PIECE(APCDN(APCDY),U,2)
+3 SET DR=".07////^S X=DUZ;.08////^S X=$$NOW^XLFDT"
DO ^DIE
KILL DIE,DR,DA,Y
+4 SET APCDSS=$PIECE(^AUPNGOAL(APCDPIEN,21,$PIECE(APCDN(APCDY),U),11,$PIECE(APCDN(APCDY),U,2),0),U,9)
+5 SET DIR(0)="S^ME:STEP MET;MA:MAINTAINING STEP;S:STEP STOPPED"
SET DIR("A")="STEP STATUS"
SET DIR("B")=APCDSS
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
GOTO MNO1X
+7 SET APCDSS=Y
+8 SET DR=".09////"_APCDSS_$SELECT(APCDSS="MA":";.06",1:"")
+9 SET DA(1)=$PIECE(APCDN(APCDY),U)
SET DA(2)=APCDPIEN
SET DIE="^AUPNGOAL("_APCDPIEN_",21,"_$PIECE(APCDN(APCDY),U)_",11,"
SET DIC("P")=$PIECE(^DD(9000093.21,1101,0),U,2)
+10 SET DA=$PIECE(APCDN(APCDY),U,2)
+11 DO ^DIE
+12 KILL DIE,DR,DA
MNO1X ;
+1 KILL APCDPIEN,APCDL,APCDX,APCDN,APCDY,APCDSS
+2 QUIT
DISPGOAL ;
+1 NEW APCDX,APCDP0,APCDF
+2 SET APCDP0=^AUPNGOAL(APCDPIEN,0)
+3 SET APCDF=$PIECE(APCDP0,U,6)
+4 SET APCDX=""
+5 SET APCDX=$$SETSTR^VALM1("GOAL ID: ",APCDX,3,11)
+6 SET X=$SELECT($PIECE(^AUTTLOC(APCDF,0),U,7)]"":$JUSTIFY($PIECE(^(0),U,7),4),1:"??")_$PIECE(APCDP0,U,7)
SET APCDX=$$SETSTR^VALM1(X,APCDX,13,10)
+7 SET APCDX=$$SETSTR^VALM1("Status: ",APCDX,24,8)
SET X=$$VAL^XBDIQ1(9000093,APCDPIEN,.01)_$SELECT($PIECE(APCDP0,U,11)]"":" - "_$$VAL^XBDIQ1(9000093,APCDPIEN,.11),1:"")
SET APCDX=$$SETSTR^VALM1(X,APCDX,33,26)
+8 WRITE !,APCDX
+9 IF $PIECE(^AUPNGOAL(APCDPIEN,0),U,1)="S"
SET APCDX=" Goal Start Date: "_$$DATE^APCDPG($PIECE(APCDP0,U,9))_" Goal Follow up Date: "_$$DATE^APCDPG($PIECE(APCDP0,U,10))
+10 IF $PIECE(^AUPNGOAL(APCDPIEN,0),U,1)="N"
SET APCDX=" Goal Created Date: "_$$DATE^APCDPG($PIECE(APCDP0,U,3))
+11 WRITE !,APCDX
+12 ;goal name, reason
+13 SET APCDX=" Goal Name: "_$$VAL^XBDIQ1(9000093,APCDPIEN,1101)
+14 WRITE !?2,APCDX
+15 SET APCDX=" Goal Reason: "_$$VAL^XBDIQ1(9000093,APCDPIEN,1201)
+16 WRITE !?2,APCDX
+17 QUIT
