- ACDWCD60 ; IHS/ADC/EDE/KML - CLIENT DET OUTP FOR CRISIS BRIEF 10:11 NOV 17,1993 ;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- ;*********************************************************************
- ;//^ACDWDRV3, ^ACDWIIF
- ;*********************************************************************
- ;S ACDP1="" F S ACDP1=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1)) Q:ACDP1="" F ACDP2=0:0 S ACDP2=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2)) Q:'ACDP2 S ACDDA=ACDP2 D ^ACDWIIF S ACDDA=^ACDIIF(ACDP2,"BWP") D ^ACDWVIS D P1
- S ACDP1=""
- F S ACDP1=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1)) Q:ACDP1="" D Q:$D(DIRUT)
- . F ACDP2=0:0 S ACDP2=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2)) Q:'ACDP2 D Q:$D(DIRUT)
- .. S ACDDA=ACDP2 D ^ACDWIIF S ACDDA=^ACDIIF(ACDP2,"BWP") D ^ACDWVIS D P1
- .. Q
- . Q
- D ^ACDWK Q
- P1 ;Output
- D F W !!,"VISIT DATE:",?40,ACDCLIV
- D F W !,"COMPONENT:",?40,ACDCOMCL," / ",ACDCOMTL
- D F W !!,"PROVIDER:",?40,ACDPROV
- D F W !,"PRIMARY PROBLEM:",?40,ACDPROBP
- D F W !,"OTHER PROBLEMS:" S ACDLP="" F D F S ACDLP=$O(ACDPTA(ACDLP)) Q:ACDLP="" W ?40,ACDLP,!
- D F W !,"HOURS FOR 'OT' : ",?40,ACDOTHRS
- D F W !,"DISPOSITION FOR 'OT': ",?40,ACDOTDIS
- W !!,"..........................................",!
- ;
- Q
- F ;Form feed
- Q:$D(DIRUT)
- I $Y+4>IOSL D F^ACDWUTL
- ACDWCD60 ; IHS/ADC/EDE/KML - CLIENT DET OUTP FOR CRISIS BRIEF 10:11 NOV 17,1993 ;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 ;*********************************************************************
- +3 ;//^ACDWDRV3, ^ACDWIIF
- +4 ;*********************************************************************
- +5 ;S ACDP1="" F S ACDP1=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1)) Q:ACDP1="" F ACDP2=0:0 S ACDP2=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2)) Q:'ACDP2 S ACDDA=ACDP2 D ^ACDWIIF S ACDDA=^ACDIIF(ACDP2,"BWP") D ^ACDWVIS D P1
- +6 SET ACDP1=""
- +7 FOR
- SET ACDP1=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1))
- IF ACDP1=""
- QUIT
- Begin DoDot:1
- +8 FOR ACDP2=0:0
- SET ACDP2=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2))
- IF 'ACDP2
- QUIT
- Begin DoDot:2
- +9 SET ACDDA=ACDP2
- DO ^ACDWIIF
- SET ACDDA=^ACDIIF(ACDP2,"BWP")
- DO ^ACDWVIS
- DO P1
- +10 QUIT
- End DoDot:2
- IF $DATA(DIRUT)
- QUIT
- +11 QUIT
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +12 DO ^ACDWK
- QUIT
- P1 ;Output
- +1 DO F
- WRITE !!,"VISIT DATE:",?40,ACDCLIV
- +2 DO F
- WRITE !,"COMPONENT:",?40,ACDCOMCL," / ",ACDCOMTL
- +3 DO F
- WRITE !!,"PROVIDER:",?40,ACDPROV
- +4 DO F
- WRITE !,"PRIMARY PROBLEM:",?40,ACDPROBP
- +5 DO F
- WRITE !,"OTHER PROBLEMS:"
- SET ACDLP=""
- FOR
- DO F
- SET ACDLP=$ORDER(ACDPTA(ACDLP))
- IF ACDLP=""
- QUIT
- WRITE ?40,ACDLP,!
- +6 DO F
- WRITE !,"HOURS FOR 'OT' : ",?40,ACDOTHRS
- +7 DO F
- WRITE !,"DISPOSITION FOR 'OT': ",?40,ACDOTDIS
- +8 WRITE !!,"..........................................",!
- +9 ;
- +10 QUIT
- F ;Form feed
- +1 IF $DATA(DIRUT)
- QUIT
- +2 IF $Y+4>IOSL
- DO F^ACDWUTL
