source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLRP3.m@ 1078

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1SDWLRP3 ;;IOFO BAY PINES/TEH - WAITING LIST - RPC 3 ; 20 Aug 2002 2:10 PM
2 ;;5.3;scheduling;**263**;AUG 13 1993
3 ;
4 ;
5 ;******************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ; ---- ----- -----------
10 ; 10/30/2002 Inserted comment for DBIA174
11 ;
12 ;
13 ;
14 ;
15 ;
16 ;
17 ;******************************************************************
18 ;
19 ;
20 ; Internal ID : Description ; Internal ID : Description
21 ;
22 ;
23SDPRIOUT() ;PRIORITY SET OF CODES - Internal ID:Description;Internal ID:Description
24 K ^TMP("SDWLST",$J)
25 D FIELD^DID(409.3,"10",,"POINTER","^TMP(""SDWLPRI"",$J)")
26 Q
27SDREQOUT() ;REQUEST BY SET OF CODES - Internal ID:Description;Internal ID:Description
28 K ^TMP("SDWLST",$J)
29 D FIELD^DID(409.3,"11",,"POINTER","^TMP(""SDWLREQ"",$J)")
30 Q
31SDTYOUT() ;WAIT LIST TYPE - Internal ID:Description;Internal ID:Description
32 K ^TMP("SDWLST",$J)
33 D FIELD^DID(409.3,"4",,"POINTER","^TMP(""SDWLTY"",$J)")
34 Q
35SDDISOUT() ;DISPOSITION
36 K ^TMP("SDWLDIS",$J)
37 D FIELD^DID(409.3,"21",,"POINTER","^TMP(""SDWLDIS"",$J)")
38 Q
39SDSTOUT() ;CURRENT STATUS
40 K ^TMP("SDWLST",$J)
41 D FIELD^DID(409.3,"23",,"POINTER","^TMP(""SDWLST"",$J)")
42 Q
43SDPACOUT() ;PACKAGE
44 K ^TMP("SDWPAC",$J)
45 D FIELD^DID(409.3,"26",,"POINTER","^TMP(""SDWLPAC"",$J)")
46 Q
47SDNEOUT() ;NEW ENROLLEE
48 K ^TMP("SDWLNE",$J)
49 D FIELD^DID(409.3,"27",,"POINTER","^TMP(""SDWLNE"",$J)")
50 Q
51SDSC(SDWLOUT,SDWLDFN) ;-service connected API
52 ;
53 ;
54 ; Input:
55 ; Patients DFN
56 ;
57 ; Output:
58 ; ^TMP("SDWLRP3",$J,0)=Service Connected Disability %
59 ; ^TMP("SDWLRP3",$J,INTERNAL NUMBER)=DISABILITY^%
60 ;
61 ;
62 K ^TMP("SDWLRP3",$J)
63 D ELIG^VADPT,SVC^VADPT
64 I $D(VAEL(3)),$P(VAEL(3),U,2) S SDWLSC=$P(VAEL(3),U,2),^TMP("SDWLRP3",$J,0)=SDWLSC
65 ;
66 ;10/30/2002;DBIA174 - Direct global access to Patient file, Field .3721 -- Rated Disabilties-teh
67 ;
68 I $D(^DPT(SDWLDFN,.372)) S X=0 F S X=$O(^DPT(SDWLDFN,.372,X)) Q:X<1 D
69 .S Y=$G(^DPT(SDWLDFN,.372,X,0)) I $P(Y,U,3) S SDWLX=$P($G(^DIC(31,+Y,0)),U,1),^TMP("SDWLRP3",$J,$P(Y,U,1))=SDWLX_"^"_$P(Y,U,2)
70 I '$D(^TMP("SDWLRP3",$J)) S SDWLOUT=-1 Q
71 K SDWLOUT S SDWLOUT=$NA(^TMP("SDWLRP3",$J))
72 Q
Note: See TracBrowser for help on using the repository browser.