1 | QAOSLAPS ;HISC/JES,DAD-COMPUTE ELAPSED DAYS ;7/26/93 12:20
|
---|
2 | ;;3.0;Occurrence Screen;;09/14/1993
|
---|
3 | ENLAPSE ; ELAPSED DAYS FOR CLINICAL, PEER, AND MANAGEMENT REVIEWS
|
---|
4 | N QAQADICT,QAQAFLD,QAQAXREF
|
---|
5 | S (QAQAX,X1)=X,X2=$P(^QA(741,DA(1),0),"^",3)
|
---|
6 | I X1>0,X2>0 D
|
---|
7 | . D ^%DTC S $P(^QA(741,DA(1),"REVR",DA,0),"^",8)=X
|
---|
8 | . S QAQADICT=741.01,QAQAFLD=8 D ENSET^QAQAXREF
|
---|
9 | . Q
|
---|
10 | S X=QAQAX G EXIT
|
---|
11 | ENLAPSO ; ELAPSED DAYS CALCULATED FROM THE OCCURRENCE DATE XREF
|
---|
12 | S QAQAX=X N QAQADICT,QAQAFLD,QAQAXREF
|
---|
13 | F IEN=0:0 S IEN=$O(^QA(741,DA,"REVR",IEN)) Q:IEN'>0 D O
|
---|
14 | S X=QAQAX G EXIT
|
---|
15 | O S QAQA=^QA(741,DA,"REVR",IEN,0)
|
---|
16 | S X=$P(QAQA,"^",8),QAQADICT=741.01,QAQAFLD=8 D ENKILL^QAQAXREF
|
---|
17 | S $P(^QA(741,DA,"REVR",IEN,0),"^",8)=""
|
---|
18 | S X1=$P(QAQA,"^",3),X2=QAQAX
|
---|
19 | I X1>0,X2>0 D
|
---|
20 | . D ^%DTC S $P(^QA(741,DA,"REVR",IEN,0),"^",8)=X
|
---|
21 | . S QAQADICT=741.01,QAQAFLD=8 D ENSET^QAQAXREF
|
---|
22 | . Q
|
---|
23 | Q
|
---|
24 | ENDUES ; DUE DATES FOR PEER AND MANAGER
|
---|
25 | S QA(0)=$O(^QA(741.2,"C",1,0))
|
---|
26 | Q:QA(0)'=+^QA(741,DA(1),"REVR",DA,0) Q:$D(^QA(740,1,"OS"))[0
|
---|
27 | S QA=X,QA("DA")=DA,DA=DA(1)
|
---|
28 | F QA(0)=1:1:2 S X2=$P(^QA(740,1,"OS"),"^",QA(0)) I X2>0 D
|
---|
29 | . S X1=QA D C^%DTC S X=X\1 S $P(^QA(741,DA,0),"^",11+QA(0))=X
|
---|
30 | . N QAQAXREF,QAQADICT,QAQAFLD
|
---|
31 | . S QAQADICT=741,QAQAFLD=11+QA(0) D ENSET^QAQAXREF
|
---|
32 | . Q
|
---|
33 | S DA=QA("DA")
|
---|
34 | EXIT ;
|
---|
35 | K QA,QACL,QAL,QA1,QAPEER,QAMANG,QASKIP,QASKIM,QAPIECE,QAQAX,X,X1,X2
|
---|
36 | Q
|
---|