source: FOIAVistA/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSPNAM.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1QAOSPNAM ;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
13ENTSK ;
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
37EXIT ;
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
44SET(SUBSCRPT,DATA,PIECE) ;
45 S $P(^TMP($J,"QAOSPNAM",SUBSCRPT),"^")=DATA
46 S $P(^TMP($J,"QAOSPNAM",SUBSCRPT),"^",PIECE)="X"
47 Q
48PAUSE ;
49 K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
50 Q
51HEAD ;
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
Note: See TracBrowser for help on using the repository browser.