37 lines
1.3 KiB
Mathematica
37 lines
1.3 KiB
Mathematica
QAOSLAPS ;HISC/JES,DAD-COMPUTE ELAPSED DAYS ;7/26/93 12:20
|
|
;;3.0;Occurrence Screen;;09/14/1993
|
|
ENLAPSE ; ELAPSED DAYS FOR CLINICAL, PEER, AND MANAGEMENT REVIEWS
|
|
N QAQADICT,QAQAFLD,QAQAXREF
|
|
S (QAQAX,X1)=X,X2=$P(^QA(741,DA(1),0),"^",3)
|
|
I X1>0,X2>0 D
|
|
. D ^%DTC S $P(^QA(741,DA(1),"REVR",DA,0),"^",8)=X
|
|
. S QAQADICT=741.01,QAQAFLD=8 D ENSET^QAQAXREF
|
|
. Q
|
|
S X=QAQAX G EXIT
|
|
ENLAPSO ; ELAPSED DAYS CALCULATED FROM THE OCCURRENCE DATE XREF
|
|
S QAQAX=X N QAQADICT,QAQAFLD,QAQAXREF
|
|
F IEN=0:0 S IEN=$O(^QA(741,DA,"REVR",IEN)) Q:IEN'>0 D O
|
|
S X=QAQAX G EXIT
|
|
O S QAQA=^QA(741,DA,"REVR",IEN,0)
|
|
S X=$P(QAQA,"^",8),QAQADICT=741.01,QAQAFLD=8 D ENKILL^QAQAXREF
|
|
S $P(^QA(741,DA,"REVR",IEN,0),"^",8)=""
|
|
S X1=$P(QAQA,"^",3),X2=QAQAX
|
|
I X1>0,X2>0 D
|
|
. D ^%DTC S $P(^QA(741,DA,"REVR",IEN,0),"^",8)=X
|
|
. S QAQADICT=741.01,QAQAFLD=8 D ENSET^QAQAXREF
|
|
. Q
|
|
Q
|
|
ENDUES ; DUE DATES FOR PEER AND MANAGER
|
|
S QA(0)=$O(^QA(741.2,"C",1,0))
|
|
Q:QA(0)'=+^QA(741,DA(1),"REVR",DA,0) Q:$D(^QA(740,1,"OS"))[0
|
|
S QA=X,QA("DA")=DA,DA=DA(1)
|
|
F QA(0)=1:1:2 S X2=$P(^QA(740,1,"OS"),"^",QA(0)) I X2>0 D
|
|
. S X1=QA D C^%DTC S X=X\1 S $P(^QA(741,DA,0),"^",11+QA(0))=X
|
|
. N QAQAXREF,QAQADICT,QAQAFLD
|
|
. S QAQADICT=741,QAQAFLD=11+QA(0) D ENSET^QAQAXREF
|
|
. Q
|
|
S DA=QA("DA")
|
|
EXIT ;
|
|
K QA,QACL,QAL,QA1,QAPEER,QAMANG,QASKIP,QASKIM,QAPIECE,QAQAX,X,X1,X2
|
|
Q
|