SDWLIFT2 ;IOFO BAY PINES/OG - INTER-FACILITY TRANSFER: DISPLAY TRANSFER DETAILS ; Compiled March 23, 2005 12:38:06 ; Compiled January 25, 2007 12:35:43
;;5.3;Scheduling;**415,446**;AUG 13 1993;Build 77
;
;
;******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
;
;
Q
EN ; INITIALIZE VARIABLES FOR DISPLAY
; SDWLFMT: which set of data?
; 0 - Active
; 2 - Inactive
N SDWLOK,SDWLI
K SDWLINFO
D GETDATA^SDWLIFT5(.SDWLINFO,SDWLFMT)
S SDWLIFTN=$$GETTN^SDWLIFT(.SDWLINFO)
I 'SDWLIFTN S VALMBCK="R" Q
K SDWLINFO D GETDATA^SDWLIFT5(.SDWLINFO,SDWLFMT)
S (SDWLOK,SDWLI)=0 F S SDWLI=$O(SDWLINFO(SDWLI)) Q:'SDWLI I SDWLINFO(SDWLI,1)=SDWLIFTN S SDWLOK=1 Q
D:SDWLOK EN^VALM("SDWL TRANSFER REQ VIEW")
D INIT^SDWLIFT1(SDWLFMT)
S VALMBCK="R"
Q
;
INIT ; Default initialization options.
N DIC,D,X,WP,SDWLI,DFN,TMP,SDWLTY,SDWLDA,VADM
S SDWLDA=$$GET1^DIQ(409.35,SDWLIFTN,.01,"I")
D GETS^DIQ(409.35,SDWLIFTN,"1;3;7",,"TMP")
S DFN=$$GET1^DIQ(409.3,SDWLDA,.01,"I")
D DEM^VADPT
S VALMCNT=1
D SET^VALM10(VALMCNT,"Name: "_$E(VADM(1)_SDWLSPS,1,31)_"Status: "_TMP(409.35,SDWLIFTN_",",3))
I TMP(409.35,SDWLIFTN_",",7)'="" S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,"Transfer accepted by: "_TMP(409.35,SDWLIFTN_",",7))
S VALMCNT=VALMCNT+1
D SET^VALM10(VALMCNT,"SSN: "_$E($P(VADM(2),U,2)_SDWLSPS,1,31)_"Date of birth: "_$P(VADM(3),U,2))
S VALMCNT=VALMCNT+1
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")))
S VALMCNT=VALMCNT+1
D SET^VALM10(VALMCNT,"Transfer to: "_$$GET1^DIQ(4,$$FIND1^DIC(4,"","X",TMP(409.35,SDWLIFTN_",",1),"D"),.01))
S VALMCNT=VALMCNT+1
D SET^VALM10(VALMCNT,"Comments: ")
S X=$$GET1^DIQ(409.35,SDWLIFTN_",",5,"Z","WP")
S SDWLI=0 F S SDWLI=$O(WP(SDWLI)) Q:'SDWLI S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,WP(SDWLI,0))
Q
;
HD ; -- Make header line for list processor
S X=$$SETSTR^VALM1("User: "_SDWLDZN,"",1,79)
S VALMHDR(1)=X,VALMHDR(2)=""
Q
EXIT ; Tidy up
K SDWLIFTN
K VALMHDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLIFT2 2307 printed Dec 13, 2024@03:02:48 Page 2
SDWLIFT2 ;IOFO BAY PINES/OG - INTER-FACILITY TRANSFER: DISPLAY TRANSFER DETAILS ; Compiled March 23, 2005 12:38:06 ; Compiled January 25, 2007 12:35:43
+1 ;;5.3;Scheduling;**415,446**;AUG 13 1993;Build 77
+2 ;
+3 ;
+4 ;******************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ; ---- ----- -----------
+9 ;
+10 ;
+11 QUIT
EN ; INITIALIZE VARIABLES FOR DISPLAY
+1 ; SDWLFMT: which set of data?
+2 ; 0 - Active
+3 ; 2 - Inactive
+4 NEW SDWLOK,SDWLI
+5 KILL SDWLINFO
+6 DO GETDATA^SDWLIFT5(.SDWLINFO,SDWLFMT)
+7 SET SDWLIFTN=$$GETTN^SDWLIFT(.SDWLINFO)
+8 IF 'SDWLIFTN
SET VALMBCK="R"
QUIT
+9 KILL SDWLINFO
DO GETDATA^SDWLIFT5(.SDWLINFO,SDWLFMT)
+10 SET (SDWLOK,SDWLI)=0
FOR
SET SDWLI=$ORDER(SDWLINFO(SDWLI))
if 'SDWLI
QUIT
IF SDWLINFO(SDWLI,1)=SDWLIFTN
SET SDWLOK=1
QUIT
+11 if SDWLOK
DO EN^VALM("SDWL TRANSFER REQ VIEW")
+12 DO INIT^SDWLIFT1(SDWLFMT)
+13 SET VALMBCK="R"
+14 QUIT
+15 ;
INIT ; Default initialization options.
+1 NEW DIC,D,X,WP,SDWLI,DFN,TMP,SDWLTY,SDWLDA,VADM
+2 SET SDWLDA=$$GET1^DIQ(409.35,SDWLIFTN,.01,"I")
+3 DO GETS^DIQ(409.35,SDWLIFTN,"1;3;7",,"TMP")
+4 SET DFN=$$GET1^DIQ(409.3,SDWLDA,.01,"I")
+5 DO DEM^VADPT
+6 SET VALMCNT=1
+7 DO SET^VALM10(VALMCNT,"Name: "_$EXTRACT(VADM(1)_SDWLSPS,1,31)_"Status: "_TMP(409.35,SDWLIFTN_",",3))
+8 IF TMP(409.35,SDWLIFTN_",",7)'=""
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,"Transfer accepted by: "_TMP(409.35,SDWLIFTN_",",7))
+9 SET VALMCNT=VALMCNT+1
+10 DO SET^VALM10(VALMCNT,"SSN: "_$EXTRACT($PIECE(VADM(2),U,2)_SDWLSPS,1,31)_"Date of birth: "_$PIECE(VADM(3),U,2))
+11 SET VALMCNT=VALMCNT+1
+12 DO 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")))
+13 SET VALMCNT=VALMCNT+1
+14 DO SET^VALM10(VALMCNT,"Transfer to: "_$$GET1^DIQ(4,$$FIND1^DIC(4,"","X",TMP(409.35,SDWLIFTN_",",1),"D"),.01))
+15 SET VALMCNT=VALMCNT+1
+16 DO SET^VALM10(VALMCNT,"Comments: ")
+17 SET X=$$GET1^DIQ(409.35,SDWLIFTN_",",5,"Z","WP")
+18 SET SDWLI=0
FOR
SET SDWLI=$ORDER(WP(SDWLI))
if 'SDWLI
QUIT
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,WP(SDWLI,0))
+19 QUIT
+20 ;
HD ; -- Make header line for list processor
+1 SET X=$$SETSTR^VALM1("User: "_SDWLDZN,"",1,79)
+2 SET VALMHDR(1)=X
SET VALMHDR(2)=""
+3 QUIT
EXIT ; Tidy up
+1 KILL SDWLIFTN
+2 KILL VALMHDR
+3 QUIT
