APCDAGOL ; IHS/CMI/LAB - PROMPT FOR PROBLEM ;
;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
;
START ;
NEW DA,DIR
S DIR(0)="9000093,.01",DIR("A")="Enter INITIAL GOAL Setting" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S APCDTSKI=1,APCDLOOK="" Q
G:Y="" XIT
S APCDLOOK=Y
XIT K Y,X,DO,D,DD,DIPGM,APCDIGS
Q
PG ;EP
I $G(APCDDATE)="" S APCDDATE=DT
I $G(APCDLOC)="" S APCDLOC=DUZ(2)
S DFN=APCDPAT,Y=APCDPAT D ^AUPNPAT K Y
S APCDPLL=APCDLOC,APCDPLD=$P(APCDDATE,".")
S APCDPLV=$G(APCDVSIT)
D EN^XBNEW("PL1^APCDAGOL","DFN;APCDPLL;APCDPLD;APCDPLV;VALM*")
Q
PL1 ;EP
D TERM^VALM0
D ENDE^APCDPG
Q
NON ;EP called from APCD NO (ADD) template
D ^XBNEW("NO^APCDAGOL:APCD*")
Q
STP ;EP called from APCD PO (ADD) template
NEW APCDADDP
S APCDADDP=1
D ^XBNEW("NO1^APCDAGOL:APCD*")
Q
NO ;EP add a step to a goal
K DIR,DIRUT S DIR(0)="F^1:12",DIR("A")="Enter Goal Number" K DA D ^DIR K DIR
G:$D(DIRUT) NOX
S APCDPR=Y
D ^APCDPLK
I APCDPERR=1 W $C(7),$C(7),"Not a valid problem number.",! K APCDPERR G NO
;display existing notes, get next note number
NO1 ;EP
S APCDGOAL=APCDPIEN
I $O(^AUPNGOAL(APCDGOAL,21,0)) D
.W !,"Steps: " S APCDL=0 F S APCDL=$O(^AUPNGOAL(APCDGOAL,21,APCDL)) Q:APCDL'=+APCDL I $O(^AUPNGOAL(APCDGOAL,21,APCDL,11,0)) W !?3,$P(^DIC(4,$P(^AUPNGOAL(APCDGOAL,21,APCDL,0),U),0),U) D
..S APCDX=0 F S APCDX=$O(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX)) Q:APCDX'=+APCDX D
...Q:$P(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,0),U,9)="D"
...W !?5,"Step#",$P(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,0),U)," ",$P($G(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,11)),U,1)
...W !?12,"Status: ",$$EXTSET^XBFUNC(9000093.211101,.09,$P(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,0),U,9)),?39,"Start: ",$$DATE^APCDPG($P(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,0),U,5))
...W ?56,"F/U: ",$$DATE^APCDPG($P(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,0),U,6))
...;S X=$P(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,0),U,4) I X S X=$P(^APCDPTGT(X,0),U,1) W ?64,"Type: ",X
W ! S DIR(0)="Y",DIR("A")="Add a new Step for this Goal",DIR("B")="N" K DA D ^DIR K DIR
G:$D(DIRUT) NOX
G:Y=0 NOX
;get next step number
NUM ;
;add location multiple if necessary, otherwise get ien in multiple
S APCDNIEN=$O(^AUPNGOAL(APCDGOAL,21,"B",APCDLOC,0))
I APCDNIEN="" S X="`"_APCDLOC,DIC="^AUPNGOAL("_APCDGOAL_",21,",DA(1)=APCDGOAL,DIC(0)="L",DIC("P")=$P(^DD(9000093,2100,0),U,2) D ^DIC K DIC,DA,DR,Y,X S APCDNIEN=$O(^AUPNGOAL(APCDGOAL,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(APCDGOAL,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 #",X
K DIC S X=APCDNUM,DA(1)=APCDNIEN,DA(2)=APCDGOAL,DIC="^AUPNGOAL("_APCDGOAL_",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),DA=+Y,DR=".02////^S X=DUZ;.03////^S X=%;.07////^S X=DUZ;.08////^S X=$$NOW^XLFDT;1101;.04;.05;.06;.09////A;.1" D ^DIE K DIE,DR,DA,Y W !!
G NO1
NOX ;
K Y,APCDGOAL,X,L,APCDNUM,APCDNIEN,DIC,DA,DD
Q
APCDAGOL ; IHS/CMI/LAB - PROMPT FOR PROBLEM ;
+1 ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
+2 ;
START ;
+1 NEW DA,DIR
+2 SET DIR(0)="9000093,.01"
SET DIR("A")="Enter INITIAL GOAL Setting"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET APCDTSKI=1
SET APCDLOOK=""
QUIT
+4 IF Y=""
GOTO XIT
+5 SET APCDLOOK=Y
XIT KILL Y,X,DO,D,DD,DIPGM,APCDIGS
+1 QUIT
PG ;EP
+1 IF $GET(APCDDATE)=""
SET APCDDATE=DT
+2 IF $GET(APCDLOC)=""
SET APCDLOC=DUZ(2)
+3 SET DFN=APCDPAT
SET Y=APCDPAT
DO ^AUPNPAT
KILL Y
+4 SET APCDPLL=APCDLOC
SET APCDPLD=$PIECE(APCDDATE,".")
+5 SET APCDPLV=$GET(APCDVSIT)
+6 DO EN^XBNEW("PL1^APCDAGOL","DFN;APCDPLL;APCDPLD;APCDPLV;VALM*")
+7 QUIT
PL1 ;EP
+1 DO TERM^VALM0
+2 DO ENDE^APCDPG
+3 QUIT
NON ;EP called from APCD NO (ADD) template
+1 DO ^XBNEW("NO^APCDAGOL:APCD*")
+2 QUIT
STP ;EP called from APCD PO (ADD) template
+1 NEW APCDADDP
+2 SET APCDADDP=1
+3 DO ^XBNEW("NO1^APCDAGOL:APCD*")
+4 QUIT
NO ;EP add a step to a goal
+1 KILL DIR,DIRUT
SET DIR(0)="F^1:12"
SET DIR("A")="Enter Goal Number"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO NOX
+3 SET APCDPR=Y
+4 DO ^APCDPLK
+5 IF APCDPERR=1
WRITE $CHAR(7),$CHAR(7),"Not a valid problem number.",!
KILL APCDPERR
GOTO NO
+6 ;display existing notes, get next note number
NO1 ;EP
+1 SET APCDGOAL=APCDPIEN
+2 IF $ORDER(^AUPNGOAL(APCDGOAL,21,0))
Begin DoDot:1
+3 WRITE !,"Steps: "
SET APCDL=0
FOR
SET APCDL=$ORDER(^AUPNGOAL(APCDGOAL,21,APCDL))
IF APCDL'=+APCDL
QUIT
IF $ORDER(^AUPNGOAL(APCDGOAL,21,APCDL,11,0))
WRITE !?3,$PIECE(^DIC(4,$PIECE(^AUPNGOAL(APCDGOAL,21,APCDL,0),U),0),U)
Begin DoDot:2
+4 SET APCDX=0
FOR
SET APCDX=$ORDER(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX))
IF APCDX'=+APCDX
QUIT
Begin DoDot:3
+5 IF $PIECE(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,0),U,9)="D"
QUIT
+6 WRITE !?5,"Step#",$PIECE(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,0),U)," ",$PIECE($GET(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,11)),U,1)
+7 WRITE !?12,"Status: ",$$EXTSET^XBFUNC(9000093.211101,.09,$PIECE(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,0),U,9)),?39,"Start: ",$$DATE^APCDPG($PIECE(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,0),U,5))
+8 WRITE ?56,"F/U: ",$$DATE^APCDPG($PIECE(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,0),U,6))
+9 ;S X=$P(^AUPNGOAL(APCDGOAL,21,APCDL,11,APCDX,0),U,4) I X S X=$P(^APCDPTGT(X,0),U,1) W ?64,"Type: ",X
End DoDot:3
End DoDot:2
End DoDot:1
+10 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Add a new Step for this Goal"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
GOTO NOX
+12 IF Y=0
GOTO NOX
+13 ;get next step number
NUM ;
+1 ;add location multiple if necessary, otherwise get ien in multiple
+2 SET APCDNIEN=$ORDER(^AUPNGOAL(APCDGOAL,21,"B",APCDLOC,0))
+3 IF APCDNIEN=""
SET X="`"_APCDLOC
SET DIC="^AUPNGOAL("_APCDGOAL_",21,"
SET DA(1)=APCDGOAL
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(APCDGOAL,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(APCDGOAL,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 #",X
+8 KILL DIC
SET X=APCDNUM
SET DA(1)=APCDNIEN
SET DA(2)=APCDGOAL
SET DIC="^AUPNGOAL("_APCDGOAL_",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 DA=+Y
SET DR=".02////^S X=DUZ;.03////^S X=%;.07////^S X=DUZ;.08////^S X=$$NOW^XLFDT;1101;.04;.05;.06;.09////A;.1"
DO ^DIE
KILL DIE,DR,DA,Y
WRITE !!
+11 GOTO NO1
NOX ;
+1 KILL Y,APCDGOAL,X,L,APCDNUM,APCDNIEN,DIC,DA,DD
+2 QUIT
