| [613] | 1 | QAOSPSR0 ;HISC/DAD-OCCURRENCE SCREENS BY SERVICE ;2/12/93 15:26
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | D ^QAQDATE G:QAQQUIT EXIT K %ZIS,IOP
|
|---|
| 4 | K ^UTILITY($J,"P"),^UTILITY($J,"QAOSSCRN"),^UTILITY($J,"QAOSSERV")
|
|---|
| 5 | K QAQDIC S QAQDIC="^DIC(49,",QAQDIC(0)="AEMNQZ",QAQDIC("A")="Select SERVICE: "
|
|---|
| 6 | S QAQUTIL="QAOSSERV" D ^QAQSELCT G:QAQQUIT EXIT
|
|---|
| 7 | K QAQDIC S QAQDIC="^QA(741.1,",QAQDIC(0)="AEMNQZ",QAQDIC("A")="Select SCREEN: "
|
|---|
| 8 | S QAQDIC("B")="ALL",QAQUTIL="QAOSSCRN" D ^QAQSELCT G:QAQQUIT EXIT
|
|---|
| 9 | DEV ;
|
|---|
| 10 | K %ZIS S %ZIS="QM" W ! D ^%ZIS G:POP EXIT
|
|---|
| 11 | I $D(IO("Q")) S ZTRTN="ENTSK^QAOSPSR0",ZTDESC="Occurrences by service",(ZTSAVE("QAO*"),ZTSAVE("QAQ*"),ZTSAVE("^UTILITY($J,"))="" D ^%ZTLOAD G EXIT
|
|---|
| 12 | ENTSK ;
|
|---|
| 13 | S QAOSQUIT=0 F QAOSDATE=QAQNBEG-.0000001:0 S QAOSDATE=$O(^QA(741,"C",QAOSDATE)) Q:(QAOSDATE'>0)!(QAOSDATE>QAQNEND)!(QAOSQUIT) F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"C",QAOSDATE,QAOSD0)) Q:QAOSD0'>0 D LOOP1
|
|---|
| 14 | PRINT ;
|
|---|
| 15 | U IO S SERV="",Y=DT X ^DD("DD") S TODAY=$P(Y,"@"),PAGE=1 K UNDL S $P(UNDL,"-",80)="-",QAOSQUIT=0 I '$D(^UTILITY($J,"P")) D HEAD W !!,"*** NO OCCURRENCES FOUND IN THE SELECTED DATE RANGE ***" G EXIT
|
|---|
| 16 | F SER=0:1 S SERV=$O(^UTILITY($J,"P",SERV)) Q:SERV=""!QAOSQUIT D PAUSE:$E(IOST)="C"&SER Q:QAOSQUIT D HEAD,SUBHEAD,PRT1
|
|---|
| 17 | EXIT ;
|
|---|
| 18 | W ! D ^%ZISC
|
|---|
| 19 | K %ZIS,DATE,LOC,NAM,NAME,PAGE,POP,QAOSD0,QAOSDATE,QAOSQUIT,SCRN,SCRNTXT,SER,SERV,SSN,STAT,TODAY,TXSP,UNDL,X,Y,Z,ZTDESC,ZTRTN,ZTSAVE,%DT,D,I,Y,QAQDIC,QAQUTIL,^UTILITY($J,"P"),^UTILITY($J,"QAOSSCRN"),^UTILITY($J,"QAOSSERV")
|
|---|
| 20 | D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 21 | Q
|
|---|
| 22 | PRT1 ;
|
|---|
| 23 | F SCRN=0:0 S SCRN=$O(^UTILITY($J,"P",SERV,SCRN)) Q:SCRN'>0!QAOSQUIT S NAME="" F NAM=0:0 S NAME=$O(^UTILITY($J,"P",SERV,SCRN,NAME)) Q:NAME=""!QAOSQUIT F DATE=0:0 S DATE=$O(^UTILITY($J,"P",SERV,SCRN,NAME,DATE)) Q:DATE'>0!QAOSQUIT D PRT2
|
|---|
| 24 | Q
|
|---|
| 25 | PRT2 ;
|
|---|
| 26 | S LOC=^UTILITY($J,"P",SERV,SCRN,NAME,DATE),TXSP=$P(LOC,"^"),SCRNTXT=$P(LOC,"^",2),STAT=$P(LOC,"^",3),SSN=$P(LOC,"^",4),Y=DATE\1 X ^DD("DD")
|
|---|
| 27 | W !!,NAME,?32,SSN,?43,Y,?56,STAT,?65,$E(TXSP,1,15),!?1,SCRN,?8,$E(SCRNTXT,1,72)
|
|---|
| 28 | S Z=$O(^UTILITY($J,"P",SERV,SCRN))_$O(^UTILITY($J,"P",SERV,SCRN,NAME))_$O(^UTILITY($J,"P",SERV,SCRN,NAME,DATE))
|
|---|
| 29 | I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE:Z]"" Q:QAOSQUIT D:Z]"" HEAD,SUBHEAD
|
|---|
| 30 | Q
|
|---|
| 31 | LOOP1 ;
|
|---|
| 32 | S LOC=^QA(741,QAOSD0,0),SCRN=+$G(^("SCRN")),SCRNTXT="" S:$D(^QA(741.1,SCRN,0))#2 SCRN=+^(0),SCRNTXT=$P(^(0),"^",2)
|
|---|
| 33 | Q:$D(^UTILITY($J,"QAOSSCRN",SCRN,SCRN))[0
|
|---|
| 34 | S SERV=$P(LOC,"^",6),TXSP=$P(LOC,"^",7),STAT=$P(LOC,"^",11) Q:STAT=2 S STAT=$S(STAT=1:"CLOSED",1:"OPEN")
|
|---|
| 35 | S NAME=+LOC,LOC=$G(^DPT(+LOC,0)),NAME=$S($P(LOC,"^")]"":$P(LOC,"^"),1:NAME),SSN=$P(LOC,"^",9) S:NAME="" NAME=+LOC
|
|---|
| 36 | S SERV(0)=$P($G(^DIC(49,+SERV,0)),"^") Q:SERV(0)=""
|
|---|
| 37 | Q:$D(^UTILITY($J,"QAOSSERV",SERV(0),SERV))[0
|
|---|
| 38 | S:TXSP]"" TXSP=$S($D(^DIC(45.7,TXSP,0))#2:$P(^(0),"^"),1:TXSP)
|
|---|
| 39 | S ^UTILITY($J,"P",SERV(0),SCRN,NAME,QAOSDATE)=TXSP_"^"_SCRNTXT_"^"_STAT_"^"_SSN
|
|---|
| 40 | Q
|
|---|
| 41 | HEAD ;
|
|---|
| 42 | W:(PAGE>1)!($E(IOST)="C") @IOF
|
|---|
| 43 | W !!?29,"OCCURRENCES BY SERVICE",?68,TODAY,!?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE S PAGE=PAGE+1
|
|---|
| 44 | D EN6^QAQAUTL
|
|---|
| 45 | W !,"PATIENT / SCREEN",?32,"SSN",?43,"DATE",?56,"STATUS",?65,"TREATING SPEC.",!,UNDL
|
|---|
| 46 | Q
|
|---|
| 47 | Q
|
|---|
| 48 | SUBHEAD ;
|
|---|
| 49 | W !!," SERVICE: ",SERV
|
|---|
| 50 | Q
|
|---|
| 51 | PAUSE ;
|
|---|
| 52 | K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
|
|---|
| 53 | Q
|
|---|
