- 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