- ACDWPD ;IHS/ADC/EDE/KML - SET LOC VARS FROM ACDPD FILE;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- ;**********************************************************************
- ;//^ACDTX10, ^ACDWDRV5
- ;Needs ACDDA as internal DA to file entry
- ;***********************************************************************
- S ACDN0=^ACDPD(ACDDA,0)
- S ACDPDT=$P(ACDN0,U)
- S ACDCOMC=$P(ACDN0,U,2) S:ACDCOMC="" ACDCOMC="NF" S ACDCOMCL=$S($D(^ACDCOMP(ACDCOMC,0)):$P(^(0),U),1:"NF")
- S ACDPG=$P(ACDN0,U,4)
- I $D(^ACDF5PI(ACDPG,0)) S ACDPG=$P(^ACDF5PI(ACDPG,0),U),ACDPG=$P(^AUTTLOC(ACDPG,0),U),ACDAUF=$P(^(0),U,10),ACDPG=$P(^DIC(4,ACDPG,0),U)
- E S ACDPG="NOT DEFINED"
- S (ACDCOMT,ACDP(3))=$P(ACDN0,U,3),ACDP(1)=9002170.7,ACDP(2)=2 S ACDCOMTL=$$SETS^ACDFUNC(.ACDP)
- ;S (ACDPROV,ACDPROVP)=$P(ACDN0,U,5) S:ACDPROV="" ACDPROV="NF" S ACDPROV=$S($D(^DIC(16,ACDPROV,0)):$P(^(0),U),1:"NF")
- S (ACDPROV,ACDPROVP)=$P(ACDN0,U,5) S:ACDPROV="" ACDPROV="NF" S ACDPROV=$S($D(^VA(200,ACDPROV,0)):$P(^(0),U),1:"NF")
- Q:$D(ACDWSTAF(1))
- MATCH ;
- ;***************************************************************
- ;This is the key to building report data or not. We go to ^ACDWASF
- ;and check to see if the record ASUFAC matches one of the arrays
- ;defined by the user's request. If so, ACDONE,ACDTWO,ACDTHREE will
- ;come back defined.
- ;If a match is found, keep counters of how many visit records matched
- ;for the area, su, or facility
- ;***************************************************************
- S ACDOK=0 D ^ACDWASF I $D(ACDONE),$D(ACDTWO),$D(ACDTHREE) S ACDOK=1
- I $D(ACDFAC(ACDAUF)),ACDOK S ACDFAC(ACDAUF)=ACDFAC(ACDAUF)+1 Q
- I $D(ACDAREA($E(ACDAUF,1,2))),ACDOK S ACDAREA($E(ACDAUF,1,2))=ACDAREA($E(ACDAUF,1,2))+1 Q
- I $D(ACDSU($E(ACDAUF,1,4))),ACDOK S ACDSU($E(ACDAUF,1,4))=ACDSU($E(ACDAUF,1,4))+1 Q
- Q
- ;
- M ;EP Multiple // ^ACDWDRV5
- S ACDN01=^ACDPD(ACDDO,1,ACDA1,0)
- M1 ;EP Multiple //^ACDWSTA1
- S ACDAY=$P(ACDN01,U) S:'ACDAY ACDAY=0
- S ACDCOED=$P(ACDN01,U,7)
- S ACDPRVA=$P(ACDN01,U,2) S:ACDPRVA="" ACDPRVA="NF" S ACDPRVA=$S($D(^ACDPREV(9002170.9,ACDPRVA,0)):$P(^(0),U),1:"NF"),ACDPRVC=$S($D(^(0)):$P(^(0),U,2),1:"NF")
- S ACDLOTY=$P(ACDN01,U,3) S:'ACDLOTY ACDLOTY="NF" S ACDLOTY=$S($D(^ACDLOT(ACDLOTY,0)):$P(^(0),U),1:"NF")
- S ACDP(3)=$P(ACDN01,U,4),ACDP(2)=3,ACDP(1)=9002170.75 S ACDTRG=$$SETS^ACDFUNC(.ACDP)
- S ACDNUMR=$P(ACDN01,U,5) S:'ACDNUMR ACDNUMR=0
- S ACDPCHRS=$P(ACDN01,U,8) S:'ACDPCHRS ACDPCHRS=0
- S ACDP(3)=$P(ACDN01,U,6),ACDP(2)=5,ACDP(1)=9002170.75 S ACDOUTC=$$SETS^ACDFUNC(.ACDP)
- ;S ACDSUB(ACDA1)=ACDAY_U_ACDPRVA_U_ACDLOTY_U_ACDTRG_U_ACDNUMR_U_ACDOUTC
- ;
- ACDWPD ;IHS/ADC/EDE/KML - SET LOC VARS FROM ACDPD FILE;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 ;**********************************************************************
- +3 ;//^ACDTX10, ^ACDWDRV5
- +4 ;Needs ACDDA as internal DA to file entry
- +5 ;***********************************************************************
- +6 SET ACDN0=^ACDPD(ACDDA,0)
- +7 SET ACDPDT=$PIECE(ACDN0,U)
- +8 SET ACDCOMC=$PIECE(ACDN0,U,2)
- IF ACDCOMC=""
- SET ACDCOMC="NF"
- SET ACDCOMCL=$SELECT($DATA(^ACDCOMP(ACDCOMC,0)):$PIECE(^(0),U),1:"NF")
- +9 SET ACDPG=$PIECE(ACDN0,U,4)
- +10 IF $DATA(^ACDF5PI(ACDPG,0))
- SET ACDPG=$PIECE(^ACDF5PI(ACDPG,0),U)
- SET ACDPG=$PIECE(^AUTTLOC(ACDPG,0),U)
- SET ACDAUF=$PIECE(^(0),U,10)
- SET ACDPG=$PIECE(^DIC(4,ACDPG,0),U)
- +11 IF '$TEST
- SET ACDPG="NOT DEFINED"
- +12 SET (ACDCOMT,ACDP(3))=$PIECE(ACDN0,U,3)
- SET ACDP(1)=9002170.7
- SET ACDP(2)=2
- SET ACDCOMTL=$$SETS^ACDFUNC(.ACDP)
- +13 ;S (ACDPROV,ACDPROVP)=$P(ACDN0,U,5) S:ACDPROV="" ACDPROV="NF" S ACDPROV=$S($D(^DIC(16,ACDPROV,0)):$P(^(0),U),1:"NF")
- +14 SET (ACDPROV,ACDPROVP)=$PIECE(ACDN0,U,5)
- IF ACDPROV=""
- SET ACDPROV="NF"
- SET ACDPROV=$SELECT($DATA(^VA(200,ACDPROV,0)):$PIECE(^(0),U),1:"NF")
- +15 IF $DATA(ACDWSTAF(1))
- QUIT
- MATCH ;
- +1 ;***************************************************************
- +2 ;This is the key to building report data or not. We go to ^ACDWASF
- +3 ;and check to see if the record ASUFAC matches one of the arrays
- +4 ;defined by the user's request. If so, ACDONE,ACDTWO,ACDTHREE will
- +5 ;come back defined.
- +6 ;If a match is found, keep counters of how many visit records matched
- +7 ;for the area, su, or facility
- +8 ;***************************************************************
- +9 SET ACDOK=0
- DO ^ACDWASF
- IF $DATA(ACDONE)
- IF $DATA(ACDTWO)
- IF $DATA(ACDTHREE)
- SET ACDOK=1
- +10 IF $DATA(ACDFAC(ACDAUF))
- IF ACDOK
- SET ACDFAC(ACDAUF)=ACDFAC(ACDAUF)+1
- QUIT
- +11 IF $DATA(ACDAREA($EXTRACT(ACDAUF,1,2)))
- IF ACDOK
- SET ACDAREA($EXTRACT(ACDAUF,1,2))=ACDAREA($EXTRACT(ACDAUF,1,2))+1
- QUIT
- +12 IF $DATA(ACDSU($EXTRACT(ACDAUF,1,4)))
- IF ACDOK
- SET ACDSU($EXTRACT(ACDAUF,1,4))=ACDSU($EXTRACT(ACDAUF,1,4))+1
- QUIT
- +13 QUIT
- +14 ;
- M ;EP Multiple // ^ACDWDRV5
- +1 SET ACDN01=^ACDPD(ACDDO,1,ACDA1,0)
- M1 ;EP Multiple //^ACDWSTA1
- +1 SET ACDAY=$PIECE(ACDN01,U)
- IF 'ACDAY
- SET ACDAY=0
- +2 SET ACDCOED=$PIECE(ACDN01,U,7)
- +3 SET ACDPRVA=$PIECE(ACDN01,U,2)
- IF ACDPRVA=""
- SET ACDPRVA="NF"
- SET ACDPRVA=$SELECT($DATA(^ACDPREV(9002170.9,ACDPRVA,0)):$PIECE(^(0),U),1:"NF")
- SET ACDPRVC=$SELECT($DATA(^(0)):$PIECE(^(0),U,2),1:"NF")
- +4 SET ACDLOTY=$PIECE(ACDN01,U,3)
- IF 'ACDLOTY
- SET ACDLOTY="NF"
- SET ACDLOTY=$SELECT($DATA(^ACDLOT(ACDLOTY,0)):$PIECE(^(0),U),1:"NF")
- +5 SET ACDP(3)=$PIECE(ACDN01,U,4)
- SET ACDP(2)=3
- SET ACDP(1)=9002170.75
- SET ACDTRG=$$SETS^ACDFUNC(.ACDP)
- +6 SET ACDNUMR=$PIECE(ACDN01,U,5)
- IF 'ACDNUMR
- SET ACDNUMR=0
- +7 SET ACDPCHRS=$PIECE(ACDN01,U,8)
- IF 'ACDPCHRS
- SET ACDPCHRS=0
- +8 SET ACDP(3)=$PIECE(ACDN01,U,6)
- SET ACDP(2)=5
- SET ACDP(1)=9002170.75
- SET ACDOUTC=$$SETS^ACDFUNC(.ACDP)
- +9 ;S ACDSUB(ACDA1)=ACDAY_U_ACDPRVA_U_ACDLOTY_U_ACDTRG_U_ACDNUMR_U_ACDOUTC
- +10 ;
