| 1 | QAOSPSS0 ;HISC/DAD-OCCURRENCE SERVICE STATISTICS SORT ;2/16/93 11:41
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | K ^UTILITY($J,"QAOSPSS"),^UTILITY($J,"QAOSXREF"),^UTILITY($J,"QAOQIP")
|
|---|
| 4 | S QAOSCLIN=+$O(^QA(741.2,"C",1,0)),QAOSEXCP=+$O(^QA(741.6,"B",3,0)),QAOSLIST=""
|
|---|
| 5 | F QA=1:1:$L(QAOSLIST(0),",") S QAO=$P(QAOSLIST(0),",",QA),QAOSLIST=QAOSLIST_$S(QAO="1":"^N",QAO=2:"^L",QAO=3:"^1",1:"^")
|
|---|
| 6 | S QAOS=$P(^DD(42,.03,0),"^",3)_"~:~UNKNOWN;" K QAOSSERV F QA=1:1:$L(QAOS,";")-1 S X=$P(QAOS,";",QA),QAOSSERV($P(X,":",2))=$P(X,":",1)
|
|---|
| 7 | S QAOS="",QA=1 F QAOS(0)=0:0 S QAOS=$O(QAOSSERV(QAOS)) Q:QAOS="" S X=QAOSSERV(QAOS),QAOSSERV(X)=QAOS_"^"_QA,QA=QA+1 K QAOSSERV(QAOS)
|
|---|
| 8 | S (QAOSSEQ("L"),QAOSSEQ("N"),QAOSSEQ("1"))=1 F QAOSCRN=0:0 S QAOSCRN=$O(^QA(741.1,"B",QAOSCRN)) Q:QAOSCRN'>0 F QAOSD0=0:0 S QAOSD0=$O(^QA(741.1,"B",QAOSCRN,QAOSD0)) Q:QAOSD0'>0 D LOOP0
|
|---|
| 9 | F QAOSDATE=QAQNBEG-.0000001:0 S QAOSDATE=$O(^QA(741,"C",QAOSDATE)) Q:(QAOSDATE'>0)!(QAOSDATE>(QAQNEND+.9999999)) F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"C",QAOSDATE,QAOSD0)) Q:QAOSD0'>0 D LOOP1
|
|---|
| 10 | Q
|
|---|
| 11 | LOOP0 ;
|
|---|
| 12 | ; ^UTILITY($J,"QAOSXREF",SCREEN#)=SEQUENCE# ^ STATUS
|
|---|
| 13 | S QAOSSCRN=$G(^QA(741.1,QAOSD0,0)),QAOSTYPE=$P(QAOSSCRN,"^",4) Q:QAOSLIST'[("^"_QAOSTYPE_"^")
|
|---|
| 14 | I QAOSSORT="S" S QA="" F QA(0)=0:0 S QA=$O(QAOSSERV(QA)) Q:QA="" S ^UTILITY($J,"QAOSPSS",QAOSTYPE,$P(QAOSSERV(QA),"^"),QAOSSEQ(QAOSTYPE))=+QAOSSCRN_"^0"
|
|---|
| 15 | I QAOSSORT="C" S ^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSEQ(QAOSTYPE))=+QAOSSCRN_"^0^0^0^0^0^0^0^0^0^0^0^0"
|
|---|
| 16 | S ^UTILITY($J,"QAOSXREF",+QAOSSCRN)=QAOSSEQ(QAOSTYPE)_"^"_QAOSTYPE,QAOSSEQ(QAOSTYPE)=QAOSSEQ(QAOSTYPE)+1
|
|---|
| 17 | Q
|
|---|
| 18 | LOOP1 ;
|
|---|
| 19 | S QAOSZERO=$G(^QA(741,QAOSD0,0)) Q:QAOSZERO=""!($P(QAOSZERO,"^",11)=2)
|
|---|
| 20 | S QAOSSCRN=+$G(^QA(741,QAOSD0,"SCRN")) Q:QAOSSCRN'>0 S QAOSSCRN(0)=+$G(^QA(741.1,QAOSSCRN,0)) Q:QAOSSCRN(0)'>0
|
|---|
| 21 | S QAOSD1=+$O(^QA(741,QAOSD0,"REVR","B",QAOSCLIN,0)),QAOSFIND=$P($G(^QA(741,QAOSD0,"REVR",QAOSD1,0)),"^",5) Q:QAOSFIND=QAOSEXCP
|
|---|
| 22 | S QAOS=$G(^UTILITY($J,"QAOSXREF",QAOSSCRN(0))),QAOSSEQ=+QAOS,QAOSTYPE=$P(QAOS,"^",2) Q:QAOSLIST'[("^"_QAOSTYPE_"^")
|
|---|
| 23 | S QAOSHIEN=+$P(QAOSZERO,"^",5)
|
|---|
| 24 | S QAOSHIEN(0)=$G(^SC(QAOSHIEN,0))
|
|---|
| 25 | I $P(QAOSHIEN(0),"^",3)="C" D
|
|---|
| 26 | . S QAOSSERV(0)=$P(QAOSHIEN(0),"^",8)
|
|---|
| 27 | . S:QAOSSERV(0)="N" QAOSSERV(0)="NE"
|
|---|
| 28 | . S:QAOSSERV(0)="0" QAOSSERV(0)="~"
|
|---|
| 29 | . Q
|
|---|
| 30 | E D
|
|---|
| 31 | . S QAOSWIEN=+$G(^SC(QAOSHIEN,42))
|
|---|
| 32 | . S QAOSSERV(0)=$P($G(^DIC(42,QAOSWIEN,0)),"^",3)
|
|---|
| 33 | . Q
|
|---|
| 34 | S:QAOSSERV(0)="" QAOSSERV(0)="~"
|
|---|
| 35 | S QAOSSERV=$S($D(QAOSSERV(QAOSSERV(0)))#2:$P(QAOSSERV(QAOSSERV(0)),"^"),1:"~UNKNOWN")
|
|---|
| 36 | D SERVICE:QAOSSORT="S",CRITERIA:QAOSSORT="C"
|
|---|
| 37 | Q
|
|---|
| 38 | SERVICE ;
|
|---|
| 39 | S QAOSTEMP=^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSERV,QAOSSEQ),$P(QAOSTEMP,"^",2)=$P(QAOSTEMP,"^",2)+1,^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSERV,QAOSSEQ)=QAOSTEMP
|
|---|
| 40 | Q
|
|---|
| 41 | CRITERIA ;
|
|---|
| 42 | S QAOPIECE=$P(QAOSSERV(QAOSSERV(0)),"^",2)+1,QAOSTEMP=^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSEQ),$P(QAOSTEMP,"^",QAOPIECE)=$P(QAOSTEMP,"^",QAOPIECE)+1,^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSEQ)=QAOSTEMP
|
|---|
| 43 | S ^UTILITY($J,"QAOQIP",QAOSTYPE,QAOSSEQ,QAOSSERV(0),QAOSD0)=""
|
|---|
| 44 | Q
|
|---|
