Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACDWSTA1

ACDWSTA1.m

Go to the documentation of this file.
  1. ACDWSTA1 ;IHS/ADC/EDE/KML - staff report for preventions 10:19;
  1. ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1. P ;$O on prevention date
  1. 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)
  1. Q
  1. P1 ;Check provider / print visit information
  1. D F
  1. Q:$D(DIRUT)
  1. D CK I 'ACDOK Q
  1. S ACDVNUM=ACDVNUM+1,ACDPNUM=0
  1. I '$D(ACDSUMRP) W !,ACDVNUM,")",?5,$$DD^ACDFUNC(ACDPDT),?18,$E(ACDPG,1,12),?31,"PREVENTION",!!?14,"Primary Provider:",?40,ACDPROV
  1. ;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
  1. F ACD1=0:0 S ACD1=$O(^ACDPD(ACDV,1,ACD1)) Q:'ACD1 S ACDN01=^(ACD1,0) D Q:$D(DIRUT)
  1. . D M1^ACDWPD
  1. . D:'$O(^ACDPD(ACDV,1,ACD1,"PRV",0)) P2
  1. . Q:$D(DIRUT)
  1. . 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
  1. . Q
  1. Q
  1. P2 ;Print day information and secondary providers
  1. D F
  1. Q:$D(DIRUT)
  1. S ACDPNUM=ACDPNUM+1
  1. ;I '$D(ACDSUMRP) W !?8,ACDPNUM,")",?14,"Provider(s) credited:",?40,$P(^DIC(16,ACDGVER,0),U)
  1. I '$D(ACDSUMRP) W !?8,ACDPNUM,")",?14,"Provider(s) credited:",?40,$P(^VA(200,ACDGVER,0),U)
  1. I '$D(ACDSUMRP) W !?14,"Day",?40,ACDAY
  1. I '$D(ACDSUMRP) W !?14,"ACTIVITY",?40,ACDPRVA
  1. I '$D(ACDSUMRP) W !?14,"LOCATION",?40,ACDLOTY
  1. I '$D(ACDSUMRP) W !?14,"TARGET",?40,ACDTRG
  1. I '$D(ACDSUMRP) W !?14,"OUTCOME",?40,ACDOUTC
  1. I '$D(ACDSUMRP) W !?14,"NUMBER REACHED",?40,ACDNUMR
  1. I '$D(ACDSUMRP) W !?14,"HOURS ",?40,ACDPCHRS,!
  1. S ACDTHP=ACDTHP+ACDPCHRS
  1. Q
  1. CK ;See if selected provider matches in the prevention as
  1. ;the primary or secondary doctor
  1. S ACDOK=0
  1. I ACDPROVP=ACDGVER S ACDOK=1 Q
  1. 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
  1. Q
  1. F ;Form feed
  1. Q:$D(DIRUT)
  1. I $Y+5>IOSL D F^ACDWUTL D:'$D(DIRUT) H^ACDWSTAF
  1. Q