- 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
