source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDWLIFT5.m@ 1352

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1SDWLIFT5 ;IOFO BAY PINES/OG - INTER-FACILITY TRANSFER: ACCEPT DATA - MAIN SCREEN ; Compiled March 29, 2005 15:26:24 ; Compiled January 26, 2007 10:05:24
2 ;;5.3;Scheduling;**415,446**;AUG 13 1993;Build 77
3 ;
4 ;
5 ;******************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ; ---- ----- -----------
10 ; 10/03/06 SD*5.3*446 Enhancements
11 ;
12 Q
13EN ; INITIALIZE VARIABLES
14 K DIR,DIC,DR,DIE,VADM,SDWLLIST,VALMHDR,VALMCNT,VALMBCK
15 D EN^VALM("SDWL TRANSFER ACC MAIN")
16 Q
17INIT ; Default initialization options.
18 K ^TMP("DILIST",$J),^TMP("SDWLIFT",$J,"EP")
19 N SDWLI,DIC
20 S SDWLSPS=$J("",80)
21 S VALMCNT=0
22 D GETLIST F SDWLI=1:1:SDWLLIST(0) D
23 .N SDWLOUT
24 .S VALMCNT=VALMCNT+1
25 .S SDWLOUT=$E(VALMCNT_SDWLSPS,1,3)
26 .S SDWLOUT=SDWLOUT_$E($P(SDWLLIST(SDWLI,0),U)_SDWLSPS,1,26)_" "
27 .S SDWLOUT=SDWLOUT_$E($P(SDWLLIST(SDWLI,0),U,2)_SDWLSPS,1,21)_" "
28 .S SDWLOUT=SDWLOUT_$E($P(SDWLLIST(SDWLI,0),U,3)_SDWLSPS,1,25)_" "
29 .S SDWLOUT=SDWLOUT_$P(SDWLLIST(SDWLI,0),U,4)
30 .D SET^VALM10(VALMCNT,SDWLOUT)
31 .Q
32 I 'VALMCNT S VALMCNT=1 D SET^VALM10(VALMCNT," ** No transfer details... ")
33 Q
34HD ; -- Make header line for list processor
35 S (VALMHDR(1),VALMHDR(2))=""
36 Q
37EXIT ; Tidy up
38 K ^TMP("DILIST",$J),^TMP("SDWLIFT",$J,"EP")
39 K SDWLLIST,SDWLSPS,SDWLIFTN
40 Q
41GETLIST ;
42 N SDWLI
43 S DIC=409.36
44 D LIST^DIC(DIC)
45 S (SDWLI,SDWLLIST(0))=0,DIC(0)="Z"
46 F S SDWLI=$O(^TMP("DILIST",$J,2,SDWLI)) Q:'SDWLI D
47 .N TMP,SDWLIFTN,SDWLST,DIC,D,X
48 .S SDWLIFTN=^TMP("DILIST",$J,2,SDWLI)
49 .D GETS^DIQ(409.36,SDWLIFTN,".01;.02;.03;.09;.1;.2;1",,"TMP")
50 .S SDWLST=$$GET1^DIQ(409.36,SDWLIFTN,1,"I")
51 .Q:SDWLST="C"!(SDWLST="R")!(SDWLST="T")
52 .S SDWLLIST(0)=SDWLLIST(0)+1
53 .S SDWLLIST(SDWLLIST(0),0)=TMP(409.36,SDWLIFTN_",",.01)
54 .S $P(SDWLLIST(SDWLLIST(0),0),U,2)=TMP(409.36,SDWLIFTN_",",.2) ; date/time
55 .S $P(SDWLLIST(SDWLLIST(0),0),U,3)=$$GET1^DIQ(4,$$FIND1^DIC(4,"","X",TMP(409.36,SDWLIFTN_",",.1),"D"),.01)
56 .S $P(SDWLLIST(SDWLLIST(0),0),U,4)=SDWLST
57 .S SDWLLIST(SDWLLIST(0),1)=SDWLIFTN
58 .Q
59 Q
60GETDATA(SDWLOUT,SDWLFMT) ; Get request data for display.
61 ; SDWLFMT - output format: 0: filtered, only active transmissions
62 ; 1: all transmissions
63 ; 2: filtered, only inactive transmissions
64 N SDWLI,DIC,X,Y
65 S DIC=409.35
66 D LIST^DIC(DIC)
67 S (SDWLI,SDWLOUT(0))=0,DIC(0)="Z"
68 F S SDWLI=$O(^TMP("DILIST",$J,2,SDWLI)) Q:'SDWLI S X="`"_^TMP("DILIST",$J,2,SDWLI) D ^DIC I $D(Y(0)) D
69 .N REC,SDWLNAM,DFN,SDWLDA,SDWLSTA,TMP,SDWLIFTN,SDWLTY,SDWLTV,VADM,DIC,D,X
70 .S REC=Y(0),SDWLNAM=Y(0,0),SDWLDA=$P(Y(0),U),SDWLIFTN=+Y,DFN=$$GET1^DIQ(409.3,SDWLDA,.01,"I")
71 .D GETS^DIQ(409.35,SDWLIFTN,"1;2;3;4",,"TMP")
72 .S SDWLSTA=TMP(409.35,SDWLIFTN_",",3),SDWLTV=SDWLSTA="RESOLVED"!(SDWLSTA="REFUSED")
73 .I 'SDWLFMT Q:SDWLTV ; Only show 'active' transmissions.
74 .I SDWLFMT=2 Q:'SDWLTV ; Only show 'inactive' transmissions.
75 .D DEM^VADPT
76 .D GETS^DIQ(409.3,SDWLDA,"2;4",,"TMP")
77 .S SDWLOUT(0)=SDWLOUT(0)+1
78 .S SDWLOUT(SDWLOUT(0),1)=SDWLIFTN
79 .; Name
80 .S SDWLOUT(SDWLOUT(0),0)=SDWLNAM
81 .; SSN
82 .S $P(SDWLOUT(SDWLOUT(0),0),U,2)=$P(VADM(2),U,2)
83 .; Destination Institution
84 .S $P(SDWLOUT(SDWLOUT(0),0),U,3)=$$GET1^DIQ(4,$$FIND1^DIC(4,"","X",TMP(409.35,SDWLIFTN_",",1),"D"),.01)
85 .; Transfer Status
86 .S $P(SDWLOUT(SDWLOUT(0),0),U,4)=SDWLSTA
87 .; Current Wait List Institution
88 .S $P(SDWLOUT(SDWLOUT(0),0),U,5)=TMP(409.3,SDWLDA_",",2)
89 .; Current Wait List Type
90 .S $P(SDWLOUT(SDWLOUT(0),0),U,6)=TMP(409.3,SDWLDA_",",4)
91 .; Current Wait List Type Extension
92 .S SDWLTY=$$GET1^DIQ(409.3,SDWLDA,4,"I")
93 .S $P(SDWLOUT(SDWLOUT(0),0),U,7)=$$GET1^DIQ(409.3,SDWLDA,SDWLTY+4)
94 .; Sex
95 .S $P(SDWLOUT(SDWLOUT(0),0),U,8)=$P(VADM(5),U,2)
96 .; Transmission date/time
97 .S $P(SDWLOUT(SDWLOUT(0),0),U,9)=TMP(409.35,SDWLIFTN_",",2)
98 .; Requestor
99 .S $P(SDWLOUT(SDWLOUT(0),0),U,10)=TMP(409.35,SDWLIFTN_",",4)
100 .Q
101 Q
Note: See TracBrowser for help on using the repository browser.