QAOSPTX0 ;HISC/DAD-TREATING SPECIALTY CARE TYPES REPORT ;9/14/93  15:48
 ;;3.0;Occurrence Screen;;09/14/1993
 K DIR S DIR(0)="SOM^C:Care type;T:Treating specialty;"
 S DIR("A")="Sort by",DIR("B")="Care type"
 S DIR("?",1)="",DIR("?")="     Enter the desired sorting method."
 D ^DIR G:$D(DIRUT) EXIT S QAOSSORT=Y
 K %ZIS,IOP S %ZIS="QM" W ! D ^%ZIS G:POP EXIT
 I $D(IO("Q")) D  G EXIT
 . S ZTRTN="ENTSK^QAOSPTX0",ZTSAVE("QAOSSORT")=""
 . S ZTDESC="Treating specialty care types report"
 . D ^%ZTLOAD
 . Q
ENTSK ;
 K ^TMP($J,"QAOSPTX0") S QAOSTEXT=""
 F  S QAOSTEXT=$O(^DIC(45.7,"B",QAOSTEXT)) Q:QAOSTEXT=""  D
 . F QAOSD0=0:0 S QAOSD0=$O(^DIC(45.7,"B",QAOSTEXT,QAOSD0)) Q:QAOSD0'>0  D
 .. S QAOSTXSP=$P($G(^DIC(45.7,QAOSD0,0)),"^") Q:QAOSTXSP=""
 .. S QAOSS0=+$O(^QA(741.9,"B",QAOSD0,0))
 .. S QAOSTYPE=$P($G(^QA(741.9,QAOSS0,0)),"^",2)
 .. I QAOSTYPE="" S QAOSTYPE="?"
 .. S QAOSTYPE(0)=$P(^DD(741.9,1,0),"^",3)_"?: *** NOT SPECIFIED ***;"
 .. S QAOSTYPE=$P($P(QAOSTYPE(0),QAOSTYPE_":",2),";")
 .. I QAOSSORT="C" S ^TMP($J,"QAOSPTX0",QAOSTYPE,QAOSTXSP)=""
 .. E  S ^TMP($J,"QAOSPTX0",QAOSTXSP,QAOSTYPE)=""
 .. Q
 . Q
PRINT ;
 U IO
 K QAOSUNDL S QAOSQUIT=0,QAOSPAGE=1,$P(QAOSUNDL,"-",81)=""
 S Y=DT X ^DD("DD") S QAOTODAY=Y,QAOSTXT1="" D HEAD
 F  S QAOSTXT1=$O(^TMP($J,"QAOSPTX0",QAOSTXT1)) Q:QAOSTXT1=""!QAOSQUIT  D
 . S QAOSTXT2=""
 . F  S QAOSTXT2=$O(^TMP($J,"QAOSPTX0",QAOSTXT1,QAOSTXT2)) Q:QAOSTXT2=""!QAOSQUIT  D
 .. I QAOSSORT="C" W !,QAOSTXT2,?40,$E(QAOSTXT1,$E(QAOSTXT1)=" "+1,999)
 .. E  W !,QAOSTXT1,?40,$E(QAOSTXT2,$E(QAOSTXT2)=" "+1,999)
 .. I $Y>(IOSL-6) D
 ... I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S QAOSQUIT=$S(Y'>0:1,1:0)
 ... Q:QAOSQUIT
 ... D HEAD
 ... Q
 .. Q
 . Q
EXIT ;
 D ^%ZISC
 K %ZIS,DIR,DIRUT,DTOUT,DUOUT,POP,QAOSD0,QAOSPAGE,QAOSQUIT,QAOSS0
 K QAOSSORT,QAOSTEXT,QAOSTXSP,QAOSTXT1,QAOSTXT2,QAOSTYPE,QAOSUNDL
 K QAOTODAY,Y,ZTDESC,ZTDTH,ZTRTN,^TMP($J,"QAOSPTX0")
 Q
HEAD ;
 W:($E(IOST)="C")!(QAOSPAGE>1) @IOF
 W !!?25,"TREATING SPECIALTY CARE TYPES"
 W ?68,QAOTODAY,!?68,"PAGE: ",QAOSPAGE S QAOSPAGE=QAOSPAGE+1
 W !,"TREATING SPECIALTY",?40,"CARE TYPE"
 W !,QAOSUNDL,!
 Q