source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNEVAL.m@ 767

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1SPNEVAL ;;SAN/WDE/GENERATE LAST EVEL,OFFERED & REC
2 ;;2.0;Spinal Cord Dysfunction;**11**;01/02/1997
3 ;This routine will find the last evel offered
4 ;Note that it will look for the latest one not so much
5 ;the last one on file
6 ;-------------------------------------------------------------------
7REC ;GET THE LAST RECEIVED 2ND PIECE
8 S X="",SPNX=""
9 Q:$D(^SPNL(154,D0,"REHAB","B"))=0
10 F S SPNX=$O(^SPNL(154,D0,"REHAB","B",SPNX)) Q:(SPNX="")!('+SPNX) D
11 .S X="",X=$O(^SPNL(154,D0,"REHAB","B",SPNX,X))
12 I '$D(^SPNL(154,D0,"REHAB",X,0)) S X="" Q
13 S X=$P($G(^SPNL(154,D0,"REHAB",X,0)),U,2)
14 K SPNX
15 Q
16NEXT ;GET THE NEXT DUE 3RD PIECE
17 S X="",SPNX=""
18 Q:$D(^SPNL(154,D0,"REHAB","B"))=0
19 F S SPNX=$O(^SPNL(154,D0,"REHAB","B",SPNX)) Q:(SPNX="")!('+SPNX) D
20 .S X="",X=$O(^SPNL(154,D0,"REHAB","B",SPNX,X))
21 I '$D(^SPNL(154,D0,"REHAB",X,0)) S X="" Q
22 S X=$P($G(^SPNL(154,D0,"REHAB",X,0)),U,3)
23 K SPNX
24 Q
25OFFER ;GET THE LAST OFFERED 1ST PIECE
26 S X="",SPNX=""
27 Q:$D(^SPNL(154,D0,"REHAB","B"))=0
28 F S SPNX=$O(^SPNL(154,D0,"REHAB","B",SPNX)) Q:(SPNX="")!('+SPNX) D
29 .S X="",X=$O(^SPNL(154,D0,"REHAB","B",SPNX,X))
30 I '$D(^SPNL(154,D0,"REHAB",X,0)) S X="" Q
31 S X=$P($G(^SPNL(154,D0,"REHAB",X,0)),U,1)
32 K SPNX
33 Q
Note: See TracBrowser for help on using the repository browser.