- 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 "??"
