- TIUMOVE ; SLC/JER - Patient movement look-up ;10/26/95 21:17
- ;;1.0;TEXT INTEGRATION UTILITIES;**3**;Jun 20, 1997
- MAIN(TIUY,DFN,TIUSSN,TIUMDT,TIULDT,TIUMTYP,TIUDFLT,TIUMODE,TIULOC) ;
- ; Call with: .TIUY - (by ref) array in which demographic, movement,
- ; & visit data are returned
- ; [DFN] - patient file entry number
- ; [TIUSSN] - patient SSN
- ; [TIUMDT] - movement date
- ; [TIULDT] - upper bound of date range
- ; [TIUMTYP] - MAS Movement event type
- ; [TIUDFLT] - Default movement (e.g., "LAST")
- ; [TIUMODE] - mode flag 0 ==> Silent
- ; 1 ==> Interactive (default)
- AGN ; Loop for handling repeated attempts
- N TIUI,TIUII,TIUER,TIUOK,TIUOUT,TIUX,TIUMTSTR,TIUMLST,TIUCNT,X
- S TIUMTYP=$S(+$G(TIUMTYP):+$G(TIUMTYP),1:1)
- S TIUMODE=$S($G(TIUMODE)]"":$G(TIUMODE),1:1)
- S TIUMDT=$S(+$G(TIUMDT):+$G(TIUMDT),1:2400101)
- S TIULDT=$S(+$G(TIULDT):+$G(TIULDT),1:+$$NOW^TIULC)
- S TIUMTSTR="ADMISSION^TRANSFER^DISCHARGE^CHECK-IN^CHECK-OUT^SPECIALTY CHANGE"
- I +$G(DFN)'>0,($G(TIUSSN)]"") S DFN=+$$PATIENT^TIULA($G(TIUSSN))
- I +$G(DFN)'>0 S TIUOUT=1 Q
- I '$D(^DGPM("ATID"_TIUMTYP,DFN)),+TIUMODE W !,"No ",$P(TIUMTSTR,U,TIUMTYP),"S on file.",! Q
- I +TIUMTYP=1,(TIUMODE=0),(TIUDFLT="CURRENT"),+$G(^DPT(DFN,.105)) S TIUX=+$G(^DPT(DFN,.105)) G VADPT
- D TGET(.TIUMLST,DFN,TIUMDT,TIULDT,TIUMTYP,.TIUCNT,TIUMODE)
- ; If call is silent, and multiple movements in result, then quit
- I '+TIUMODE,$S(+TIUCNT=1:1,TIUDFLT="LAST":1,1:0) S TIUX=$G(TIUMLST(1))
- I '+TIUMODE,(+TIUCNT>1),(+$G(TIUX)'>0) Q
- I '+TIUMODE,(+TIUCNT=0) Q
- I +TIUMODE D I +TIUER Q:+$G(TIUOUT) G AGN
- . I +TIUCNT'>0 W !,"No ",$P(TIUMTSTR,U,TIUMTYP),"S within search parameters.",! Q
- . W !,"The following ",$P(TIUMTSTR,U,TIUMTYP)
- . W $S(+TIUCNT>1:"(S) are",1:" is")," available:"
- . S (TIUER,TIUOK,TIUI)=0
- . F S TIUI=$O(TIUMLST(TIUI)) Q:+TIUI'>0!+TIUER!+TIUOK D
- . . S TIUII=TIUI,TIUX=$P(TIUMLST(TIUI),"^",2,20)
- . . D WRITE I '(TIUI#5) D BREAK
- . Q:$D(TIUOUT)
- . I +TIUER S TIUOUT=1 Q
- . I TIUII#5 D BREAK Q:$D(TIUOUT)
- . I +TIUER S TIUOUT=1 Q
- . S TIUX=$G(TIUMLST(+TIUOK)),^DISV(DUZ,"DGPMEX",DFN)=+TIUX
- . W " ",$$DATE^TIULS(+$P(TIUX,U,2),"AMTH DD CCYY@HR:MIN")
- VADPT D PATVADPT^TIULV(.TIUY,DFN,+TIUX)
- Q
- TGET(Y,DFN,MDT,LDT,MTYPE,C,MODE) ; Get list of movements
- N I,N,D S MDT=$G(MDT,9999999.9999999),MTYPE=$G(MTYPE,1),LDT=$G(LDT,0)
- I MDT'=9999999.9999999 S MDT=9999999.9999999-$$IDATE^TIULC(MDT)
- I LDT'=0 S LDT=9999999.9999999-$$IDATE^TIULC(LDT)
- S C=0,I=LDT F S I=$O(^DGPM("ATID"_MTYPE,DFN,I)) Q:+I'>0!(+I>MDT) D
- . S N=$O(^DGPM("ATID"_MTYPE,DFN,I,0)) Q:'$D(^DGPM(+N,0))
- . S D=^(0),C=C+1,Y(C)=N_"^"_D
- . I +$G(MODE) S Y("TIUMVD",+D)=N,Y("TIUMVDA",N)=C
- Q
- BREAK ; Handle prompting
- W !,"CHOOSE 1-",TIUII W:$D(TIUMLST(TIUII+1)) !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT" W ": " R X:DTIME
- I $S('$T!(X["^"):1,X=""&'$D(TIUMLST(TIUII+1)):1,1:0) S TIUER=1 Q
- I X="" Q
- I X=" ",$D(^DISV(DUZ,"DGPMEX",DFN)) S TIUX=^(DFN) I $D(TIUMLST("TIUMVDA",+TIUX)) S TIUOK=+$G(TIUMLST("TIUMVDA",+TIUX)) Q
- I X'=+X!'$D(TIUMLST(+X)) W !!,$C(7),"INVALID RESPONSE",! G BREAK
- S TIUOK=X
- Q
- WRITE 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))
- 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:"")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUMOVE 3581 printed Mar 13, 2025@21:47:32 Page 2
- TIUMOVE ; SLC/JER - Patient movement look-up ;10/26/95 21:17
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**3**;Jun 20, 1997
- MAIN(TIUY,DFN,TIUSSN,TIUMDT,TIULDT,TIUMTYP,TIUDFLT,TIUMODE,TIULOC) ;
- +1 ; Call with: .TIUY - (by ref) array in which demographic, movement,
- +2 ; & visit data are returned
- +3 ; [DFN] - patient file entry number
- +4 ; [TIUSSN] - patient SSN
- +5 ; [TIUMDT] - movement date
- +6 ; [TIULDT] - upper bound of date range
- +7 ; [TIUMTYP] - MAS Movement event type
- +8 ; [TIUDFLT] - Default movement (e.g., "LAST")
- +9 ; [TIUMODE] - mode flag 0 ==> Silent
- +10 ; 1 ==> Interactive (default)
- AGN ; Loop for handling repeated attempts
- +1 NEW TIUI,TIUII,TIUER,TIUOK,TIUOUT,TIUX,TIUMTSTR,TIUMLST,TIUCNT,X
- +2 SET TIUMTYP=$SELECT(+$GET(TIUMTYP):+$GET(TIUMTYP),1:1)
- +3 SET TIUMODE=$SELECT($GET(TIUMODE)]"":$GET(TIUMODE),1:1)
- +4 SET TIUMDT=$SELECT(+$GET(TIUMDT):+$GET(TIUMDT),1:2400101)
- +5 SET TIULDT=$SELECT(+$GET(TIULDT):+$GET(TIULDT),1:+$$NOW^TIULC)
- +6 SET TIUMTSTR="ADMISSION^TRANSFER^DISCHARGE^CHECK-IN^CHECK-OUT^SPECIALTY CHANGE"
- +7 IF +$GET(DFN)'>0
- IF ($GET(TIUSSN)]"")
- SET DFN=+$$PATIENT^TIULA($GET(TIUSSN))
- +8 IF +$GET(DFN)'>0
- SET TIUOUT=1
- QUIT
- +9 IF '$DATA(^DGPM("ATID"_TIUMTYP,DFN))
- IF +TIUMODE
- WRITE !,"No ",$PIECE(TIUMTSTR,U,TIUMTYP),"S on file.",!
- QUIT
- +10 IF +TIUMTYP=1
- IF (TIUMODE=0)
- IF (TIUDFLT="CURRENT")
- IF +$GET(^DPT(DFN,.105))
- SET TIUX=+$GET(^DPT(DFN,.105))
- GOTO VADPT
- +11 DO TGET(.TIUMLST,DFN,TIUMDT,TIULDT,TIUMTYP,.TIUCNT,TIUMODE)
- +12 ; If call is silent, and multiple movements in result, then quit
- +13 IF '+TIUMODE
- IF $SELECT(+TIUCNT=1:1,TIUDFLT="LAST":1,1:0)
- SET TIUX=$GET(TIUMLST(1))
- +14 IF '+TIUMODE
- IF (+TIUCNT>1)
- IF (+$GET(TIUX)'>0)
- QUIT
- +15 IF '+TIUMODE
- IF (+TIUCNT=0)
- QUIT
- +16 IF +TIUMODE
- Begin DoDot:1
- +17 IF +TIUCNT'>0
- WRITE !,"No ",$PIECE(TIUMTSTR,U,TIUMTYP),"S within search parameters.",!
- QUIT
- +18 WRITE !,"The following ",$PIECE(TIUMTSTR,U,TIUMTYP)
- +19 WRITE $SELECT(+TIUCNT>1:"(S) are",1:" is")," available:"
- +20 SET (TIUER,TIUOK,TIUI)=0
- +21 FOR
- SET TIUI=$ORDER(TIUMLST(TIUI))
- if +TIUI'>0!+TIUER!+TIUOK
- QUIT
- Begin DoDot:2
- +22 SET TIUII=TIUI
- SET TIUX=$PIECE(TIUMLST(TIUI),"^",2,20)
- +23 DO WRITE
- IF '(TIUI#5)
- DO BREAK
- End DoDot:2
- +24 if $DATA(TIUOUT)
- QUIT
- +25 IF +TIUER
- SET TIUOUT=1
- QUIT
- +26 IF TIUII#5
- DO BREAK
- if $DATA(TIUOUT)
- QUIT
- +27 IF +TIUER
- SET TIUOUT=1
- QUIT
- +28 SET TIUX=$GET(TIUMLST(+TIUOK))
- SET ^DISV(DUZ,"DGPMEX",DFN)=+TIUX
- +29 WRITE " ",$$DATE^TIULS(+$PIECE(TIUX,U,2),"AMTH DD CCYY@HR:MIN")
- End DoDot:1
- IF +TIUER
- if +$GET(TIUOUT)
- QUIT
- GOTO AGN
- VADPT DO PATVADPT^TIULV(.TIUY,DFN,+TIUX)
- +1 QUIT
- TGET(Y,DFN,MDT,LDT,MTYPE,C,MODE) ; Get list of movements
- +1 NEW I,N,D
- SET MDT=$GET(MDT,9999999.9999999)
- SET MTYPE=$GET(MTYPE,1)
- SET LDT=$GET(LDT,0)
- +2 IF MDT'=9999999.9999999
- SET MDT=9999999.9999999-$$IDATE^TIULC(MDT)
- +3 IF LDT'=0
- SET LDT=9999999.9999999-$$IDATE^TIULC(LDT)
- +4 SET C=0
- SET I=LDT
- FOR
- SET I=$ORDER(^DGPM("ATID"_MTYPE,DFN,I))
- if +I'>0!(+I>MDT)
- QUIT
- Begin DoDot:1
- +5 SET N=$ORDER(^DGPM("ATID"_MTYPE,DFN,I,0))
- if '$DATA(^DGPM(+N,0))
- QUIT
- +6 SET D=^(0)
- SET C=C+1
- SET Y(C)=N_"^"_D
- +7 IF +$GET(MODE)
- SET Y("TIUMVD",+D)=N
- SET Y("TIUMVDA",N)=C
- End DoDot:1
- +8 QUIT
- BREAK ; Handle prompting
- +1 WRITE !,"CHOOSE 1-",TIUII
- if $DATA(TIUMLST(TIUII+1))
- WRITE !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT"
- WRITE ": "
- READ X:DTIME
- +2 IF $SELECT('$TEST!(X["^"):1,X=""&'$DATA(TIUMLST(TIUII+1)):1,1:0)
- SET TIUER=1
- QUIT
- +3 IF X=""
- QUIT
- +4 IF X=" "
- IF $DATA(^DISV(DUZ,"DGPMEX",DFN))
- SET TIUX=^(DFN)
- IF $DATA(TIUMLST("TIUMVDA",+TIUX))
- SET TIUOK=+$GET(TIUMLST("TIUMVDA",+TIUX))
- QUIT
- +5 IF X'=+X!'$DATA(TIUMLST(+X))
- WRITE !!,$CHAR(7),"INVALID RESPONSE",!
- GOTO BREAK
- +6 SET TIUOK=X
- +7 QUIT
- WRITE WRITE !,$JUSTIFY(TIUI,4),"> ",$$DATE^TIULS(+TIUX,"AMTH DD, CCYY@HR:MIN"),?30,$SELECT('$DATA(^DG(405.1,+$PIECE(TIUX,"^",4),0)):"",$PIECE(^(0),"^",7)]"":$PIECE(^(0),"^",7),1:$EXTRACT($PIECE(^(0),"^",1),1,20))
- +1 WRITE ?55,"TO: ",$SELECT($DATA(^DIC(42,+$PIECE(TIUX,"^",6),0)):$EXTRACT($PIECE(^(0),"^",1),1,18),1:"")
- IF $PIECE(TIUX,"^",18)=9
- WRITE !?23,"FROM: ",$SELECT($DATA(^DIC(4,+$PIECE(TIUX,"^",5),0)):$PIECE(^(0),"^",1),1:"")
- +2 QUIT
