176 lines
8.2 KiB
Mathematica
176 lines
8.2 KiB
Mathematica
SDWLIFT6 ;IOFO BAY PINES/OG - INTER-FACILITY TRANSFER: DISPLAY ACCEPT DETAILS ; Compiled March 23, 2005 12:38:06 ; Compiled January 25, 2007 16:34:01
|
|
;;5.3;Scheduling;**415,446**;AUG 13 1993;Build 77
|
|
;
|
|
;
|
|
;******************************************************************
|
|
; CHANGE LOG
|
|
;
|
|
; DATE PATCH DESCRIPTION
|
|
; ---- ----- -----------
|
|
; 04/14/2006 SD*5.3*446 INTER-FACILITY TRANSFER
|
|
;
|
|
Q
|
|
EN ; INITIALIZE VARIABLES FOR DISPLAY
|
|
N DFN,SDWLI,SDWLOK,SDWLIFN0
|
|
K SDWLLIST
|
|
D GETLIST^SDWLIFT5
|
|
S (SDWLIFTN,SDWLIFN0)=$$GETTN^SDWLIFT(.SDWLLIST)
|
|
I 'SDWLIFTN S VALMBCK="R" Q
|
|
L +^SDWL(409.36,SDWLIFTN):10 I '$T S VALMBCK="R" Q
|
|
; Refresh list and loop to ensure that the selection hasn't been removed while the choice was being made.
|
|
K SDWLLIST D GETLIST^SDWLIFT5
|
|
S (SDWLOK,SDWLI)=0 F S SDWLI=$O(SDWLLIST(SDWLI)) Q:'SDWLI I SDWLLIST(SDWLI,1)=SDWLIFTN S SDWLOK=1 Q
|
|
D:SDWLOK
|
|
.N DIC,DFN,SDWLDFN,SDWLICN,SDWLSSN,SDWLTY,X,Y
|
|
.S SDWLICN=$$GET1^DIQ(409.36,SDWLIFTN,991.01)
|
|
.S SDWLSSN=$$GET1^DIQ(409.36,SDWLIFTN,.09)
|
|
.S (DFN,SDWLDFN)=$S(+SDWLICN:$O(^DPT("AICN",SDWLICN,"")),1:"")
|
|
.I DFN="" S (DFN,SDWLDFN)=$S(+SDWLSSN:$O(^DPT("SSN",SDWLSSN,"")),1:"")
|
|
.S SDWLTY=$$GET1^DIQ(409.36,SDWLIFTN,4,"I")
|
|
.D EN^VALM("SDWL TRANSFER ACC VIEW")
|
|
.Q
|
|
L -^SDWL(409.36,SDWLIFN0)
|
|
D INIT^SDWLIFT5
|
|
S VALMBCK="R"
|
|
Q
|
|
INIT ; Default initialization options.
|
|
N SDWLINFO
|
|
D GETINFO(.SDWLINFO)
|
|
F VALMCNT=1:1:SDWLINFO(0) D SET^VALM10(VALMCNT,SDWLINFO(VALMCNT,0))
|
|
Q
|
|
GETINFO(SDWLOUT) ; The Coversheet function calls here too.
|
|
N DIC,D,X,WP,TMP,SDWLADD,SDWLFID,SDWLI
|
|
D GETS^DIQ(409.36,SDWLIFTN,"*",,"TMP")
|
|
S SDWLOUT(0)=1
|
|
D:SDWLDFN=""
|
|
.S SDWLOUT(SDWLOUT(0),0)="Patient not registered"
|
|
.S SDWLOUT(0)=SDWLOUT(0)+1
|
|
.D CNTRL^VALM10(1,1,22,IOINHI,IOINORM)
|
|
.Q
|
|
S SDWLOUT(SDWLOUT(0),0)="Transmg. Inst: "_$E($$GET1^DIQ(4,$$FIND1^DIC(4,"","X",TMP(409.36,SDWLIFTN_",",.1),"D"),.01)_SDWLSPS,1,28)_" "
|
|
S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_"Transmn. Date: "_TMP(409.36,SDWLIFTN_",",.2)
|
|
S SDWLOUT(0)=SDWLOUT(0)+1
|
|
S SDWLOUT(SDWLOUT(0),0)="Name: "_$E(TMP(409.36,SDWLIFTN_",",.01)_SDWLSPS,1,27)_" "
|
|
S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_"Sex: "_$E(TMP(409.36,SDWLIFTN_",",.02)_SDWLSPS,1,7)
|
|
S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_"DoB: "_$E(TMP(409.36,SDWLIFTN_",",.03)_SDWLSPS,1,13)
|
|
S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_"SSN: "_TMP(409.36,SDWLIFTN_",",.09)
|
|
;
|
|
S SDWLOUT(0)=SDWLOUT(0)+1,SDWLADD=SDWLOUT(0)
|
|
S SDWLOUT(SDWLOUT(0),0)=$E("Address: "_TMP(409.36,SDWLIFTN_",",.111)_SDWLSPS,1,58)_" Status: "_TMP(409.36,SDWLIFTN_",",1)
|
|
F SDWLFID=.112:.001:.114,.117 I TMP(409.36,SDWLIFTN_",",SDWLFID)'="" S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)=$E(SDWLSPS,1,9)_TMP(409.36,SDWLIFTN_",",SDWLFID)
|
|
I TMP(409.36,SDWLIFTN_",",.115)_TMP(409.36,SDWLIFTN_",",.116)'="" D
|
|
.S SDWLOUT(0)=SDWLOUT(0)+1
|
|
.S SDWLOUT(SDWLOUT(0),0)=$E(SDWLSPS,1,9)
|
|
.I TMP(409.36,SDWLIFTN_",",.115)'="" S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_TMP(409.36,SDWLIFTN_",",.115)
|
|
.S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_" "_TMP(409.36,SDWLIFTN_",",.116)
|
|
.Q
|
|
I TMP(409.36,SDWLIFTN_",",.131)'="" S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="Phone no "_TMP(409.36,SDWLIFTN_",",.131)
|
|
D:TMP(409.36,SDWLIFTN_",",.1217)'="" ; Temporary address details. Displayed to the right of the address in up to 3 lines starting column 62
|
|
.S SDWLOUT(SDWLADD,0)=$E(SDWLOUT(SDWLADD,0)_SDWLSPS,1,61)_"Temporary address" ; There should be at least three lines if it is also indicated as temporary.
|
|
.S SDWLOUT(SDWLADD+1,0)=$E(SDWLOUT(SDWLADD+1,0)_SDWLSPS,1,61)_"From: "_TMP(409.36,SDWLIFTN_",",.1217)
|
|
.S SDWLOUT(SDWLADD+2,0)=$E(SDWLOUT(SDWLADD+2,0)_SDWLSPS,1,61)_"To : "_TMP(409.36,SDWLIFTN_",",.1218)
|
|
.Q
|
|
S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="Service connected: "_TMP(409.36,SDWLIFTN_",",.301)
|
|
I TMP(409.36,SDWLIFTN_",",.301)="YES" S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_" Percentage: "_TMP(409.36,SDWLIFTN_",",.302)
|
|
S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="Primary Eligibility: "_TMP(409.36,SDWLIFTN_",",.361)
|
|
S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="Wait List Type: "
|
|
S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_TMP(409.36,SDWLIFTN_",",4)_" : "_TMP(409.36,SDWLIFTN_",",5)
|
|
S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="Desired Date of Appt: "
|
|
S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_TMP(409.36,SDWLIFTN_",",22)
|
|
S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_" Integration Control Number: "
|
|
S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_TMP(409.36,SDWLIFTN_",",991.01)
|
|
S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="Comments: "
|
|
S X=$$GET1^DIQ(409.36,SDWLIFTN_",",.4,"Z","WP")
|
|
S SDWLI=0 F S SDWLI=$O(WP(SDWLI)) Q:'SDWLI S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)=WP(SDWLI,0)
|
|
Q
|
|
GETTN(SDWLLIST) ; Get transfer id.
|
|
N DIR,Y
|
|
I 'SDWLLIST(0) S DIR(0)="Y",DIR("A")="No entries. OK",DIR("B")="YES" D ^DIR Q 0
|
|
I SDWLLIST(0)=1 S Y=1 ; If there is only one, don't ask.
|
|
E S DIR(0)="L^1:"_SDWLLIST(0),DIR("A")="Which entry?" D ^DIR
|
|
Q $G(SDWLLIST(+Y,1),0)
|
|
HD ; -- Make header line for list processor
|
|
S (VALMHDR(1),VALMHDR(2))=""
|
|
Q
|
|
PCMM(SDWLIFTN,DFN) ;
|
|
N SDWLPCMM,SDWLRES,DIE,DA,DR
|
|
I $G(DFN)="" W !,"Patient not entered on the system. Use Load/edit" S DIR(0)="E",VALMBCK="R" D ^DIR Q
|
|
S (SDWLPCMM,SDWLRES)=0
|
|
D PAT^SCMCQK
|
|
;If a PCMM assignment was made, close 409.36
|
|
;if an EWL Entry was created instead, add pointer
|
|
;then pass a message back.
|
|
Q:'SDWLPCMM&'SDWLRES
|
|
S DIE="^SDWL(409.36,",DA=SDWLIFTN
|
|
I SDWLPCMM S DR="1///C"
|
|
E S DR="409.3///"_$P(SDWLRES,U,2)
|
|
D ^DIE,SENDST(SDWLIFTN)
|
|
Q
|
|
;
|
|
ACCEPT ; Sign the transaction off as accepted. Remove the temporary file and send a message to transmitting facility
|
|
N DIR
|
|
I $$GET1^DIQ(409.36,SDWLIFTN,.3)'="YES" D Q
|
|
.S DIR("A")="A coversheet does not appear to have been requested."_$C(13,10)_"This is required before acceptance. Enter RETURN to continue or '^' to exit"
|
|
.S DIR(0)="E"
|
|
.D ^DIR
|
|
.S VALMBCK=$S(Y:"R",1:"Q")
|
|
.Q
|
|
D FULL^VALM1
|
|
S DIR(0)="Y"
|
|
S DIR("A")="Do you confirm that the appropriate action was taken to schedule this patient"_$C(13,10)_"for an appointment or she/he has EWL entry and the cover sheet has been printed"
|
|
S DIR("B")="N"
|
|
D ^DIR
|
|
D:Y
|
|
.N SDWLSTN,SDWLINST,XMY,XMSUB,XMTEXT,XMDUZ,SDWLX,DA,DIK
|
|
.S SDWLSTN=$$GET1^DIQ(409.36,SDWLIFTN,.1)
|
|
.S SDWLINST=$$FIND1^DIC(4,"","X",SDWLSTN,"D")
|
|
.S XMY("S.SDWL-XFER-SERVER@"_$$GET1^DIQ(4,SDWLINST,60))=""
|
|
.S XMSUB="SDWL TRANSFER ACCEPTANCE"
|
|
.S XMTEXT="SDWLX("
|
|
.S XMDUZ="POSTMASTER"
|
|
.S SDWLX(1,0)=".5"_U_"SENDING FACILITY TRANSFER ID"_U_$$GET1^DIQ(409.36,SDWLIFTN,.5)
|
|
.S SDWLX(2,0)="7"_U_"ACCEPTING PERSON"_U_$$GET1^DIQ(200,DUZ,.01)
|
|
.S SDWLX(0)=2
|
|
.D ^XMD
|
|
.S DA=SDWLIFTN,DIK="^SDWL(409.36," D ^DIK
|
|
.Q
|
|
S VALMBCK="Q"
|
|
Q
|
|
REJECT ; Sign the transaction off as rejected. Remove the temporary file and send a message to transmitting facility
|
|
N SDWLSTN,SDWLINST,XMSUB,XMY,XMTEXT,XMDUZ,SDWLX
|
|
S SDWLSTN=$$GET1^DIQ(409.36,SDWLIFTN,.1)
|
|
S SDWLINST=$$FIND1^DIC(4,"","X",SDWLSTN,"D")
|
|
S XMY("S.SDWL-XFER-SERVER@"_$$GET1^DIQ(4,SDWLINST,60))=""
|
|
S XMSUB="SDWL TRANSFER REJECTION"
|
|
S XMTEXT="SDWLX("
|
|
S XMDUZ="POSTMASTER"
|
|
S SDWLX(1,0)=".5"_U_"SENDING FACILITY TRANSFER ID"_U_$$GET1^DIQ(409.36,SDWLIFTN,.5)
|
|
S SDWLX(0)=1
|
|
D ^XMD
|
|
S DA=SDWLIFTN,DIK="^SDWL(409.36," D ^DIK
|
|
;teh/05/20/2005 cleans the SDWLLIST array and reset count.
|
|
K SDWLLIST(SDWLIFTN)
|
|
S SDWLLIST(0)=SDWLLIST(0)-1
|
|
S VALMBCK="Q"
|
|
EXIT ; Tidy up
|
|
K SDWLIFTN
|
|
Q
|
|
SENDST(SDWLIFTN) ; Send status change notification
|
|
N SDWLSTN,SDWLINST,TMP,XMSUB,XMY,XMTEXT,XMDUZ,SDWLX,SDWLDA,SDWLDIS
|
|
S SDWLDA=$$GET1^DIQ(409.36,SDWLIFTN,409.3,"I"),SDWLDIS=$$GET1^DIQ(409.3,SDWLDA,21,"I")
|
|
D GETS^DIQ(409.36,SDWLIFTN,".1;.5;1;2","I","TMP")
|
|
S SDWLSTN=TMP(409.36,SDWLIFTN_",",.1,"I")
|
|
S SDWLINST=$$FIND1^DIC(4,"","X",SDWLSTN,"D")
|
|
S XMY("S.SDWL-XFER-SERVER@"_$$GET1^DIQ(4,SDWLINST,60))=""
|
|
S XMSUB="SDWL TRANSFER STATUS CHANGE"
|
|
S XMTEXT="SDWLX("
|
|
S XMDUZ="POSTMASTER"
|
|
S SDWLX(1,0)=.5_U_"SENDING FACILITY TRANSFER ID"_U_TMP(409.36,SDWLIFTN_",",.5,"I")
|
|
S SDWLX(2,0)=1_U_"STATUS"_U_TMP(409.36,SDWLIFTN_",",1,"I")
|
|
S SDWLX(3,0)=7_U_"ACCEPTING PERSON"_U_$$GET1^DIQ(200,DUZ,.01)
|
|
S SDWLX(4,0)=2_U_"FACILITY TRANFERRED TO"_U_TMP(409.36,SDWLIFTN_",",2,"I")
|
|
S SDWLX(5,0)=21_U_"DISPOSITION"_U_SDWLDIS
|
|
S SDWLX(0)=5
|
|
D ^XMD
|
|
Q
|