45 lines
2.9 KiB
Mathematica
45 lines
2.9 KiB
Mathematica
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
|