| 1 | QAOSPTX0 ;HISC/DAD-TREATING SPECIALTY CARE TYPES REPORT ;9/14/93 15:48
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | K DIR S DIR(0)="SOM^C:Care type;T:Treating specialty;"
|
|---|
| 4 | S DIR("A")="Sort by",DIR("B")="Care type"
|
|---|
| 5 | S DIR("?",1)="",DIR("?")=" Enter the desired sorting method."
|
|---|
| 6 | D ^DIR G:$D(DIRUT) EXIT S QAOSSORT=Y
|
|---|
| 7 | K %ZIS,IOP S %ZIS="QM" W ! D ^%ZIS G:POP EXIT
|
|---|
| 8 | I $D(IO("Q")) D G EXIT
|
|---|
| 9 | . S ZTRTN="ENTSK^QAOSPTX0",ZTSAVE("QAOSSORT")=""
|
|---|
| 10 | . S ZTDESC="Treating specialty care types report"
|
|---|
| 11 | . D ^%ZTLOAD
|
|---|
| 12 | . Q
|
|---|
| 13 | ENTSK ;
|
|---|
| 14 | K ^TMP($J,"QAOSPTX0") S QAOSTEXT=""
|
|---|
| 15 | F S QAOSTEXT=$O(^DIC(45.7,"B",QAOSTEXT)) Q:QAOSTEXT="" D
|
|---|
| 16 | . F QAOSD0=0:0 S QAOSD0=$O(^DIC(45.7,"B",QAOSTEXT,QAOSD0)) Q:QAOSD0'>0 D
|
|---|
| 17 | .. S QAOSTXSP=$P($G(^DIC(45.7,QAOSD0,0)),"^") Q:QAOSTXSP=""
|
|---|
| 18 | .. S QAOSS0=+$O(^QA(741.9,"B",QAOSD0,0))
|
|---|
| 19 | .. S QAOSTYPE=$P($G(^QA(741.9,QAOSS0,0)),"^",2)
|
|---|
| 20 | .. I QAOSTYPE="" S QAOSTYPE="?"
|
|---|
| 21 | .. S QAOSTYPE(0)=$P(^DD(741.9,1,0),"^",3)_"?: *** NOT SPECIFIED ***;"
|
|---|
| 22 | .. S QAOSTYPE=$P($P(QAOSTYPE(0),QAOSTYPE_":",2),";")
|
|---|
| 23 | .. I QAOSSORT="C" S ^TMP($J,"QAOSPTX0",QAOSTYPE,QAOSTXSP)=""
|
|---|
| 24 | .. E S ^TMP($J,"QAOSPTX0",QAOSTXSP,QAOSTYPE)=""
|
|---|
| 25 | .. Q
|
|---|
| 26 | . Q
|
|---|
| 27 | PRINT ;
|
|---|
| 28 | U IO
|
|---|
| 29 | K QAOSUNDL S QAOSQUIT=0,QAOSPAGE=1,$P(QAOSUNDL,"-",81)=""
|
|---|
| 30 | S Y=DT X ^DD("DD") S QAOTODAY=Y,QAOSTXT1="" D HEAD
|
|---|
| 31 | F S QAOSTXT1=$O(^TMP($J,"QAOSPTX0",QAOSTXT1)) Q:QAOSTXT1=""!QAOSQUIT D
|
|---|
| 32 | . S QAOSTXT2=""
|
|---|
| 33 | . F S QAOSTXT2=$O(^TMP($J,"QAOSPTX0",QAOSTXT1,QAOSTXT2)) Q:QAOSTXT2=""!QAOSQUIT D
|
|---|
| 34 | .. I QAOSSORT="C" W !,QAOSTXT2,?40,$E(QAOSTXT1,$E(QAOSTXT1)=" "+1,999)
|
|---|
| 35 | .. E W !,QAOSTXT1,?40,$E(QAOSTXT2,$E(QAOSTXT2)=" "+1,999)
|
|---|
| 36 | .. I $Y>(IOSL-6) D
|
|---|
| 37 | ... I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S QAOSQUIT=$S(Y'>0:1,1:0)
|
|---|
| 38 | ... Q:QAOSQUIT
|
|---|
| 39 | ... D HEAD
|
|---|
| 40 | ... Q
|
|---|
| 41 | .. Q
|
|---|
| 42 | . Q
|
|---|
| 43 | EXIT ;
|
|---|
| 44 | D ^%ZISC
|
|---|
| 45 | K %ZIS,DIR,DIRUT,DTOUT,DUOUT,POP,QAOSD0,QAOSPAGE,QAOSQUIT,QAOSS0
|
|---|
| 46 | K QAOSSORT,QAOSTEXT,QAOSTXSP,QAOSTXT1,QAOSTXT2,QAOSTYPE,QAOSUNDL
|
|---|
| 47 | K QAOTODAY,Y,ZTDESC,ZTDTH,ZTRTN,^TMP($J,"QAOSPTX0")
|
|---|
| 48 | Q
|
|---|
| 49 | HEAD ;
|
|---|
| 50 | W:($E(IOST)="C")!(QAOSPAGE>1) @IOF
|
|---|
| 51 | W !!?25,"TREATING SPECIALTY CARE TYPES"
|
|---|
| 52 | W ?68,QAOTODAY,!?68,"PAGE: ",QAOSPAGE S QAOSPAGE=QAOSPAGE+1
|
|---|
| 53 | W !,"TREATING SPECIALTY",?40,"CARE TYPE"
|
|---|
| 54 | W !,QAOSUNDL,!
|
|---|
| 55 | Q
|
|---|
