source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSLAPS.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1QAOSLAPS ;HISC/JES,DAD-COMPUTE ELAPSED DAYS ;7/26/93 12:20
2 ;;3.0;Occurrence Screen;;09/14/1993
3ENLAPSE ; 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
11ENLAPSO ; 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
15O 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
24ENDUES ; 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")
34EXIT ;
35 K QA,QACL,QAL,QA1,QAPEER,QAMANG,QASKIP,QASKIM,QAPIECE,QAQAX,X,X1,X2
36 Q
Note: See TracBrowser for help on using the repository browser.