| 1 | QAOSPNAM ;HISC/DAD-ATTENDING & RESIDENT/PROVIDER REPORT ;6/17/93 11:13
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | K DIR S DIR(0)="SOM^C:Code;N:Name",DIR("A")="Sort report by"
|
|---|
| 4 | S DIR("?",1)="",DIR("?")=" Enter the desired sorting method."
|
|---|
| 5 | S DIR("B")="Name"
|
|---|
| 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^QAOSPNAM",ZTSAVE("QAOSSORT")=""
|
|---|
| 10 | . S ZTDESC="Attending & resident/provider report"
|
|---|
| 11 | . D ^%ZTLOAD
|
|---|
| 12 | . Q
|
|---|
| 13 | ENTSK ;
|
|---|
| 14 | S PAGE=1,%DT="",X="T" D ^%DT X ^DD("DD") S TODAY=Y
|
|---|
| 15 | K ^TMP($J,"QAOSPNAM"),UNDL S $P(UNDL,"-",80)="-"
|
|---|
| 16 | F QAOSD0=0:0 S QAOSD0=$O(^QA(741,QAOSD0)) Q:QAOSD0'>0 D
|
|---|
| 17 | . S QAOSZERO=$G(^QA(741,QAOSD0,0)) Q:QAOSZERO=""
|
|---|
| 18 | . F QA=9,10 D
|
|---|
| 19 | .. S QAOSCODE=+$P(QAOSZERO,"^",QA) Q:QAOSCODE'>0
|
|---|
| 20 | .. S QAOSNAME=$P($G(^VA(200,QAOSCODE,0)),"^")
|
|---|
| 21 | .. S:QAOSNAME="" QAOSNAME=QAOSCODE
|
|---|
| 22 | .. I QAOSSORT="N" D SET(QAOSNAME,QAOSCODE,QA-7)
|
|---|
| 23 | .. E D SET(QAOSCODE,QAOSNAME,QA-7)
|
|---|
| 24 | .. Q
|
|---|
| 25 | . Q
|
|---|
| 26 | U IO D HEAD
|
|---|
| 27 | I '$D(^TMP($J,"QAOSPNAM")) W !!,"NO DATA FOUND FOR THIS REPORT" G EXIT
|
|---|
| 28 | S QAOSSUB="",QAOSQUIT=0
|
|---|
| 29 | F S QAOSSUB=$O(^TMP($J,"QAOSPNAM",QAOSSUB)) Q:QAOSSUB=""!QAOSQUIT D
|
|---|
| 30 | . S QAOSDATA=^TMP($J,"QAOSPNAM",QAOSSUB)
|
|---|
| 31 | . I QAOSSORT="N" S QAOSNAME=QAOSSUB,QAOSCODE=$P(QAOSDATA,"^")
|
|---|
| 32 | . E S QAOSNAME=$P(QAOSDATA,"^"),QAOSCODE=QAOSSUB
|
|---|
| 33 | . W !,QAOSNAME,?35,$J(QAOSCODE,9)
|
|---|
| 34 | . W ?53,$P(QAOSDATA,"^",2),?71,$P(QAOSDATA,"^",3)
|
|---|
| 35 | . I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAOSQUIT D HEAD
|
|---|
| 36 | . Q
|
|---|
| 37 | EXIT ;
|
|---|
| 38 | W ! D ^%ZISC
|
|---|
| 39 | K %DT,%ZIS,DIR,DIRUT,DTOUT,DUOUT,PAGE,POP,QA,QAOSD0,QAOSDATA,QAOSCODE
|
|---|
| 40 | K QAOSNAME,QAOSQUIT,QAOSSUB,QAOSZERO,TODAY,UNDL,X,Y,ZTRTN,ZTDESC
|
|---|
| 41 | K QAOSSORT,^TMP($J,"QAOSPNAM")
|
|---|
| 42 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 43 | Q
|
|---|
| 44 | SET(SUBSCRPT,DATA,PIECE) ;
|
|---|
| 45 | S $P(^TMP($J,"QAOSPNAM",SUBSCRPT),"^")=DATA
|
|---|
| 46 | S $P(^TMP($J,"QAOSPNAM",SUBSCRPT),"^",PIECE)="X"
|
|---|
| 47 | Q
|
|---|
| 48 | PAUSE ;
|
|---|
| 49 | K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
|
|---|
| 50 | Q
|
|---|
| 51 | HEAD ;
|
|---|
| 52 | W:(PAGE>1)!($E(IOST)="C") @IOF
|
|---|
| 53 | W !!?29,"PRACTITIONER CODE LIST",?68,TODAY,!?68,"PAGE: ",PAGE
|
|---|
| 54 | S PAGE=PAGE+1 D EN6^QAQAUTL
|
|---|
| 55 | W !,"PRACTITIONER",?35,"CODE NUMBER",?49,"ATTENDING",?63,"RESIDENT/PROVIDER"
|
|---|
| 56 | W !,UNDL,!
|
|---|
| 57 | Q
|
|---|
