source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLIFT2.m@ 1240

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1SDWLIFT2 ;IOFO BAY PINES/OG - INTER-FACILITY TRANSFER: DISPLAY TRANSFER DETAILS ; Compiled March 23, 2005 12:38:06 ; Compiled January 25, 2007 12:35:43
2 ;;5.3;Scheduling;**415,446**;AUG 13 1993;Build 77
3 ;
4 ;
5 ;******************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ; ---- ----- -----------
10 ;
11 ;
12 Q
13EN ; INITIALIZE VARIABLES FOR DISPLAY
14 ; SDWLFMT: which set of data?
15 ; 0 - Active
16 ; 2 - Inactive
17 N SDWLOK,SDWLI
18 K SDWLINFO
19 D GETDATA^SDWLIFT5(.SDWLINFO,SDWLFMT)
20 S SDWLIFTN=$$GETTN^SDWLIFT(.SDWLINFO)
21 I 'SDWLIFTN S VALMBCK="R" Q
22 K SDWLINFO D GETDATA^SDWLIFT5(.SDWLINFO,SDWLFMT)
23 S (SDWLOK,SDWLI)=0 F S SDWLI=$O(SDWLINFO(SDWLI)) Q:'SDWLI I SDWLINFO(SDWLI,1)=SDWLIFTN S SDWLOK=1 Q
24 D:SDWLOK EN^VALM("SDWL TRANSFER REQ VIEW")
25 D INIT^SDWLIFT1(SDWLFMT)
26 S VALMBCK="R"
27 Q
28 ;
29INIT ; Default initialization options.
30 N DIC,D,X,WP,SDWLI,DFN,TMP,SDWLTY,SDWLDA,VADM
31 S SDWLDA=$$GET1^DIQ(409.35,SDWLIFTN,.01,"I")
32 D GETS^DIQ(409.35,SDWLIFTN,"1;3;7",,"TMP")
33 S DFN=$$GET1^DIQ(409.3,SDWLDA,.01,"I")
34 D DEM^VADPT
35 S VALMCNT=1
36 D SET^VALM10(VALMCNT,"Name: "_$E(VADM(1)_SDWLSPS,1,31)_"Status: "_TMP(409.35,SDWLIFTN_",",3))
37 I TMP(409.35,SDWLIFTN_",",7)'="" S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,"Transfer accepted by: "_TMP(409.35,SDWLIFTN_",",7))
38 S VALMCNT=VALMCNT+1
39 D SET^VALM10(VALMCNT,"SSN: "_$E($P(VADM(2),U,2)_SDWLSPS,1,31)_"Date of birth: "_$P(VADM(3),U,2))
40 S VALMCNT=VALMCNT+1
41 D SET^VALM10(VALMCNT,"Wait List Type: "_$$GET1^DIQ(409.3,SDWLDA,4)_" : "_$$GET1^DIQ(409.3,SDWLDA,4+$$GET1^DIQ(409.3,SDWLDA,4,"I")))
42 S VALMCNT=VALMCNT+1
43 D SET^VALM10(VALMCNT,"Transfer to: "_$$GET1^DIQ(4,$$FIND1^DIC(4,"","X",TMP(409.35,SDWLIFTN_",",1),"D"),.01))
44 S VALMCNT=VALMCNT+1
45 D SET^VALM10(VALMCNT,"Comments: ")
46 S X=$$GET1^DIQ(409.35,SDWLIFTN_",",5,"Z","WP")
47 S SDWLI=0 F S SDWLI=$O(WP(SDWLI)) Q:'SDWLI S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,WP(SDWLI,0))
48 Q
49 ;
50HD ; -- Make header line for list processor
51 S X=$$SETSTR^VALM1("User: "_SDWLDZN,"",1,79)
52 S VALMHDR(1)=X,VALMHDR(2)=""
53 Q
54EXIT ; Tidy up
55 K SDWLIFTN
56 K VALMHDR
57 Q
Note: See TracBrowser for help on using the repository browser.