- ACDWDRV1 ;IHS/ADC/EDE/KML - DRV1 2941117;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- F K ACDQUIT D D I $D(ACDQUIT) D PRHDR^ACD G ^ACDWK
- D ;
- S ACDWDRV(1)=1
- D PRHDR^ACD
- ;S:'$D(ACD27) $P(ACD27,"*",27)="*"
- ;W !,ACD27,!,"* INI/INF/FU/REPORTS *",!,ACD27
- F I=1:1:15 W !,I," ",$P($T(@I),";",3) I I=15 S DIR(0)="L^1:15^S ACDRPTS=Y",DIR("A")="RUN REPORT # " W ! D ^DIR S:X["^"!($D(DTOUT)) ACDQUIT=1 Q:$D(ACDQUIT)
- I $D(ACDQUIT) K ACDWDRV Q
- D ^ACDWRQ I $D(ACDQUIT) K ACDQUIT Q
- D ^ACDWQ ; call to XBDBQUE
- Q
- ;
- L ;EP - FOR TASKMAN
- S ACDNW(1)=ACDTO,ACDNW(2)=ACDFR,ACDNW(3)=ACDLOC,ACDNW(4)=ACDRPTS
- S ACDTO=ACDNW(1),ACDFR=ACDNW(2),ACDLOC=ACDNW(3)
- D ACDV
- Q
- ACDV ;
- K ^TMP("ACD",ACDJOB,ACDBT)
- S ACDDO=0
- F ACD=ACDFR-.01:0 S ACD=$O(^ACDVIS("B",ACD)) Q:'ACD!(ACD>ACDTO) D
- . S ACDV=0 F S ACDV=$O(^ACDVIS("B",ACD,ACDV)) Q:'ACDV D
- .. Q:$P(^ACDVIS(ACDV,0),U,4)="" ; prevent subscript error
- .. Q:'$D(ACDCRST($P(^ACDVIS(ACDV,0),U,4))) ; type not wanted
- .. S ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV)=""
- .. S ACD1=0 F S ACD1=$O(^ACDIIF("C",ACDV,ACD1)) Q:'ACD1 D
- ... S ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1)=""
- ... Q
- .. Q
- . Q
- Q
- ;
- P ;EP - PRINT REPORT
- K DIRUT
- S ACDNW(1)=ACDTO,ACDNW(2)=ACDFR,ACDNW(3)=ACDLOC,ACDNW(4)=ACDRPTS
- F ACDNW(0)=1:1:$L(ACDNW(4),",")-1 S ACDTO=ACDNW(1),ACDFR=ACDNW(2),ACDLOC=ACDNW(3),(ACDTG,ACDTGSUB)=$P(ACDNW(4),",",ACDNW(0)) D P2 Q:$D(DIRUT)
- Q
- ;
- P2 ;
- S ACDV=0
- F S ACDV=$O(^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV)) Q:'ACDV D Q:$D(DIRUT)
- . S ACDDA=ACDV D ^ACDWVIS
- . S ACD1=0
- . F S ACD1=$O(^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1)) Q:'ACD1 D Q:$D(DIRUT)
- .. S ACDDA=ACD1 D ^ACDWIIF
- .. I ACDOK,ACDDFNP D @ACDTG
- .. Q
- . Q
- Q:$D(DIRUT)
- D HED
- Q
- ;
- HED ;
- S ACDH(0)=$P($T(@ACDTG),";",3)_U_ACDLOC,ACDWDRV(1)=1 D HV^ACDWUTL
- U IO D H S ACDTG="G"_ACDTG D @ACDTG
- Q
- H ;EP
- D H^ACDWDRVA
- Q
- 1 ;;COMPONENT CODE-TYPE/ SEX/ HOURS/ AGE RANGE/ UNIQ CLI/ # VIS (NEW V4)
- S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMCL_"/"_ACDCOMT,ACDSEX,ACDOTHRS,ACDAGER,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
- 2 ;;CT'S BY CONTACT TYPE
- S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
- 3 ;;CT'S BY DRUG TYPE
- D C^ACDWUTL
- S ACDDT="" F S ACDDT=$O(ACDDTA(ACDDT)) Q:ACDDT="" D
- .S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDT,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1
- Q
- 4 ;;CT'S BY ACTUAL PLACEMENT
- S ACDCBO=ACDPLAA_"/"_ACDPLAA1
- S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
- 5 ;;CT'S BY RECOMMENDED PLACEMENT
- S ACDCBO=ACDPLAR_"/"_ACDPLAR1
- S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
- 6 ;;CT'S BY PRIMARY PROBLEM
- S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPROBP,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
- 7 ;;CT'S BY OTHER PROBLEM
- D C1^ACDWUTL
- S ACDPT="" F S ACDPT=$O(ACDPTA(ACDPT)) Q:ACDPT="" D
- .S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPT,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1
- Q
- 8 ;;CT'S FOR OTHER PROBLEM WITHIN PRIMARY PROBLEM
- ;D C1^ACDWUTL
- S ACDPT="" F S ACDPT=$O(ACDPTA(ACDPT)) Q:ACDPT="" D
- .S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPROBP,ACDPT,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1
- Q
- 9 ;;CT'S FOR AVE DAYS USED DRUGS WITHIN CONTACT TYPE
- Q:$G(ACDDUD)=999
- S:'ACDDUD ACDDUD=.1 S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUD)) ^(ACDDUD)="" S ^(ACDDUD)=^(ACDDUD)+1
- Q
- 10 ;;CT'S FOR AVE DAYS USED ALCOHOL WITHIN CONTACT TYPE
- Q:$G(ACDDUA)=999
- S:'ACDDUA ACDDUA=.1 S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUA)) ^(ACDDUA)="" S ^(ACDDUA)=^(ACDDUA)+1
- Q
- 11 ;;CT'S FOR DIFFERENCE REASONS WITHIN CONTACT TYPE
- S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDIF,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
- 13 ;;AVE CLIENT STAGE BY COMPONENT
- S ACDADD=0,ACDADD=ACDSUS+ACDPS+ACDES+ACDSS+ACDBS+ACDCS Q:'ACDADD
- S ACDCBO=ACDCOMCL_"/"_ACDCOMT
- S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDADD)) ^(ACDADD)="" S ^(ACDADD)=^(ACDADD)+6 Q
- 14 ;;PLACEMENT DIFFERENCE VOLUME
- S ACDCBO=ACDPLAA_"/"_ACDPLAA1,ACDCOMB=ACDPLAR_"/"_ACDPLAR1
- S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMB,ACDCBO,ACDDIF)) ^(ACDDIF)="" S ^(ACDDIF)=^(ACDDIF)+1 Q
- 12 ;;DRUG TYPE/ AGE RANGE/ SEX/ ARRESTS / UNIQ CLI (NEW V4) (****)
- Q:$G(ACDAAR)=999
- S ACDDT="" F S ACDDT=$O(ACDDTA(ACDDT)) Q:ACDDT="" D
- . S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDT,ACDAGER,ACDSEX,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+ACDAAR Q
- Q
- 15 ;;CT'S BY HOSPITAL DAYS
- Q:$G(ACDDH)=999
- S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+ACDDH Q
- G2 S ACDC(1)=ACDH(9),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
- G3 S ACDC(1)="DRUG TYPE",ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
- G4 S ACDC(1)=ACDH(10),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
- G5 S ACDC(1)=ACDH(11),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
- G6 S ACDC(1)=ACDH(51),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
- G7 S ACDC(1)=ACDH(52),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
- G1 S ACDC(1)=ACDH(54),ACDC(2)=ACDH(53),ACDC(3)="HOURS",ACDC(4)=ACDH(21),ACDC(5)=ACDH(59),ACDC(6)=ACDH(7) D ^ACDWRP91 Q
- G8 S ACDC(1)=ACDH(51),ACDC(2)=ACDH(52),ACDC(3)=ACDH(6),ACDC(4)=ACDH(7),ACDC(5)=ACDH(8) D ^ACDWRP6 Q
- G9 S ACDC(1)=ACDH(9),ACDC(2)=ACDH(12) D ^ACDWRP14 Q
- G10 S ACDC(1)=ACDH(9),ACDC(2)=ACDH(13) D ^ACDWRP14 Q
- G11 S ACDC(1)=ACDH(9),ACDC(2)=ACDH(14),ACDC(3)=ACDH(6),ACDC(4)=ACDH(7),ACDC(5)=ACDH(8) D ^ACDWRP6 Q
- G13 S ACDC(1)=ACDH(55),ACDC(2)=ACDH(56) D ^ACDWRP13 Q
- G14 S ACDC(1)=ACDH(11),ACDC(2)=ACDH(10),ACDC(3)=ACDH(14),ACDC(4)=ACDH(6) D ^ACDWRP15 Q
- G12 S ACDC(1)="DRUG TYPE",ACDC(2)=ACDH(21),ACDC(3)=ACDH(53),ACDC(4)=ACDH(60),ACDC(5)=ACDH(59) D ^ACDWRP99 Q
- G15 S ACDC(1)=ACDH(59),ACDC(2)=ACDH(61),ACDC(3)=ACDH(58) D ^ACDWRP4 Q
- ;
- EOJ ;EP - EOJ FOR XBDBQUE
- K ^TMP("ACD",ACDJOB,ACDBT)
- LOCK -^TMP("ACD",ACDJOB,ACDBT)
- K ACDNW,ACDQ,ACDFAC,ACDAREA,ACDSU,ACDTRB,ACDSTA,ACDCRST
- K ACDAGE,ACDBT,ACDFOLL,ACDH,ACDHRS,ACDJOB,ACDOK,ACDOPT,ACDPLAAL,ACDPLARL,ACDPT,ACDSTAT,ACDTG,ACDTGSUB,ACDVET,ACDWDRV
- Q
- ACDWDRV1 ;IHS/ADC/EDE/KML - DRV1 2941117;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 FOR
- KILL ACDQUIT
- DO D
- IF $DATA(ACDQUIT)
- DO PRHDR^ACD
- GOTO ^ACDWK
- D ;
- +1 SET ACDWDRV(1)=1
- +2 DO PRHDR^ACD
- +3 ;S:'$D(ACD27) $P(ACD27,"*",27)="*"
- +4 ;W !,ACD27,!,"* INI/INF/FU/REPORTS *",!,ACD27
- +5 FOR I=1:1:15
- WRITE !,I," ",$PIECE($TEXT(@I),";",3)
- IF I=15
- SET DIR(0)="L^1:15^S ACDRPTS=Y"
- SET DIR("A")="RUN REPORT # "
- WRITE !
- DO ^DIR
- IF X["^"!($DATA(DTOUT))
- SET ACDQUIT=1
- IF $DATA(ACDQUIT)
- QUIT
- +6 IF $DATA(ACDQUIT)
- KILL ACDWDRV
- QUIT
- +7 DO ^ACDWRQ
- IF $DATA(ACDQUIT)
- KILL ACDQUIT
- QUIT
- +8 ; call to XBDBQUE
- DO ^ACDWQ
- +9 QUIT
- +10 ;
- L ;EP - FOR TASKMAN
- +1 SET ACDNW(1)=ACDTO
- SET ACDNW(2)=ACDFR
- SET ACDNW(3)=ACDLOC
- SET ACDNW(4)=ACDRPTS
- +2 SET ACDTO=ACDNW(1)
- SET ACDFR=ACDNW(2)
- SET ACDLOC=ACDNW(3)
- +3 DO ACDV
- +4 QUIT
- ACDV ;
- +1 KILL ^TMP("ACD",ACDJOB,ACDBT)
- +2 SET ACDDO=0
- +3 FOR ACD=ACDFR-.01:0
- SET ACD=$ORDER(^ACDVIS("B",ACD))
- IF 'ACD!(ACD>ACDTO)
- QUIT
- Begin DoDot:1
- +4 SET ACDV=0
- FOR
- SET ACDV=$ORDER(^ACDVIS("B",ACD,ACDV))
- IF 'ACDV
- QUIT
- Begin DoDot:2
- +5 ; prevent subscript error
- IF $PIECE(^ACDVIS(ACDV,0),U,4)=""
- QUIT
- +6 ; type not wanted
- IF '$DATA(ACDCRST($PIECE(^ACDVIS(ACDV,0),U,4)))
- QUIT
- +7 SET ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV)=""
- +8 SET ACD1=0
- FOR
- SET ACD1=$ORDER(^ACDIIF("C",ACDV,ACD1))
- IF 'ACD1
- QUIT
- Begin DoDot:3
- +9 SET ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1)=""
- +10 QUIT
- End DoDot:3
- +11 QUIT
- End DoDot:2
- +12 QUIT
- End DoDot:1
- +13 QUIT
- +14 ;
- P ;EP - PRINT REPORT
- +1 KILL DIRUT
- +2 SET ACDNW(1)=ACDTO
- SET ACDNW(2)=ACDFR
- SET ACDNW(3)=ACDLOC
- SET ACDNW(4)=ACDRPTS
- +3 FOR ACDNW(0)=1:1:$LENGTH(ACDNW(4),",")-1
- SET ACDTO=ACDNW(1)
- SET ACDFR=ACDNW(2)
- SET ACDLOC=ACDNW(3)
- SET (ACDTG,ACDTGSUB)=$PIECE(ACDNW(4),",",ACDNW(0))
- DO P2
- IF $DATA(DIRUT)
- QUIT
- +4 QUIT
- +5 ;
- P2 ;
- +1 SET ACDV=0
- +2 FOR
- SET ACDV=$ORDER(^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV))
- IF 'ACDV
- QUIT
- Begin DoDot:1
- +3 SET ACDDA=ACDV
- DO ^ACDWVIS
- +4 SET ACD1=0
- +5 FOR
- SET ACD1=$ORDER(^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1))
- IF 'ACD1
- QUIT
- Begin DoDot:2
- +6 SET ACDDA=ACD1
- DO ^ACDWIIF
- +7 IF ACDOK
- IF ACDDFNP
- DO @ACDTG
- +8 QUIT
- End DoDot:2
- IF $DATA(DIRUT)
- QUIT
- +9 QUIT
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +10 IF $DATA(DIRUT)
- QUIT
- +11 DO HED
- +12 QUIT
- +13 ;
- HED ;
- +1 SET ACDH(0)=$PIECE($TEXT(@ACDTG),";",3)_U_ACDLOC
- SET ACDWDRV(1)=1
- DO HV^ACDWUTL
- +2 USE IO
- DO H
- SET ACDTG="G"_ACDTG
- DO @ACDTG
- +3 QUIT
- H ;EP
- +1 DO H^ACDWDRVA
- +2 QUIT
- 1 ;;COMPONENT CODE-TYPE/ SEX/ HOURS/ AGE RANGE/ UNIQ CLI/ # VIS (NEW V4)
- +1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMCL_"/"_ACDCOMT,ACDSEX,ACDOTHRS,ACDAGER,ACDDFNP))
- SET ^(ACDDFNP)=""
- SET ^(ACDDFNP)=^(ACDDFNP)+1
- QUIT
- 2 ;;CT'S BY CONTACT TYPE
- +1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDFNP))
- SET ^(ACDDFNP)=""
- SET ^(ACDDFNP)=^(ACDDFNP)+1
- QUIT
- 3 ;;CT'S BY DRUG TYPE
- +1 DO C^ACDWUTL
- +2 SET ACDDT=""
- FOR
- SET ACDDT=$ORDER(ACDDTA(ACDDT))
- IF ACDDT=""
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDT,ACDDFNP))
- SET ^(ACDDFNP)=""
- SET ^(ACDDFNP)=^(ACDDFNP)+1
- End DoDot:1
- +4 QUIT
- 4 ;;CT'S BY ACTUAL PLACEMENT
- +1 SET ACDCBO=ACDPLAA_"/"_ACDPLAA1
- +2 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDDFNP))
- SET ^(ACDDFNP)=""
- SET ^(ACDDFNP)=^(ACDDFNP)+1
- QUIT
- 5 ;;CT'S BY RECOMMENDED PLACEMENT
- +1 SET ACDCBO=ACDPLAR_"/"_ACDPLAR1
- +2 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDDFNP))
- SET ^(ACDDFNP)=""
- SET ^(ACDDFNP)=^(ACDDFNP)+1
- QUIT
- 6 ;;CT'S BY PRIMARY PROBLEM
- +1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPROBP,ACDDFNP))
- SET ^(ACDDFNP)=""
- SET ^(ACDDFNP)=^(ACDDFNP)+1
- QUIT
- 7 ;;CT'S BY OTHER PROBLEM
- +1 DO C1^ACDWUTL
- +2 SET ACDPT=""
- FOR
- SET ACDPT=$ORDER(ACDPTA(ACDPT))
- IF ACDPT=""
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPT,ACDDFNP))
- SET ^(ACDDFNP)=""
- SET ^(ACDDFNP)=^(ACDDFNP)+1
- End DoDot:1
- +4 QUIT
- 8 ;;CT'S FOR OTHER PROBLEM WITHIN PRIMARY PROBLEM
- +1 ;D C1^ACDWUTL
- +2 SET ACDPT=""
- FOR
- SET ACDPT=$ORDER(ACDPTA(ACDPT))
- IF ACDPT=""
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPROBP,ACDPT,ACDDFNP))
- SET ^(ACDDFNP)=""
- SET ^(ACDDFNP)=^(ACDDFNP)+1
- End DoDot:1
- +4 QUIT
- 9 ;;CT'S FOR AVE DAYS USED DRUGS WITHIN CONTACT TYPE
- +1 IF $GET(ACDDUD)=999
- QUIT
- +2 IF 'ACDDUD
- SET ACDDUD=.1
- IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUD))
- SET ^(ACDDUD)=""
- SET ^(ACDDUD)=^(ACDDUD)+1
- +3 QUIT
- 10 ;;CT'S FOR AVE DAYS USED ALCOHOL WITHIN CONTACT TYPE
- +1 IF $GET(ACDDUA)=999
- QUIT
- +2 IF 'ACDDUA
- SET ACDDUA=.1
- IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUA))
- SET ^(ACDDUA)=""
- SET ^(ACDDUA)=^(ACDDUA)+1
- +3 QUIT
- 11 ;;CT'S FOR DIFFERENCE REASONS WITHIN CONTACT TYPE
- +1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDIF,ACDDFNP))
- SET ^(ACDDFNP)=""
- SET ^(ACDDFNP)=^(ACDDFNP)+1
- QUIT
- 13 ;;AVE CLIENT STAGE BY COMPONENT
- +1 SET ACDADD=0
- SET ACDADD=ACDSUS+ACDPS+ACDES+ACDSS+ACDBS+ACDCS
- IF 'ACDADD
- QUIT
- +2 SET ACDCBO=ACDCOMCL_"/"_ACDCOMT
- +3 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDADD))
- SET ^(ACDADD)=""
- SET ^(ACDADD)=^(ACDADD)+6
- QUIT
- 14 ;;PLACEMENT DIFFERENCE VOLUME
- +1 SET ACDCBO=ACDPLAA_"/"_ACDPLAA1
- SET ACDCOMB=ACDPLAR_"/"_ACDPLAR1
- +2 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMB,ACDCBO,ACDDIF))
- SET ^(ACDDIF)=""
- SET ^(ACDDIF)=^(ACDDIF)+1
- QUIT
- 12 ;;DRUG TYPE/ AGE RANGE/ SEX/ ARRESTS / UNIQ CLI (NEW V4) (****)
- +1 IF $GET(ACDAAR)=999
- QUIT
- +2 SET ACDDT=""
- FOR
- SET ACDDT=$ORDER(ACDDTA(ACDDT))
- IF ACDDT=""
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDT,ACDAGER,ACDSEX,ACDDFNP))
- SET ^(ACDDFNP)=""
- SET ^(ACDDFNP)=^(ACDDFNP)+ACDAAR
- QUIT
- End DoDot:1
- +4 QUIT
- 15 ;;CT'S BY HOSPITAL DAYS
- +1 IF $GET(ACDDH)=999
- QUIT
- +2 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDFNP))
- SET ^(ACDDFNP)=""
- SET ^(ACDDFNP)=^(ACDDFNP)+ACDDH
- QUIT
- G2 SET ACDC(1)=ACDH(9)
- SET ACDC(2)=ACDH(6)
- SET ACDC(3)=ACDH(7)
- SET ACDC(4)=ACDH(8)
- DO ^ACDWRP5
- QUIT
- G3 SET ACDC(1)="DRUG TYPE"
- SET ACDC(2)=ACDH(6)
- SET ACDC(3)=ACDH(7)
- SET ACDC(4)=ACDH(8)
- DO ^ACDWRP5
- QUIT
- G4 SET ACDC(1)=ACDH(10)
- SET ACDC(2)=ACDH(6)
- SET ACDC(3)=ACDH(7)
- SET ACDC(4)=ACDH(8)
- DO ^ACDWRP5
- QUIT
- G5 SET ACDC(1)=ACDH(11)
- SET ACDC(2)=ACDH(6)
- SET ACDC(3)=ACDH(7)
- SET ACDC(4)=ACDH(8)
- DO ^ACDWRP5
- QUIT
- G6 SET ACDC(1)=ACDH(51)
- SET ACDC(2)=ACDH(6)
- SET ACDC(3)=ACDH(7)
- SET ACDC(4)=ACDH(8)
- DO ^ACDWRP5
- QUIT
- G7 SET ACDC(1)=ACDH(52)
- SET ACDC(2)=ACDH(6)
- SET ACDC(3)=ACDH(7)
- SET ACDC(4)=ACDH(8)
- DO ^ACDWRP5
- QUIT
- G1 SET ACDC(1)=ACDH(54)
- SET ACDC(2)=ACDH(53)
- SET ACDC(3)="HOURS"
- SET ACDC(4)=ACDH(21)
- SET ACDC(5)=ACDH(59)
- SET ACDC(6)=ACDH(7)
- DO ^ACDWRP91
- QUIT
- G8 SET ACDC(1)=ACDH(51)
- SET ACDC(2)=ACDH(52)
- SET ACDC(3)=ACDH(6)
- SET ACDC(4)=ACDH(7)
- SET ACDC(5)=ACDH(8)
- DO ^ACDWRP6
- QUIT
- G9 SET ACDC(1)=ACDH(9)
- SET ACDC(2)=ACDH(12)
- DO ^ACDWRP14
- QUIT
- G10 SET ACDC(1)=ACDH(9)
- SET ACDC(2)=ACDH(13)
- DO ^ACDWRP14
- QUIT
- G11 SET ACDC(1)=ACDH(9)
- SET ACDC(2)=ACDH(14)
- SET ACDC(3)=ACDH(6)
- SET ACDC(4)=ACDH(7)
- SET ACDC(5)=ACDH(8)
- DO ^ACDWRP6
- QUIT
- G13 SET ACDC(1)=ACDH(55)
- SET ACDC(2)=ACDH(56)
- DO ^ACDWRP13
- QUIT
- G14 SET ACDC(1)=ACDH(11)
- SET ACDC(2)=ACDH(10)
- SET ACDC(3)=ACDH(14)
- SET ACDC(4)=ACDH(6)
- DO ^ACDWRP15
- QUIT
- G12 SET ACDC(1)="DRUG TYPE"
- SET ACDC(2)=ACDH(21)
- SET ACDC(3)=ACDH(53)
- SET ACDC(4)=ACDH(60)
- SET ACDC(5)=ACDH(59)
- DO ^ACDWRP99
- QUIT
- G15 SET ACDC(1)=ACDH(59)
- SET ACDC(2)=ACDH(61)
- SET ACDC(3)=ACDH(58)
- DO ^ACDWRP4
- QUIT
- +1 ;
- EOJ ;EP - EOJ FOR XBDBQUE
- +1 KILL ^TMP("ACD",ACDJOB,ACDBT)
- +2 LOCK -^TMP("ACD",ACDJOB,ACDBT)
- +3 KILL ACDNW,ACDQ,ACDFAC,ACDAREA,ACDSU,ACDTRB,ACDSTA,ACDCRST
- +4 KILL ACDAGE,ACDBT,ACDFOLL,ACDH,ACDHRS,ACDJOB,ACDOK,ACDOPT,ACDPLAAL,ACDPLARL,ACDPT,ACDSTAT,ACDTG,ACDTGSUB,ACDVET,ACDWDRV
- +5 QUIT
