source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUMOVE.m@ 724

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1TIUMOVE ; SLC/JER - Patient movement look-up ;10/26/95 21:17
2 ;;1.0;TEXT INTEGRATION UTILITIES;**3**;Jun 20, 1997
3MAIN(TIUY,DFN,TIUSSN,TIUMDT,TIULDT,TIUMTYP,TIUDFLT,TIUMODE,TIULOC) ;
4 ; Call with: .TIUY - (by ref) array in which demographic, movement,
5 ; & visit data are returned
6 ; [DFN] - patient file entry number
7 ; [TIUSSN] - patient SSN
8 ; [TIUMDT] - movement date
9 ; [TIULDT] - upper bound of date range
10 ; [TIUMTYP] - MAS Movement event type
11 ; [TIUDFLT] - Default movement (e.g., "LAST")
12 ; [TIUMODE] - mode flag 0 ==> Silent
13 ; 1 ==> Interactive (default)
14AGN ; Loop for handling repeated attempts
15 N TIUI,TIUII,TIUER,TIUOK,TIUOUT,TIUX,TIUMTSTR,TIUMLST,TIUCNT,X
16 S TIUMTYP=$S(+$G(TIUMTYP):+$G(TIUMTYP),1:1)
17 S TIUMODE=$S($G(TIUMODE)]"":$G(TIUMODE),1:1)
18 S TIUMDT=$S(+$G(TIUMDT):+$G(TIUMDT),1:2400101)
19 S TIULDT=$S(+$G(TIULDT):+$G(TIULDT),1:+$$NOW^TIULC)
20 S TIUMTSTR="ADMISSION^TRANSFER^DISCHARGE^CHECK-IN^CHECK-OUT^SPECIALTY CHANGE"
21 I +$G(DFN)'>0,($G(TIUSSN)]"") S DFN=+$$PATIENT^TIULA($G(TIUSSN))
22 I +$G(DFN)'>0 S TIUOUT=1 Q
23 I '$D(^DGPM("ATID"_TIUMTYP,DFN)),+TIUMODE W !,"No ",$P(TIUMTSTR,U,TIUMTYP),"S on file.",! Q
24 I +TIUMTYP=1,(TIUMODE=0),(TIUDFLT="CURRENT"),+$G(^DPT(DFN,.105)) S TIUX=+$G(^DPT(DFN,.105)) G VADPT
25 D TGET(.TIUMLST,DFN,TIUMDT,TIULDT,TIUMTYP,.TIUCNT,TIUMODE)
26 ; If call is silent, and multiple movements in result, then quit
27 I '+TIUMODE,$S(+TIUCNT=1:1,TIUDFLT="LAST":1,1:0) S TIUX=$G(TIUMLST(1))
28 I '+TIUMODE,(+TIUCNT>1),(+$G(TIUX)'>0) Q
29 I '+TIUMODE,(+TIUCNT=0) Q
30 I +TIUMODE D I +TIUER Q:+$G(TIUOUT) G AGN
31 . I +TIUCNT'>0 W !,"No ",$P(TIUMTSTR,U,TIUMTYP),"S within search parameters.",! Q
32 . W !,"The following ",$P(TIUMTSTR,U,TIUMTYP)
33 . W $S(+TIUCNT>1:"(S) are",1:" is")," available:"
34 . S (TIUER,TIUOK,TIUI)=0
35 . F S TIUI=$O(TIUMLST(TIUI)) Q:+TIUI'>0!+TIUER!+TIUOK D
36 . . S TIUII=TIUI,TIUX=$P(TIUMLST(TIUI),"^",2,20)
37 . . D WRITE I '(TIUI#5) D BREAK
38 . Q:$D(TIUOUT)
39 . I +TIUER S TIUOUT=1 Q
40 . I TIUII#5 D BREAK Q:$D(TIUOUT)
41 . I +TIUER S TIUOUT=1 Q
42 . S TIUX=$G(TIUMLST(+TIUOK)),^DISV(DUZ,"DGPMEX",DFN)=+TIUX
43 . W " ",$$DATE^TIULS(+$P(TIUX,U,2),"AMTH DD CCYY@HR:MIN")
44VADPT D PATVADPT^TIULV(.TIUY,DFN,+TIUX)
45 Q
46TGET(Y,DFN,MDT,LDT,MTYPE,C,MODE) ; Get list of movements
47 N I,N,D S MDT=$G(MDT,9999999.9999999),MTYPE=$G(MTYPE,1),LDT=$G(LDT,0)
48 I MDT'=9999999.9999999 S MDT=9999999.9999999-$$IDATE^TIULC(MDT)
49 I LDT'=0 S LDT=9999999.9999999-$$IDATE^TIULC(LDT)
50 S C=0,I=LDT F S I=$O(^DGPM("ATID"_MTYPE,DFN,I)) Q:+I'>0!(+I>MDT) D
51 . S N=$O(^DGPM("ATID"_MTYPE,DFN,I,0)) Q:'$D(^DGPM(+N,0))
52 . S D=^(0),C=C+1,Y(C)=N_"^"_D
53 . I +$G(MODE) S Y("TIUMVD",+D)=N,Y("TIUMVDA",N)=C
54 Q
55BREAK ; Handle prompting
56 W !,"CHOOSE 1-",TIUII W:$D(TIUMLST(TIUII+1)) !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT" W ": " R X:DTIME
57 I $S('$T!(X["^"):1,X=""&'$D(TIUMLST(TIUII+1)):1,1:0) S TIUER=1 Q
58 I X="" Q
59 I X=" ",$D(^DISV(DUZ,"DGPMEX",DFN)) S TIUX=^(DFN) I $D(TIUMLST("TIUMVDA",+TIUX)) S TIUOK=+$G(TIUMLST("TIUMVDA",+TIUX)) Q
60 I X'=+X!'$D(TIUMLST(+X)) W !!,$C(7),"INVALID RESPONSE",! G BREAK
61 S TIUOK=X
62 Q
63WRITE W !,$J(TIUI,4),"> ",$$DATE^TIULS(+TIUX,"AMTH DD, CCYY@HR:MIN"),?30,$S('$D(^DG(405.1,+$P(TIUX,"^",4),0)):"",$P(^(0),"^",7)]"":$P(^(0),"^",7),1:$E($P(^(0),"^",1),1,20))
64 W ?55,"TO: ",$S($D(^DIC(42,+$P(TIUX,"^",6),0)):$E($P(^(0),"^",1),1,18),1:"") I $P(TIUX,"^",18)=9 W !?23,"FROM: ",$S($D(^DIC(4,+$P(TIUX,"^",5),0)):$P(^(0),"^",1),1:"")
65 Q
Note: See TracBrowser for help on using the repository browser.