| 1 | SDWLIFT4 ;IOFO BAY PINES/OG - INTER-FACILITY TRANSFER: REMOVE TRANSFER DETAILS ; Compiled March 23, 2005 11:22:00
|
|---|
| 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 FOR REMOVE
|
|---|
| 14 | N SDWLINFO
|
|---|
| 15 | D GETDATA^SDWLIFT5(.SDWLINFO,0)
|
|---|
| 16 | S SDWLIFTN=$$GETTN^SDWLIFT(.SDWLINFO)
|
|---|
| 17 | S VALMBCK="R"
|
|---|
| 18 | Q:'SDWLIFTN
|
|---|
| 19 | D EN^VALM("SDWL TRANSFER REQ REMV")
|
|---|
| 20 | D INIT^SDWLIFT1(0)
|
|---|
| 21 | S VALMBCK="R"
|
|---|
| 22 | Q
|
|---|
| 23 | REMOVE ;
|
|---|
| 24 | N X,DIC,DIK,DA,DR,Y
|
|---|
| 25 | S X="`"_SDWLIFTN,DIC=409.35,DIC(0)="Z" D ^DIC
|
|---|
| 26 | I $P(Y(0),U,4)="R" D REMREQ
|
|---|
| 27 | E S DA=SDWLIFTN,DIK="^SDWL(409.35," D ^DIK
|
|---|
| 28 | K ^TMP("SDWLIFT",$J,"EP")
|
|---|
| 29 | Q
|
|---|
| 30 | REMREQ ; send removal request to SDWL-XFER-SERVER
|
|---|
| 31 | N SDWLRIN,DIE,DA,DR
|
|---|
| 32 | S SDWLRIN=$$GET1^DIQ(409.35,SDWLIFTN,6)
|
|---|
| 33 | D SEND(SDWLRIN,$$GET1^DIQ(4,$$FIND1^DIC(4,"","X",$$GET1^DIQ(409.35,SDWLIFTN,1,"I"),"D"),60))
|
|---|
| 34 | S DIE=409.35,DA=SDWLIFTN,DR="3///C" D ^DIE
|
|---|
| 35 | Q
|
|---|
| 36 | SEND(SDWLRIN,SDWLDMN) ;
|
|---|
| 37 | N XMSUB,XMY,XMTEXT,XMDUZ,SDWLX
|
|---|
| 38 | S XMSUB="SDWL TRANSFER REMOVAL REQUEST"
|
|---|
| 39 | S XMY("S.SDWL-XFER-SERVER@"_SDWLDMN)=""
|
|---|
| 40 | S XMTEXT="SDWLX("
|
|---|
| 41 | S XMDUZ="POSTMASTER"
|
|---|
| 42 | S SDWLX(1,0)="6"_U_"RECEIVING FACILITY TRANSFER ID"_U_SDWLRIN
|
|---|
| 43 | S SDWLX(0)=1
|
|---|
| 44 | D ^XMD
|
|---|
| 45 | Q
|
|---|
| 46 | EXIT ; Tidy up
|
|---|
| 47 | K SDWLIFTN
|
|---|
