APCHS82 ; IHS/CMI/LAB - PART 4 OF APCHS -- SUMMARY PRODUCTION COMPONENTS ; 12 Sep 2011 5:35 PM
;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
;
GOAL ; ******************** GOAL / STEPS *********
AGOAL ;
; <SETUP>
COMMON Q:'$D(^AUPNGOAL("AC",APCHSPAT)) ;no goals so don't bother
K APCHSDFT S APCHSNDF=0
S APCHSFAC="" F APCHSQ=0:0 S APCHSFAC=$O(^AUPNGOAL("AA",APCHSPAT,APCHSFAC)) Q:'APCHSFAC D GOALSCH
X APCHSCKP G:$D(APCHSQIT) GOALX I 'APCHSNPG W ! X APCHSCKP G:$D(APCHSQIT) GOALX X:'APCHSNPG APCHSBRK
I APCHSNDF=0 G COMMON1
; <DISPLAY>
S APCHSTAT="" F S APCHSTAT=$O(APCHSDFT(APCHSTAT)) Q:APCHSTAT=""!($D(APCHSQIT)) D
.X APCHSCKP Q:$D(APCHSQIT)
.I APCHSTAT="A" W "ACTIVE GOALS (ALL ACTIVE AND MAINTAINING GOALS)",!
.I APCHSTAT="I" W !,"INACTIVE GOALS (ALL GOALS STOPPED OR MET IN PAST 12 MONTHS)",!
.I APCHSTAT="N" W !,"GOALS NOT SET (LAST 5 OR 12 MONTHS)",!
.S APCHSFPP="" F S APCHSFPP=$O(APCHSDFT(APCHSTAT,APCHSFPP)) Q:APCHSFPP=""!($D(APCHSQIT)) D
..S APCHSIEN=APCHSDFT(APCHSTAT,APCHSFPP) D GOALDSP
COMMON1 ;
GOALX K APCHSDFT,APCHSNDF,APCHSFPP,APCHSFAC,APCHSPLN,APCHSPBN,APCHSDTM,APCHSDTN,APCHSPRB,APCHSTAT,APCHSNFP,APCHSNRQ,APCHSPNM,APCHSIEN,APCHSFCN,APCHSICD,APCHSDOO
K APCHSICL,APCHSILN,APCHSN,APCHSNAR,APCHSNTE
K APCHSNFL,APCHSNSH,APCHSNAB,APCHSVSC,APCHSITE,Y,APCHCSVD,APCHSX
Q
GOALSCH ;
S APCHSPRB="" F APCHSQ=0:0 S APCHSPRB=$O(^AUPNGOAL("AA",APCHSPAT,APCHSFAC,APCHSPRB)) Q:APCHSPRB="" D
.S APCHSTAT=""
.S APCHSIEN=$O(^(APCHSPRB,""))
.Q:$P(^AUPNGOAL(APCHSIEN,0),U,11)="D" ;never display deleted goals
.I $P(^AUPNGOAL(APCHSIEN,0),U,1)="S",$P(^AUPNGOAL(APCHSIEN,0),U,11)="A" S APCHSTAT="A"
.I $P(^AUPNGOAL(APCHSIEN,0),U,1)="S",$P(^AUPNGOAL(APCHSIEN,0),U,11)="ME" S APCHSTAT="I"
.I $P(^AUPNGOAL(APCHSIEN,0),U,1)="S",$P(^AUPNGOAL(APCHSIEN,0),U,11)="MA" S APCHSTAT="A"
.I $P(^AUPNGOAL(APCHSIEN,0),U,1)="S",$P(^AUPNGOAL(APCHSIEN,0),U,11)="S" S APCHSTAT="I"
.I $P(^AUPNGOAL(APCHSIEN,0),U,1)="N" S APCHSTAT="N"
.I APCHSTAT="I",$$FMDIFF^XLFDT(DT,$P(^AUPNGOAL(APCHSIEN,0),U,3))>365 Q ;ONLY DISPLAY IF INACTIVE AND STARTED IN PAST 12 MOS
.I APCHSTAT="" Q ;?? CAN'T FIGURE OUT IF ACTIVE OR INACTIVE
.S APCHSNDF=APCHSNDF+1
.S APCHSTAT(APCHSTAT)=$G(APCHSTAT(APCHSTAT))+1
.I APCHSTAT="N",APCHSTAT(APCHSTAT)>5 Q ;ONLY DISPLAY LAST 5 OF Goals not set
.S APCHSDFT(APCHSTAT,APCHSFAC_APCHSPRB)=APCHSIEN
Q
GOALDSP ;
; <SETUP GOAL>
S APCHSN=^AUPNGOAL(APCHSIEN,0)
D STEPDSP
Q
STEPDSP ;
X APCHSCKP Q:$D(APCHSQIT)
S APCHSFAC=$P(APCHSN,U,6)
W !,"GOAL ID: "
S X=$S($P(^AUTTLOC(APCHSFAC,0),U,7)]"":$J($P(^(0),U,7),4),1:"??")_$P(APCHSN,U,7)
W X,?20,"Status: ",$S($P(APCHSN,U,1)="N":"GOAL NOT SET",1:$$VAL^XBDIQ1(9000093,APCHSIEN,.11)),!
X APCHSCKP Q:$D(APCHSQIT)
;GOAL NAME
K APCHWP
D WP($$VAL^XBDIQ1(9000093,APCHSIEN,1101),70)
S APCHX=0 F S APCHX=$O(APCHWP(APCHX)) Q:APCHX'=+APCHX!($D(APCHSQIT)) D
.X APCHSCKP Q:$D(APCHSQIT)
.W ?9,APCHWP(APCHX),!
Q:$D(APCHSQIT)
X APCHSCKP Q:$D(APCHSQIT)
I $P(^AUPNGOAL(APCHSIEN,0),U,1)="S" S X="Start: "_$$DATE^APCDPG($P(APCHSN,U,9))_" Follow up: "_$$DATE^APCDPG($P(APCHSN,U,10))_" Modified: "_$$DATE^APCDPG($P(APCHSN,U,5))
I $P(^AUPNGOAL(APCHSIEN,0),U,1)="N" S X="Created: "_$$DATE^APCDPG($P(APCHSN,U,3))
W ?9,X,!
S APCHX=0,Y="" F S APCHX=$O(^AUPNGOAL(APCHSIEN,10,APCHX)) Q:APCHX'=+APCHX S X=$P(^AUPNGOAL(APCHSIEN,10,APCHX,0),U,1),X=$P(^APCDTPGT(X,0),U,1) S Y=Y_X_" "
K APCHWP
D WP("Type: "_Y,59)
S APCHX=0 F S APCHX=$O(APCHWP(APCHX)) Q:APCHX'=+APCHX!($D(APCHSQIT)) D
.X APCHSCKP Q:$D(APCHSQIT)
.W ?9,APCHWP(APCHX),!
Q:$D(APCHSQIT)
;GOAL NAME
K APCHWP
D WP("Goal Name: "_$$VAL^XBDIQ1(9000093,APCHSIEN,1101),59)
S APCHX=0 F S APCHX=$O(APCHWP(APCHX)) Q:APCHX'=+APCHX!($D(APCHSQIT)) D
.X APCHSCKP Q:$D(APCHSQIT)
.W ?9,APCHWP(APCHX),!
Q:$D(APCHSQIT)
;REASON
K APCHWP
D WP("Reason: "_$$VAL^XBDIQ1(9000093,APCHSIEN,1201),59)
S APCHX=0 F S APCHX=$O(APCHWP(APCHX)) Q:APCHX'=+APCHX!($D(APCHSQIT)) D
.X APCHSCKP Q:$D(APCHSQIT)
.W ?9,APCHWP(APCHX),!
Q:$D(APCHSQIT)
X APCHSCKP Q:$D(APCHSQIT)
W ?9,"Provider: ",$$VAL^XBDIQ1(9000093,APCHSIEN,.08),!
;display steps
STEP S APCHC=0 I $O(^AUPNGOAL(APCHSIEN,21,0)) D
.S (APCHC,APCHL)=0,APCHSLR="" F S APCHL=$O(^AUPNGOAL(APCHSIEN,21,APCHL)) Q:APCHL'=+APCHL!($D(APCHSQIT)) D
..I $O(^AUPNGOAL(APCHSIEN,21,APCHL,11,0)) S APCHSLR=$P(^AUTTLOC($P(^AUPNGOAL(APCHSIEN,21,APCHL,0),U),0),U,7) D
...S APCHX=0,APCDC=0 F S APCHX=$O(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX)) Q:APCHX'=+APCHX D
....Q:$P(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0),U,9)="D"
....X APCHSCKP Q:$D(APCHSQIT)
....S APCDC=APCDC+1
....S X=APCHSLR_" Step#"_APCDC,$E(X,20)="Status: "_$$SS($P($G(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0)),U,9))
....W ?3,X,!
....K APCHWP
....D WP($P($G(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,11)),U,1),70)
....S APCHY=0 F S APCHY=$O(APCHWP(APCHY)) Q:APCHY'=+APCHY!($D(APCHSQIT)) D
.....X APCHSCKP Q:$D(APCHSQIT)
.....W ?9,APCHWP(APCHY),!
....X APCHSCKP Q:$D(APCHSQIT)
....S X="Start: "_$$DATE^APCDPG($P(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0),U,5))_" Follow Up: "_$$DATE^APCDPG($P(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0),U,6)) ;_" Modified: "_$$DATE^APCDPG($P(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0),U,8))
....W ?9,X,!
....X APCHSCKP Q:$D(APCHSQIT)
....S Y=$P(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0),U,4) I Y S Y=$P(^APCDTPGT(Y,0),U,1)
....S P=$P(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0),U,10) I P S P=$P(^VA(200,P,0),U,1)
....S X="Type: "_Y_" Provider: "_P
....W ?9,X,!
DISPREVS ;
Q:'$O(^AUPNGOAL(APCHSIEN,13,0)) ;no review/followups on file
W ?3,"Followup/Reviews for GOAL : "_$S($P(^AUTTLOC(APCHSFAC,0),U,7)]"":$J($P(^(0),U,7),4),1:"??")_$P(APCHSN,U,7),!
S (APCHC,APCHL)=0
F S APCHL=$O(^AUPNGOAL(APCHSIEN,13,APCHL)) Q:APCHL'=+APCHL!($D(APCHSQIT)) D
.S X="Date: "_$$DATE^APCDPG($P(^AUPNGOAL(APCHSIEN,13,APCHL,0),U))_" "_$P(^AUPNGOAL(APCHSIEN,13,APCHL,0),U,2)
.K APCHWP
.D WP(X,70)
.S APCHY=0 F S APCHY=$O(APCHWP(APCHY)) Q:APCHY'=+APCHY!($D(APCHSQIT)) D
..X APCHSCKP Q:$D(APCHSQIT)
..W ?9,APCHWP(APCHY),!
Q
WP(X,R) ;EP - Entry point to print wp fields pass node in APCHWP
NEW APCHG,APCHX,CNT
K ^UTILITY($J,"W")
S APCHX=0
S DIWL=1,DIWR=R
D ^DIWP
S (Z,CNT)=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z S CNT=CNT+1,APCHWP(CNT)=^UTILITY($J,"W",DIWL,Z,0)
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),APCHG,CNT,APCHX
Q
SS(%) ;
I %="A" Q "ACTIVE"
I %="MA" Q "MAINTAINING STEP"
I %="ME" Q "STEP MET"
I %="S" Q "STEP STOPPED"
I %="D" Q "DELETED"
Q "??"
APCHS82 ; IHS/CMI/LAB - PART 4 OF APCHS -- SUMMARY PRODUCTION COMPONENTS ; 12 Sep 2011 5:35 PM
+1 ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
+2 ;
GOAL ; ******************** GOAL / STEPS *********
AGOAL ;
+1 ; <SETUP>
COMMON ;no goals so don't bother
IF '$DATA(^AUPNGOAL("AC",APCHSPAT))
QUIT
+1 KILL APCHSDFT
SET APCHSNDF=0
+2 SET APCHSFAC=""
FOR APCHSQ=0:0
SET APCHSFAC=$ORDER(^AUPNGOAL("AA",APCHSPAT,APCHSFAC))
IF 'APCHSFAC
QUIT
DO GOALSCH
+3 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
GOTO GOALX
IF 'APCHSNPG
WRITE !
XECUTE APCHSCKP
IF $DATA(APCHSQIT)
GOTO GOALX
IF 'APCHSNPG
XECUTE APCHSBRK
+4 IF APCHSNDF=0
GOTO COMMON1
+5 ; <DISPLAY>
+6 SET APCHSTAT=""
FOR
SET APCHSTAT=$ORDER(APCHSDFT(APCHSTAT))
IF APCHSTAT=""!($DATA(APCHSQIT))
QUIT
Begin DoDot:1
+7 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+8 IF APCHSTAT="A"
WRITE "ACTIVE GOALS (ALL ACTIVE AND MAINTAINING GOALS)",!
+9 IF APCHSTAT="I"
WRITE !,"INACTIVE GOALS (ALL GOALS STOPPED OR MET IN PAST 12 MONTHS)",!
+10 IF APCHSTAT="N"
WRITE !,"GOALS NOT SET (LAST 5 OR 12 MONTHS)",!
+11 SET APCHSFPP=""
FOR
SET APCHSFPP=$ORDER(APCHSDFT(APCHSTAT,APCHSFPP))
IF APCHSFPP=""!($DATA(APCHSQIT))
QUIT
Begin DoDot:2
+12 SET APCHSIEN=APCHSDFT(APCHSTAT,APCHSFPP)
DO GOALDSP
End DoDot:2
End DoDot:1
COMMON1 ;
GOALX KILL APCHSDFT,APCHSNDF,APCHSFPP,APCHSFAC,APCHSPLN,APCHSPBN,APCHSDTM,APCHSDTN,APCHSPRB,APCHSTAT,APCHSNFP,APCHSNRQ,APCHSPNM,APCHSIEN,APCHSFCN,APCHSICD,APCHSDOO
+1 KILL APCHSICL,APCHSILN,APCHSN,APCHSNAR,APCHSNTE
+2 KILL APCHSNFL,APCHSNSH,APCHSNAB,APCHSVSC,APCHSITE,Y,APCHCSVD,APCHSX
+3 QUIT
GOALSCH ;
+1 SET APCHSPRB=""
FOR APCHSQ=0:0
SET APCHSPRB=$ORDER(^AUPNGOAL("AA",APCHSPAT,APCHSFAC,APCHSPRB))
IF APCHSPRB=""
QUIT
Begin DoDot:1
+2 SET APCHSTAT=""
+3 SET APCHSIEN=$ORDER(^(APCHSPRB,""))
+4 ;never display deleted goals
IF $PIECE(^AUPNGOAL(APCHSIEN,0),U,11)="D"
QUIT
+5 IF $PIECE(^AUPNGOAL(APCHSIEN,0),U,1)="S"
IF $PIECE(^AUPNGOAL(APCHSIEN,0),U,11)="A"
SET APCHSTAT="A"
+6 IF $PIECE(^AUPNGOAL(APCHSIEN,0),U,1)="S"
IF $PIECE(^AUPNGOAL(APCHSIEN,0),U,11)="ME"
SET APCHSTAT="I"
+7 IF $PIECE(^AUPNGOAL(APCHSIEN,0),U,1)="S"
IF $PIECE(^AUPNGOAL(APCHSIEN,0),U,11)="MA"
SET APCHSTAT="A"
+8 IF $PIECE(^AUPNGOAL(APCHSIEN,0),U,1)="S"
IF $PIECE(^AUPNGOAL(APCHSIEN,0),U,11)="S"
SET APCHSTAT="I"
+9 IF $PIECE(^AUPNGOAL(APCHSIEN,0),U,1)="N"
SET APCHSTAT="N"
+10 ;ONLY DISPLAY IF INACTIVE AND STARTED IN PAST 12 MOS
IF APCHSTAT="I"
IF $$FMDIFF^XLFDT(DT,$PIECE(^AUPNGOAL(APCHSIEN,0),U,3))>365
QUIT
+11 ;?? CAN'T FIGURE OUT IF ACTIVE OR INACTIVE
IF APCHSTAT=""
QUIT
+12 SET APCHSNDF=APCHSNDF+1
+13 SET APCHSTAT(APCHSTAT)=$GET(APCHSTAT(APCHSTAT))+1
+14 ;ONLY DISPLAY LAST 5 OF Goals not set
IF APCHSTAT="N"
IF APCHSTAT(APCHSTAT)>5
QUIT
+15 SET APCHSDFT(APCHSTAT,APCHSFAC_APCHSPRB)=APCHSIEN
End DoDot:1
+16 QUIT
GOALDSP ;
+1 ; <SETUP GOAL>
+2 SET APCHSN=^AUPNGOAL(APCHSIEN,0)
+3 DO STEPDSP
+4 QUIT
STEPDSP ;
+1 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+2 SET APCHSFAC=$PIECE(APCHSN,U,6)
+3 WRITE !,"GOAL ID: "
+4 SET X=$SELECT($PIECE(^AUTTLOC(APCHSFAC,0),U,7)]"":$JUSTIFY($PIECE(^(0),U,7),4),1:"??")_$PIECE(APCHSN,U,7)
+5 WRITE X,?20,"Status: ",$SELECT($PIECE(APCHSN,U,1)="N":"GOAL NOT SET",1:$$VAL^XBDIQ1(9000093,APCHSIEN,.11)),!
+6 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+7 ;GOAL NAME
+8 KILL APCHWP
+9 DO WP($$VAL^XBDIQ1(9000093,APCHSIEN,1101),70)
+10 SET APCHX=0
FOR
SET APCHX=$ORDER(APCHWP(APCHX))
IF APCHX'=+APCHX!($DATA(APCHSQIT))
QUIT
Begin DoDot:1
+11 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+12 WRITE ?9,APCHWP(APCHX),!
End DoDot:1
+13 IF $DATA(APCHSQIT)
QUIT
+14 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+15 IF $PIECE(^AUPNGOAL(APCHSIEN,0),U,1)="S"
SET X="Start: "_$$DATE^APCDPG($PIECE(APCHSN,U,9))_" Follow up: "_$$DATE^APCDPG($PIECE(APCHSN,U,10))_" Modified: "_$$DATE^APCDPG($PIECE(APCHSN,U,5))
+16 IF $PIECE(^AUPNGOAL(APCHSIEN,0),U,1)="N"
SET X="Created: "_$$DATE^APCDPG($PIECE(APCHSN,U,3))
+17 WRITE ?9,X,!
+18 SET APCHX=0
SET Y=""
FOR
SET APCHX=$ORDER(^AUPNGOAL(APCHSIEN,10,APCHX))
IF APCHX'=+APCHX
QUIT
SET X=$PIECE(^AUPNGOAL(APCHSIEN,10,APCHX,0),U,1)
SET X=$PIECE(^APCDTPGT(X,0),U,1)
SET Y=Y_X_" "
+19 KILL APCHWP
+20 DO WP("Type: "_Y,59)
+21 SET APCHX=0
FOR
SET APCHX=$ORDER(APCHWP(APCHX))
IF APCHX'=+APCHX!($DATA(APCHSQIT))
QUIT
Begin DoDot:1
+22 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+23 WRITE ?9,APCHWP(APCHX),!
End DoDot:1
+24 IF $DATA(APCHSQIT)
QUIT
+25 ;GOAL NAME
+26 KILL APCHWP
+27 DO WP("Goal Name: "_$$VAL^XBDIQ1(9000093,APCHSIEN,1101),59)
+28 SET APCHX=0
FOR
SET APCHX=$ORDER(APCHWP(APCHX))
IF APCHX'=+APCHX!($DATA(APCHSQIT))
QUIT
Begin DoDot:1
+29 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+30 WRITE ?9,APCHWP(APCHX),!
End DoDot:1
+31 IF $DATA(APCHSQIT)
QUIT
+32 ;REASON
+33 KILL APCHWP
+34 DO WP("Reason: "_$$VAL^XBDIQ1(9000093,APCHSIEN,1201),59)
+35 SET APCHX=0
FOR
SET APCHX=$ORDER(APCHWP(APCHX))
IF APCHX'=+APCHX!($DATA(APCHSQIT))
QUIT
Begin DoDot:1
+36 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+37 WRITE ?9,APCHWP(APCHX),!
End DoDot:1
+38 IF $DATA(APCHSQIT)
QUIT
+39 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+40 WRITE ?9,"Provider: ",$$VAL^XBDIQ1(9000093,APCHSIEN,.08),!
+41 ;display steps
STEP SET APCHC=0
IF $ORDER(^AUPNGOAL(APCHSIEN,21,0))
Begin DoDot:1
+1 SET (APCHC,APCHL)=0
SET APCHSLR=""
FOR
SET APCHL=$ORDER(^AUPNGOAL(APCHSIEN,21,APCHL))
IF APCHL'=+APCHL!($DATA(APCHSQIT))
QUIT
Begin DoDot:2
+2 IF $ORDER(^AUPNGOAL(APCHSIEN,21,APCHL,11,0))
SET APCHSLR=$PIECE(^AUTTLOC($PIECE(^AUPNGOAL(APCHSIEN,21,APCHL,0),U),0),U,7)
Begin DoDot:3
+3 SET APCHX=0
SET APCDC=0
FOR
SET APCHX=$ORDER(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX))
IF APCHX'=+APCHX
QUIT
Begin DoDot:4
+4 IF $PIECE(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0),U,9)="D"
QUIT
+5 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+6 SET APCDC=APCDC+1
+7 SET X=APCHSLR_" Step#"_APCDC
SET $EXTRACT(X,20)="Status: "_$$SS($PIECE($GET(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0)),U,9))
+8 WRITE ?3,X,!
+9 KILL APCHWP
+10 DO WP($PIECE($GET(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,11)),U,1),70)
+11 SET APCHY=0
FOR
SET APCHY=$ORDER(APCHWP(APCHY))
IF APCHY'=+APCHY!($DATA(APCHSQIT))
QUIT
Begin DoDot:5
+12 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+13 WRITE ?9,APCHWP(APCHY),!
End DoDot:5
+14 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+15 ;_" Modified: "_$$DATE^APCDPG($P(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0),U,8))
SET X="Start: "_$$DATE^APCDPG($PIECE(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0),U,5))_" Follow Up: "_$$DATE^APCDPG($PIECE(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0),U,6))
+16 WRITE ?9,X,!
+17 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+18 SET Y=$PIECE(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0),U,4)
IF Y
SET Y=$PIECE(^APCDTPGT(Y,0),U,1)
+19 SET P=$PIECE(^AUPNGOAL(APCHSIEN,21,APCHL,11,APCHX,0),U,10)
IF P
SET P=$PIECE(^VA(200,P,0),U,1)
+20 SET X="Type: "_Y_" Provider: "_P
+21 WRITE ?9,X,!
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
DISPREVS ;
+1 ;no review/followups on file
IF '$ORDER(^AUPNGOAL(APCHSIEN,13,0))
QUIT
+2 WRITE ?3,"Followup/Reviews for GOAL : "_$SELECT($PIECE(^AUTTLOC(APCHSFAC,0),U,7)]"":$JUSTIFY($PIECE(^(0),U,7),4),1:"??")_$PIECE(APCHSN,U,7),!
+3 SET (APCHC,APCHL)=0
+4 FOR
SET APCHL=$ORDER(^AUPNGOAL(APCHSIEN,13,APCHL))
IF APCHL'=+APCHL!($DATA(APCHSQIT))
QUIT
Begin DoDot:1
+5 SET X="Date: "_$$DATE^APCDPG($PIECE(^AUPNGOAL(APCHSIEN,13,APCHL,0),U))_" "_$PIECE(^AUPNGOAL(APCHSIEN,13,APCHL,0),U,2)
+6 KILL APCHWP
+7 DO WP(X,70)
+8 SET APCHY=0
FOR
SET APCHY=$ORDER(APCHWP(APCHY))
IF APCHY'=+APCHY!($DATA(APCHSQIT))
QUIT
Begin DoDot:2
+9 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
+10 WRITE ?9,APCHWP(APCHY),!
End DoDot:2
End DoDot:1
+11 QUIT
WP(X,R) ;EP - Entry point to print wp fields pass node in APCHWP
+1 NEW APCHG,APCHX,CNT
+2 KILL ^UTILITY($JOB,"W")
+3 SET APCHX=0
+4 SET DIWL=1
SET DIWR=R
+5 DO ^DIWP
+6 SET (Z,CNT)=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
SET CNT=CNT+1
SET APCHWP(CNT)=^UTILITY($JOB,"W",DIWL,Z,0)
+7 KILL DIWL,DIWR,DIWF,Z
+8 KILL ^UTILITY($JOB,"W"),APCHG,CNT,APCHX
+9 QUIT
SS(%) ;
+1 IF %="A"
QUIT "ACTIVE"
+2 IF %="MA"
QUIT "MAINTAINING STEP"
+3 IF %="ME"
QUIT "STEP MET"
+4 IF %="S"
QUIT "STEP STOPPED"
+5 IF %="D"
QUIT "DELETED"
+6 QUIT "??"
