| [613] | 1 | SDWLIFT1 ;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
|
|---|
| 13 | EN ; 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
|
|---|
| 19 | ENI ; 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
|
|---|
| 27 | INIT(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
|
|---|
| 61 | HD ; -- 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
|
|---|
| 66 | EXIT ; Tidy up
|
|---|
| 67 | K VALMBCK,VALMHDR,VALMCNT
|
|---|
| 68 | K SDWLDZN,SDWLSPS,SDWLINFO,SDWLOPT,SDWLFMT
|
|---|
| 69 | K ^TMP("DILIST",$J),^TMP("SDWLIFT",$J)
|
|---|
| 70 | Q
|
|---|
| 71 | GETTRN(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
|
|---|
