ACDWSTA1 ;IHS/ADC/EDE/KML - staff report for preventions 10:19;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
P ;$O on prevention date
F ACD=ACDFR-.01:0 Q:$D(DIRUT) S ACD=$O(^ACDPD("B",ACD)) Q:'ACD!(ACD>ACDTO) F ACDV=0:0 Q:$D(DIRUT) S ACDV=$O(^ACDPD("B",ACD,ACDV)) Q:'ACDV S ACDDA=ACDV D ^ACDWPD I ACD6DIG=ACDAUF D P1 Q:$D(DIRUT)
Q
P1 ;Check provider / print visit information
D F
Q:$D(DIRUT)
D CK I 'ACDOK Q
S ACDVNUM=ACDVNUM+1,ACDPNUM=0
I '$D(ACDSUMRP) W !,ACDVNUM,")",?5,$$DD^ACDFUNC(ACDPDT),?18,$E(ACDPG,1,12),?31,"PREVENTION",!!?14,"Primary Provider:",?40,ACDPROV
;F ACD1=0:0 S ACD1=$O(^ACDPD(ACDV,1,ACD1)) Q:'ACD1 S ACDN01=^(ACD1,0) D M1^ACDWPD D:'$O(^ACDPD(ACDV,1,ACD1,"PRV",0)) P2 F ACD2=0:0 S ACD2=$O(^ACDPD(ACDV,1,ACD1,"PRV",ACD2)) Q:'ACD2 I $D(^(ACD2,0)),$P(^(0),U)=ACDGVER D P2 Q
F ACD1=0:0 S ACD1=$O(^ACDPD(ACDV,1,ACD1)) Q:'ACD1 S ACDN01=^(ACD1,0) D Q:$D(DIRUT)
. D M1^ACDWPD
. D:'$O(^ACDPD(ACDV,1,ACD1,"PRV",0)) P2
. Q:$D(DIRUT)
. F ACD2=0:0 S ACD2=$O(^ACDPD(ACDV,1,ACD1,"PRV",ACD2)) Q:'ACD2 I $D(^(ACD2,0)),$P(^(0),U)=ACDGVER D P2 Q
. Q
Q
P2 ;Print day information and secondary providers
D F
Q:$D(DIRUT)
S ACDPNUM=ACDPNUM+1
;I '$D(ACDSUMRP) W !?8,ACDPNUM,")",?14,"Provider(s) credited:",?40,$P(^DIC(16,ACDGVER,0),U)
I '$D(ACDSUMRP) W !?8,ACDPNUM,")",?14,"Provider(s) credited:",?40,$P(^VA(200,ACDGVER,0),U)
I '$D(ACDSUMRP) W !?14,"Day",?40,ACDAY
I '$D(ACDSUMRP) W !?14,"ACTIVITY",?40,ACDPRVA
I '$D(ACDSUMRP) W !?14,"LOCATION",?40,ACDLOTY
I '$D(ACDSUMRP) W !?14,"TARGET",?40,ACDTRG
I '$D(ACDSUMRP) W !?14,"OUTCOME",?40,ACDOUTC
I '$D(ACDSUMRP) W !?14,"NUMBER REACHED",?40,ACDNUMR
I '$D(ACDSUMRP) W !?14,"HOURS ",?40,ACDPCHRS,!
S ACDTHP=ACDTHP+ACDPCHRS
Q
CK ;See if selected provider matches in the prevention as
;the primary or secondary doctor
S ACDOK=0
I ACDPROVP=ACDGVER S ACDOK=1 Q
F ACD1=0:0 S ACD1=$O(^ACDPD(ACDV,1,ACD1)) Q:'ACD1 F ACD2=0:0 S ACD2=$O(^ACDPD(ACDV,1,ACD1,"PRV",ACD2)) Q:'ACD2 I $D(^(ACD2,0)),$P(^(0),U)=ACDGVER S ACDOK=1 Q
Q
F ;Form feed
Q:$D(DIRUT)
I $Y+5>IOSL D F^ACDWUTL D:'$D(DIRUT) H^ACDWSTAF
Q
ACDWSTA1 ;IHS/ADC/EDE/KML - staff report for preventions 10:19;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
P ;$O on prevention date
+1 FOR ACD=ACDFR-.01:0
IF $DATA(DIRUT)
QUIT
SET ACD=$ORDER(^ACDPD("B",ACD))
IF 'ACD!(ACD>ACDTO)
QUIT
FOR ACDV=0:0
IF $DATA(DIRUT)
QUIT
SET ACDV=$ORDER(^ACDPD("B",ACD,ACDV))
IF 'ACDV
QUIT
SET ACDDA=ACDV
DO ^ACDWPD
IF ACD6DIG=ACDAUF
DO P1
IF $DATA(DIRUT)
QUIT
+2 QUIT
P1 ;Check provider / print visit information
+1 DO F
+2 IF $DATA(DIRUT)
QUIT
+3 DO CK
IF 'ACDOK
QUIT
+4 SET ACDVNUM=ACDVNUM+1
SET ACDPNUM=0
+5 IF '$DATA(ACDSUMRP)
WRITE !,ACDVNUM,")",?5,$$DD^ACDFUNC(ACDPDT),?18,$EXTRACT(ACDPG,1,12),?31,"PREVENTION",!!?14,"Primary Provider:",?40,ACDPROV
+6 ;F ACD1=0:0 S ACD1=$O(^ACDPD(ACDV,1,ACD1)) Q:'ACD1 S ACDN01=^(ACD1,0) D M1^ACDWPD D:'$O(^ACDPD(ACDV,1,ACD1,"PRV",0)) P2 F ACD2=0:0 S ACD2=$O(^ACDPD(ACDV,1,ACD1,"PRV",ACD2)) Q:'ACD2 I $D(^(ACD2,0)),$P(^(0),U)=ACDGVER D P2 Q
+7 FOR ACD1=0:0
SET ACD1=$ORDER(^ACDPD(ACDV,1,ACD1))
IF 'ACD1
QUIT
SET ACDN01=^(ACD1,0)
Begin DoDot:1
+8 DO M1^ACDWPD
+9 IF '$ORDER(^ACDPD(ACDV,1,ACD1,"PRV",0))
DO P2
+10 IF $DATA(DIRUT)
QUIT
+11 FOR ACD2=0:0
SET ACD2=$ORDER(^ACDPD(ACDV,1,ACD1,"PRV",ACD2))
IF 'ACD2
QUIT
IF $DATA(^(ACD2,0))
IF $PIECE(^(0),U)=ACDGVER
DO P2
QUIT
+12 QUIT
End DoDot:1
IF $DATA(DIRUT)
QUIT
+13 QUIT
P2 ;Print day information and secondary providers
+1 DO F
+2 IF $DATA(DIRUT)
QUIT
+3 SET ACDPNUM=ACDPNUM+1
+4 ;I '$D(ACDSUMRP) W !?8,ACDPNUM,")",?14,"Provider(s) credited:",?40,$P(^DIC(16,ACDGVER,0),U)
+5 IF '$DATA(ACDSUMRP)
WRITE !?8,ACDPNUM,")",?14,"Provider(s) credited:",?40,$PIECE(^VA(200,ACDGVER,0),U)
+6 IF '$DATA(ACDSUMRP)
WRITE !?14,"Day",?40,ACDAY
+7 IF '$DATA(ACDSUMRP)
WRITE !?14,"ACTIVITY",?40,ACDPRVA
+8 IF '$DATA(ACDSUMRP)
WRITE !?14,"LOCATION",?40,ACDLOTY
+9 IF '$DATA(ACDSUMRP)
WRITE !?14,"TARGET",?40,ACDTRG
+10 IF '$DATA(ACDSUMRP)
WRITE !?14,"OUTCOME",?40,ACDOUTC
+11 IF '$DATA(ACDSUMRP)
WRITE !?14,"NUMBER REACHED",?40,ACDNUMR
+12 IF '$DATA(ACDSUMRP)
WRITE !?14,"HOURS ",?40,ACDPCHRS,!
+13 SET ACDTHP=ACDTHP+ACDPCHRS
+14 QUIT
CK ;See if selected provider matches in the prevention as
+1 ;the primary or secondary doctor
+2 SET ACDOK=0
+3 IF ACDPROVP=ACDGVER
SET ACDOK=1
QUIT
+4 FOR ACD1=0:0
SET ACD1=$ORDER(^ACDPD(ACDV,1,ACD1))
IF 'ACD1
QUIT
FOR ACD2=0:0
SET ACD2=$ORDER(^ACDPD(ACDV,1,ACD1,"PRV",ACD2))
IF 'ACD2
QUIT
IF $DATA(^(ACD2,0))
IF $PIECE(^(0),U)=ACDGVER
SET ACDOK=1
QUIT
+5 QUIT
F ;Form feed
+1 IF $DATA(DIRUT)
QUIT
+2 IF $Y+5>IOSL
DO F^ACDWUTL
IF '$DATA(DIRUT)
DO H^ACDWSTAF
+3 QUIT
