Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCDPG2

APCDPG2.m

Go to the documentation of this file. 
  1. APCDPG2 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
  1.  ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
  1.  ;
  1. NO1 ;EP
  1.  W:$D(IOF) @IOF
  1.  NEW APCDSD,APCDFUD
  1.  I $P(^AUPNGOAL(APCDPIEN,0),U,1)="N" W !!,"You cannot add a step to a goal that was Not Set.",!! G NOX
  1.  W !!,"Adding a Step to the following GOAL on ",$P($P(^DPT(DFN,0),U),",",2)," ",$P($P(^(0),U),","),"'s GOAL List.",!
  1.  D DISPGOAL
  1.  I $O(^AUPNGOAL(APCDPIEN,21,0)) D
  1.  .S APCDC=0
  1.  .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
  1.  ..S APCDX=0 F  S APCDX=$O(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX)) Q:APCDX'=+APCDX  D
  1.  ...Q:$P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,9)="D"
  1.  ...S APCDC=APCDC+1
  1.  ...W !?5,"Step#",APCDC," ",$P($G(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,11)),U,1)
  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))
  1.  ...W ?56,"F/U: ",$$DATE^APCDPG($P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,6))
  1.  W ! S DIR(0)="Y",DIR("A")="Add a new Step for this Goal",DIR("B")="Y" K DA D ^DIR K DIR
  1.  G:$D(DIRUT) NOX
  1.  G:Y=0 NOX
  1. NUM ;
  1.  ;add location multiple if necessary, otherwise get ien in multiple
  1.  S APCDNIEN=$O(^AUPNGOAL(APCDPIEN,21,"B",APCDLOC,0))
  1.  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))
  1.  I APCDNIEN="" W $C(7),$C(7),"ERROR UPDATING STEP LOCATION MULTIPLE" G NOX
  1.  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
  1.  S APCDNUM=X
  1.  W !!,"Adding ",$P(^DIC(4,APCDLOC,0),U)," Step"
  1.  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
  1.  I Y=-1 W !!,$C(7),$C(7),"ERROR when updating step number multiple",! G NOX
  1.  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
  1.  ;GET START AND FOLLOWUP DATES
  1. SSD S APCDSD=""
  1.  S DIR(0)="9000093,.09",DIR("A")="START DATE" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) W !!,"value is required" G SSD
  1.  S APCDSD=Y
  1. SFD S APCDFUD=""
  1.  S DIR(0)="9000093,.1",DIR("A")="FOLLOW UP DATE" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) W !!,"value is required" G SFD
  1.  S APCDFUD=Y
  1.  I APCDFUD<APCDSD W !!,"followup date cannot be less than the start date" G SSD
  1.  S DIE="^AUPNGOAL("_APCDPIEN_",21,"_APCDNIEN_",11,",DIC("P")=$P(^DD(9000093.21,1101,0),U,2)
  1.  S DA=APCDDA,DR=".05////^S X=APCDSD;.06////^S X=APCDFUD;.09////A;.1"
  1.  D ^DIE
  1.  K DA,DR,DIE
  1.  G NO1
  1. NOX ;
  1.  K Y,APCDPIEN,X,L,APCDNUM,APCDL,DIC,DA,DD,APCDC,APCDN,APCDNIEN,DR,DIADD
  1.  Q
  1. RNO1 ;EP - called from APCDPG1 - remove a step
  1.  W:$D(IOF) @IOF
  1.  K APCDN,APCDL,APCDX,APCDC
  1.  I $P(^AUPNGOAL(APCDPIEN,0),U,1)="N" W !!,"You cannot REMOVE a step from a goal that was Not Set.",!! G RNO1X
  1.  W !!,"Removing a Step from the following GOAL on ",$P($P(^DPT(DFN,0),U),",",2)," ",$P($P(^(0),U),","),"'s GOAL List.",!
  1.  D DISPGOAL
  1.  S APCDC=0
  1.  I $O(^AUPNGOAL(APCDPIEN,21,0)) D
  1.  .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
  1.  ..S APCDX=0 F  S APCDX=$O(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX)) Q:APCDX'=+APCDX  D
  1.  ...Q:$P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,9)="D"
  1.  ...S APCDC=APCDC+1,APCDN(APCDC)=APCDL_U_APCDX
  1.  ...W !?5,"Step#",APCDC," ",$P($G(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,11)),U,1)
  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))
  1.  ...W ?56,"F/U: ",$$DATE^APCDPG($P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,6))
  1.  I APCDC=0 W !?8,"No step on file for this GOAL" G RNO1X
  1.  W ! K DIR S DIR(0)="N^1:"_APCDC_":",DIR("A")="Remove which one" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"Okay, bye." G RNO1X
  1.  I 'Y W !,"No Step selected"  G RNO1X
  1.  S APCDY=+Y
  1. RSURE ;
  1.  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
  1.  I $D(DIRUT) W !,"okay, not deleted." G RNO1X
  1.  I 'Y W !,"Okay, not deleted." G RNO1X
  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)
  1.  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
  1.  I $P($G(^AUPNGOAL(APCDPIEN,21,$P(APCDN(APCDY),U),11,$P(APCDN(APCDY),U,2),2)),U,3)="O" D
  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)
  1.  .S DA=$P(APCDN(APCDY),U,2),DR="2.04R",DIE("NO^")=1 D ^DIE K DIE,DR,DA,Y
  1.  W !!
  1. RNO1X ;xit
  1.  K APCDPIEN,APCDL,APCDX,APCDN,APCDY
  1.  Q
  1. MN1 ;EP - called to modify a step
  1.  W:$D(IOF) @IOF
  1.  K APCDN,APCDL,APCDX,APCDC
  1.  I $P(^AUPNGOAL(APCDPIEN,0),U,1)="N" W !!,"You cannot EDIT a step on a goal that was Not Set.",!! G NOX
  1.  W !!,"Editing a Step on the following GOAL on ",$P($P(^DPT(DFN,0),U),",",2)," ",$P($P(^(0),U),","),"'s GOAL List.",!
  1.  D DISPGOAL
  1.  S APCDC=0
  1.  I $O(^AUPNGOAL(APCDPIEN,21,0)) D
  1.  .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
  1.  ..S APCDX=0 F  S APCDX=$O(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX)) Q:APCDX'=+APCDX  D
  1.  ...Q:$P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,9)="D"
  1.  ...S APCDC=APCDC+1,APCDN(APCDC)=APCDL_U_APCDX
  1.  ...W !?5,APCDC,") ","Step#",APCDC," ",$P($G(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,11)),U,1)
  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))
  1.  ...W ?56,"F/U: ",$$DATE^APCDPG($P(^AUPNGOAL(APCDPIEN,21,APCDL,11,APCDX,0),U,6))
  1.  I APCDC=0 W !?8,"No step on file for this GOAL" G MNO1X
  1.  W ! K DIR S DIR(0)="N^1:"_APCDC_":",DIR("A")="Edit which one" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"Okay, bye." G MNO1X
  1.  I 'Y W !,"No Step selected"  G MNO1X
  1.  S APCDY=+Y
  1. MSURE ;
  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)
  1.  S DA=$P(APCDN(APCDY),U,2)
  1.  S DR=".07////^S X=DUZ;.08////^S X=$$NOW^XLFDT" D ^DIE K DIE,DR,DA,Y
  1.  S APCDSS=$P(^AUPNGOAL(APCDPIEN,21,$P(APCDN(APCDY),U),11,$P(APCDN(APCDY),U,2),0),U,9)
  1.  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
  1.  I $D(DIRUT) G MNO1X
  1.  S APCDSS=Y
  1.  S DR=".09////"_APCDSS_$S(APCDSS="MA":";.06",1:"")
  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)
  1.  S DA=$P(APCDN(APCDY),U,2)
  1.  D ^DIE
  1.  K DIE,DR,DA
  1. MNO1X ;
  1.  K APCDPIEN,APCDL,APCDX,APCDN,APCDY,APCDSS
  1.  Q
  1. DISPGOAL ;
  1.  NEW APCDX,APCDP0,APCDF
  1.  S APCDP0=^AUPNGOAL(APCDPIEN,0)
  1.  S APCDF=$P(APCDP0,U,6)
  1.  S APCDX=""
  1.  S APCDX=$$SETSTR^VALM1("GOAL ID: ",APCDX,3,11)
  1.  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)
  1.  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)
  1.  W !,APCDX
  1.  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))
  1.  I $P(^AUPNGOAL(APCDPIEN,0),U,1)="N" S APCDX="   Goal Created Date: "_$$DATE^APCDPG($P(APCDP0,U,3))
  1.  W !,APCDX
  1.  ;goal name, reason
  1.  S APCDX="   Goal Name: "_$$VAL^XBDIQ1(9000093,APCDPIEN,1101)
  1.  W !?2,APCDX
  1.  S APCDX="   Goal Reason: "_$$VAL^XBDIQ1(9000093,APCDPIEN,1201)
  1.  W !?2,APCDX
  1.  Q