QAOSPSS0 ;HISC/DAD-OCCURRENCE SERVICE STATISTICS SORT ;2/16/93  11:41
 ;;3.0;Occurrence Screen;;09/14/1993
 K ^UTILITY($J,"QAOSPSS"),^UTILITY($J,"QAOSXREF"),^UTILITY($J,"QAOQIP")
 S QAOSCLIN=+$O(^QA(741.2,"C",1,0)),QAOSEXCP=+$O(^QA(741.6,"B",3,0)),QAOSLIST=""
 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:"^")
 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)
 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)
 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
 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
 Q
LOOP0 ;
 ; ^UTILITY($J,"QAOSXREF",SCREEN#)=SEQUENCE# ^ STATUS
 S QAOSSCRN=$G(^QA(741.1,QAOSD0,0)),QAOSTYPE=$P(QAOSSCRN,"^",4) Q:QAOSLIST'[("^"_QAOSTYPE_"^")
 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"
 I QAOSSORT="C" S ^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSEQ(QAOSTYPE))=+QAOSSCRN_"^0^0^0^0^0^0^0^0^0^0^0^0"
 S ^UTILITY($J,"QAOSXREF",+QAOSSCRN)=QAOSSEQ(QAOSTYPE)_"^"_QAOSTYPE,QAOSSEQ(QAOSTYPE)=QAOSSEQ(QAOSTYPE)+1
 Q
LOOP1 ;
 S QAOSZERO=$G(^QA(741,QAOSD0,0)) Q:QAOSZERO=""!($P(QAOSZERO,"^",11)=2)
 S QAOSSCRN=+$G(^QA(741,QAOSD0,"SCRN")) Q:QAOSSCRN'>0  S QAOSSCRN(0)=+$G(^QA(741.1,QAOSSCRN,0)) Q:QAOSSCRN(0)'>0
 S QAOSD1=+$O(^QA(741,QAOSD0,"REVR","B",QAOSCLIN,0)),QAOSFIND=$P($G(^QA(741,QAOSD0,"REVR",QAOSD1,0)),"^",5) Q:QAOSFIND=QAOSEXCP
 S QAOS=$G(^UTILITY($J,"QAOSXREF",QAOSSCRN(0))),QAOSSEQ=+QAOS,QAOSTYPE=$P(QAOS,"^",2) Q:QAOSLIST'[("^"_QAOSTYPE_"^")
 S QAOSHIEN=+$P(QAOSZERO,"^",5)
 S QAOSHIEN(0)=$G(^SC(QAOSHIEN,0))
 I $P(QAOSHIEN(0),"^",3)="C" D
 . S QAOSSERV(0)=$P(QAOSHIEN(0),"^",8)
 . S:QAOSSERV(0)="N" QAOSSERV(0)="NE"
 . S:QAOSSERV(0)="0" QAOSSERV(0)="~"
 . Q
 E  D
 . S QAOSWIEN=+$G(^SC(QAOSHIEN,42))
 . S QAOSSERV(0)=$P($G(^DIC(42,QAOSWIEN,0)),"^",3)
 . Q
 S:QAOSSERV(0)="" QAOSSERV(0)="~"
 S QAOSSERV=$S($D(QAOSSERV(QAOSSERV(0)))#2:$P(QAOSSERV(QAOSSERV(0)),"^"),1:"~UNKNOWN")
 D SERVICE:QAOSSORT="S",CRITERIA:QAOSSORT="C"
 Q
SERVICE ;
 S QAOSTEMP=^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSERV,QAOSSEQ),$P(QAOSTEMP,"^",2)=$P(QAOSTEMP,"^",2)+1,^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSERV,QAOSSEQ)=QAOSTEMP
 Q
CRITERIA ;
 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
 S ^UTILITY($J,"QAOQIP",QAOSTYPE,QAOSSEQ,QAOSSERV(0),QAOSD0)=""
 Q