source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLIFT1.m@ 1578

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1SDWLIFT1 ;IOFO BAY PINES/OG - INTER-FACILITY TRANSFER: REQUEST SUMMARY ; Compiled March 29, 2005 15:36:25
2 ;;5.3;Scheduling;**415**;AUG 13 1993
3 ;
4 ;
5 ;******************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ; ---- ----- -----------
10 ;
11 ;
12 Q
13EN ; INITIALIZE VARIABLES
14 K ^TMP("SDWLIFT",$J)
15 K DIR,DIC,DR,DIE,VADM
16 S SDWLFMT=0
17 D EN^VALM("SDWL TRANSFER REQ MAIN")
18 Q
19ENI ; INITIALIZE VARIABLES - Inactive entries
20 N SDWLFMT
21 K ^TMP("SDWLIFT",$J,"EP")
22 K DIR,DIC,DR,DIE,VADM
23 S SDWLFMT=2
24 D EN^VALM("SDWL TRANSFER REQ INAC"),INIT(0)
25 S VALMBCK="R"
26 Q
27INIT(SDWLOPT) ; Default initialization options.
28 K ^TMP("DILIST",$J),^TMP("SDWLIFT",$J)
29 N SDWLINFO,SDWLI,DISPCNT
30 I '$D(DUZ) W !,"DUZ required for this option" D PAUSE^VALM1 Q
31 S SDWLDZN=$P(^VA(200,DUZ,0),U)
32 S SDWLSPS=$J("",30)
33 D GETDATA^SDWLIFT5(.SDWLINFO,SDWLOPT)
34 S VALMCNT=0
35 F DISPCNT=1:1:SDWLINFO(0) D
36 .N SDWLOUT
37 .S VALMCNT=VALMCNT+1
38 .; Display count
39 .S SDWLOUT=$E(DISPCNT_SDWLSPS,1,3)
40 .; Name
41 .S SDWLOUT=SDWLOUT_$E($P(SDWLINFO(DISPCNT,0),U)_SDWLSPS,1,27)_" "
42 .; SSN
43 .S SDWLOUT=SDWLOUT_$E($P(SDWLINFO(DISPCNT,0),U,2)_SDWLSPS,1,12)_" "
44 .; Destination Institution
45 .S SDWLOUT=SDWLOUT_$E($P(SDWLINFO(DISPCNT,0),U,3)_SDWLSPS,1,20)_" "
46 .; Transfer Status
47 .S SDWLOUT=SDWLOUT_$P(SDWLINFO(DISPCNT,0),U,4)
48 .D SET^VALM10(VALMCNT,SDWLOUT)
49 .; Line 2
50 .S VALMCNT=VALMCNT+1
51 .; Current Wait List Institution
52 .S SDWLOUT=$E($P(SDWLINFO(DISPCNT,0),U,5)_SDWLSPS,1,30)_" "
53 .; Current Wait List Type
54 .S SDWLOUT=SDWLOUT_$P(SDWLINFO(DISPCNT,0),U,6)_" : "
55 .; Current Wait List Type Extension
56 .S SDWLOUT=SDWLOUT_$P(SDWLINFO(DISPCNT,0),U,7)
57 .D SET^VALM10(VALMCNT,SDWLOUT)
58 .Q
59 I 'VALMCNT S VALMCNT=1 D SET^VALM10(VALMCNT," ** No "_$S(SDWLOPT=2:"in",1:"")_"active transfer details to display... ")
60 Q
61HD ; -- Make header line for list processor
62 N X
63 S X=$$SETSTR^VALM1("User: "_SDWLDZN,"",1,79)
64 S VALMHDR(1)=X,VALMHDR(2)=""
65 Q
66EXIT ; Tidy up
67 K VALMBCK,VALMHDR,VALMCNT
68 K SDWLDZN,SDWLSPS,SDWLINFO,SDWLOPT,SDWLFMT
69 K ^TMP("DILIST",$J),^TMP("SDWLIFT",$J)
70 Q
71GETTRN(SDWLDA,SDWLINNM,SDWLSTN) ; Get transfer details for Electronic Wait List internal entry number
72 ; Extrinsic boolean: 0: no active transfer, 1: active transfer.
73 ; Input: SDWLDA: EWL IEN
74 ; Output: SDWLINNM: Institution name
75 ; SDWLSTN: Station Number
76 S (SDWLINNM,SDWLSTN)=""
77 Q:'$D(^SDWL(409.35,"B",SDWLDA)) 0
78 N SDWLIFTN,SDWLSTA,SDWLINST
79 S SDWLIFTN=$O(^SDWL(409.35,"B",SDWLDA,":"),-1),SDWLSTA=$$GET1^DIQ(409.35,SDWLIFTN,3,"I") ; Get the last transfer: a status of P, T or R can not have entries after.
80 Q:"^P^T^R^"'[("^"_SDWLSTA_"^") 0
81 S SDWLSTN=$$GET1^DIQ(409.35,SDWLIFTN,1),SDWLINST=$$FIND1^DIC(4,"","X",SDWLSTN,"D"),SDWLINNM=$$GET1^DIQ(4,SDWLINST,60)
82 Q 1
Note: See TracBrowser for help on using the repository browser.