TIUVISIT ; SLC/JER - Visit File look-up ;4/28/99@09:47:44 [1/27/05 12:36pm]
;;1.0;TEXT INTEGRATION UTILITIES;**39,124,190**;Jun 20, 1997;Build 1
MAIN(TIUY,DFN,TIUSSN,TIUVDT,TIULDT,TIUDFLT,TIUMODE,TIULOC,TIUOCC,LETNEW,FILTER,UNSONLY,TIUFUTUR) ;Control
AGN K ^TMP("TIUVN",$J),^TMP("TIUVD",$J),^TMP("TIUVDA",$J)
N C,I,N,TIUI,TIUII,TIUVDA,TIUER,TIUOK,TIUX,X,TIUNVIS,TIUVDATE
S LETNEW=$G(LETNEW,1),UNSONLY=+$G(UNSONLY)
S:+$G(DFN)'>0 DFN=+$$PATIENT^TIULA($G(TIUSSN)) I +DFN'>0 S TIUOUT=1 Q
S TIUMODE=$G(TIUMODE,1),TIUOCC=$G(TIUOCC,20)
S TIULOC=$S(+$G(TIULOC):TIULOC,$G(TIULOC)]"":+$O(^SC("B",TIULOC,0)),1:"")
I +$G(TIUVDT) S TIUVDATE=(9999999-$P(TIUVDT,"."))_"."_$P(TIUVDT,".",2)
S TIULDT=$S(+$G(TIULDT)>0:(9999999-$P(TIULDT,"."))_$S($L(TIULDT,".")>1:"."_$P(TIULDT,".",2),1:""),+$G(TIUVDT):(9999999-$P(TIUVDT,"."))_"."_$P($$FMADD^XLFDT(TIUVDT,"","","",-1),".",2),1:0)
I '+$G(TIUVDT) S TIUVDT=$S(+$G(TIULDT):(9999999-$P(+$G(TIUVDT),"."))_"."_$P($$FMADD^XLFDT(+$G(TIUVDT),"",23,59,59),".",2),+$G(TIUVDT)>0:(9999999-$P(TIUVDT,"."))_"."_$P($$FMADD^XLFDT(TIUVDT,"","","",1),".",2),1:9999999) I 1
E S TIUVDT=$G(TIUVDATE)
I '$D(^AUPNVSIT("AA",DFN)) W !,"No UNSCHEDULED VISITS on file",! Q
S I=TIULDT F S I=$O(^AUPNVSIT("AA",DFN,I)) Q:+I'>0!(+I>TIUVDT) D
. N N S N=0
. F S N=$O(^AUPNVSIT("AA",DFN,I,N)) Q:+N'>0 D
. . N D
. . S:$G(FILTER)'["XD" FILTER=$G(FILTER)_"XD"
. . Q:'$D(^AUPNVSIT(+N,0))!(FILTER[$P($G(^AUPNVSIT(+N,0)),U,7))
. . ; If unscheduled visits only, then omit scheduled visits
. . I +UNSONLY,$$CHKAPPT^TIUPXAP2(N) Q
. . S D=^AUPNVSIT(+N,0)
. . I +$G(TIULOC)>0,($P(D,U,22)'=TIULOC) Q
. . S ^TMP("TIUVD",$J,(9999999-+D))=N_U_D
S (C,I)=0 F S I=$O(^TMP("TIUVD",$J,I)) Q:+I'>0 D
. S C=C+1,^TMP("TIUVN",$J,C)=$G(^TMP("TIUVD",$J,I))
. S ^TMP("TIUVDA",$J,+$G(^TMP("TIUVD",$J,I)))=C
I '+TIUMODE,'$D(^TMP("TIUVN",$J)) Q
I '$D(^TMP("TIUVN",$J)) Q
I '+TIUMODE,$G(TIUDFLT)="LAST" D Q:'+TIUX G VADPT
. N TIUI S TIUI=+$O(^TMP("TIUVN",$J,0))
. S TIUX=$G(^TMP("TIUVN",$J,+TIUI))
S (TIUER,TIUOK,TIUI)=0
W !!,"The following",$S(FILTER["H":" UNSCHEDULED",1:"")," VISITS are available:",!
F S TIUI=$O(^TMP("TIUVN",$J,TIUI)) Q:+TIUI'>0 D Q:+TIUER!+TIUOK!+$G(TIUOUT)
. N TIUVR
. S TIUII=TIUI,TIUVR=$P(^TMP("TIUVN",$J,TIUI),"^",2,20),TIUVDA=+^(TIUI)
. D WRITE
. I '(TIUI#5) D BREAK I +$G(TIUX),($L($G(TIUX),";")=3) D VADPT^TIUVSIT S TIUOUT=1 Q
. I $G(X)["?" S X="",TIUI=TIUI-5
G:$D(TIUOUT) CLEAN
G AGN:TIUER
I +$G(TIUII)#5 D BREAK I +$G(TIUX),($L($G(TIUX),";")=3) D VADPT^TIUVSIT G CLEAN
I +$G(TIUOUT) G CLEAN
I +TIUER!($G(X)["?") G AGN
I +TIUOK,'+$G(TIUNVIS) D
. S TIUX=$G(^TMP("TIUVN",$J,+TIUOK)),^DISV(DUZ,"^AUPNVSIT(")=+TIUX
. W " ",$$DATE^TIULS(+$P(TIUX,U,2),"AMTH DD CCYY@HR:MIN")
VADPT ; Call PATVADPT^TIULV to fill TIUY array
N TIUVSTR
S TIUVSTR=$P(TIUX,U,23)_";"_$P(TIUX,U,2)_";"_$P(TIUX,U,8)
D PATVADPT^TIULV(.TIUY,DFN,"",TIUVSTR)
CLEAN K ^TMP("TIUVN",$J),^TMP("TIUVD",$J),^TMP("TIUVDA",$J)
Q
BREAK ; Handle prompting
N TIUARR,TIUAPT
I TIUII=1 S (TIUOK,X)=1
W !,"CHOOSE 1-",TIUII," or"
S TIUARR("FLDS")="1;",TIUARR(4)=DFN,TIUARR("MAX")=1
S TIUAPT=$$SDAPI^SDAMA301(.TIUARR)
I TIUAPT=-1 D Q
. W !,"An error occurred while accessing the appointments database"
. W !," Please contact IRM!",!
. S (TIUER,TIUOUT)=1
. N X,X1,X2,TIUERR
. S X1=DT,X2=90 D C^%DTC
. S ^XTMP("TIUSDAMA",0)=X_"^"_DT_"^"
. S TIUERR=$O(^TMP($J,"SDAMA301",""))
. S:TIUERR ^XTMP("TIUSDAMA",$$NOW^XLFDT,TIUERR)=$G(^TMP($J,"SDAMA301",TIUERR))
. K ^TMP($J,"SDAMA301")
K ^TMP($J,"SDAMA301")
W:TIUAPT !,"<F>UTURE VISITS, or" W:+LETNEW " <N>EW VISIT"
W:$D(^TMP("TIUVN",$J,TIUII+1)) !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT"
W ": " W:$D(TIUPICK) $P(^TMP("TIUVN",$J,TIUPICK),U),"// " R X:DTIME
S X=$$UP^XLFSTR(X)
I $S('$T:1,X["^":1,1:0) S (TIUER,TIUOUT)=1 Q
S:X=""&$D(TIUPICK) X=TIUPICK
I X["?" D HELP(X) Q
I $E(X)="F" S (TIUFUTUR,TIUOUT)=1 Q
I +LETNEW'>0,(X=""),'$D(^TMP("TIUVN",$J,TIUII+1)) S (TIUER,TIUOUT)=1 Q
I +LETNEW,$S(X="N":1,X="NEW":1,X=""&'$D(^TMP("TIUVN",$J,TIUII+1)):1,1:0) D ADD^TIUVSIT(DFN,.TIUX,$S(X="N":0,X="NEW":0,1:1),.TIUSDC) S TIUVTRY=1 I +$G(TIUX)'>0 S (TIUER,TIUOUT)=1 Q
I $S(X="":1,X="N":1,X="NEW":1,1:0) Q
I X'=+X!'$D(^TMP("TIUVN",$J,+X)) W !!,$C(7),"INVALID RESPONSE",! G BREAK
S TIUOK=X
Q
HELP(X) ; Offer help
W !!?3,"Indicate the visit with which the document is associated by choosing"
W !?3,"the corresponding number. To add a new visit (e.g., for unscheduled or"
W !?3,"telephone contacts), enter ""N"".",!!
Q
WRITE ; Writes each list element
N DIC,DIQ,DA,DR,TIUVISIT,I,J,X,Y
S DIC="^AUPNVSIT(",DIQ="TIUVISIT(",DIQ(0)="IE",DA=+TIUVDA
S DR=".07;.08;.16;.21;.22" D EN^DIQ1
W !,$J(TIUI,4),"> ",$$DATE^TIULS(+TIUVR,"AMTH DD, CCYY@HR:MIN")
W ?27,$E($G(TIUVISIT(9000010,DA,.07,"E")),1,18)
W ?47,$E($S(TIUVISIT(9000010,DA,.22,"E")]"":TIUVISIT(9000010,DA,.22,"E"),1:TIUVISIT(9000010,DA,.08,"E")),1,18)
;W ?67,$E($G(TIUVISIT(9000010,DA,.22,"E")),1,12) I $G(TIUVISIT(9000010,DA,.21,"E"))]"" W !?23,TIUVISIT(9000010,DA,.21,"E")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUVISIT 5108 printed Dec 13, 2024@02:46:27 Page 2
TIUVISIT ; SLC/JER - Visit File look-up ;4/28/99@09:47:44 [1/27/05 12:36pm]
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**39,124,190**;Jun 20, 1997;Build 1
MAIN(TIUY,DFN,TIUSSN,TIUVDT,TIULDT,TIUDFLT,TIUMODE,TIULOC,TIUOCC,LETNEW,FILTER,UNSONLY,TIUFUTUR) ;Control
AGN KILL ^TMP("TIUVN",$JOB),^TMP("TIUVD",$JOB),^TMP("TIUVDA",$JOB)
+1 NEW C,I,N,TIUI,TIUII,TIUVDA,TIUER,TIUOK,TIUX,X,TIUNVIS,TIUVDATE
+2 SET LETNEW=$GET(LETNEW,1)
SET UNSONLY=+$GET(UNSONLY)
+3 if +$GET(DFN)'>0
SET DFN=+$$PATIENT^TIULA($GET(TIUSSN))
IF +DFN'>0
SET TIUOUT=1
QUIT
+4 SET TIUMODE=$GET(TIUMODE,1)
SET TIUOCC=$GET(TIUOCC,20)
+5 SET TIULOC=$SELECT(+$GET(TIULOC):TIULOC,$GET(TIULOC)]"":+$ORDER(^SC("B",TIULOC,0)),1:"")
+6 IF +$GET(TIUVDT)
SET TIUVDATE=(9999999-$PIECE(TIUVDT,"."))_"."_$PIECE(TIUVDT,".",2)
+7 SET TIULDT=$SELECT(+$GET(TIULDT)>0:(9999999-$PIECE(TIULDT,"."))_$SELECT($LENGTH(TIULDT,".")>1:"."_$PIECE(TIULDT,".",2),1:""),+$GET(TIUVDT):(9999999-$PIECE(TIUVDT,"."))_"."_$PIECE($$FMADD^XLFDT(TIUVDT,"","","",-1),".",2),1:0)
+8 IF '+$GET(TIUVDT)
SET TIUVDT=$SELECT(+$GET(TIULDT):(9999999-$PIECE(+$GET(TIUVDT),"."))_"."_$PIECE($$FMADD^XLFDT(+$GET(TIUVDT),"",23,59,59),".",2),+$GET(TIUVDT)>0:(9999999-$PIECE(TIUVDT,"."))_"."_$PIECE($$FMADD^XLFDT(TIUVDT,"","","",1),".",2),1:9999999)
IF 1
+9 IF '$TEST
SET TIUVDT=$GET(TIUVDATE)
+10 IF '$DATA(^AUPNVSIT("AA",DFN))
WRITE !,"No UNSCHEDULED VISITS on file",!
QUIT
+11 SET I=TIULDT
FOR
SET I=$ORDER(^AUPNVSIT("AA",DFN,I))
if +I'>0!(+I>TIUVDT)
QUIT
Begin DoDot:1
+12 NEW N
SET N=0
+13 FOR
SET N=$ORDER(^AUPNVSIT("AA",DFN,I,N))
if +N'>0
QUIT
Begin DoDot:2
+14 NEW D
+15 if $GET(FILTER)'["XD"
SET FILTER=$GET(FILTER)_"XD"
+16 if '$DATA(^AUPNVSIT(+N,0))!(FILTER[$PIECE($GET(^AUPNVSIT(+N,0)),U,7))
QUIT
+17 ; If unscheduled visits only, then omit scheduled visits
+18 IF +UNSONLY
IF $$CHKAPPT^TIUPXAP2(N)
QUIT
+19 SET D=^AUPNVSIT(+N,0)
+20 IF +$GET(TIULOC)>0
IF ($PIECE(D,U,22)'=TIULOC)
QUIT
+21 SET ^TMP("TIUVD",$JOB,(9999999-+D))=N_U_D
End DoDot:2
End DoDot:1
+22 SET (C,I)=0
FOR
SET I=$ORDER(^TMP("TIUVD",$JOB,I))
if +I'>0
QUIT
Begin DoDot:1
+23 SET C=C+1
SET ^TMP("TIUVN",$JOB,C)=$GET(^TMP("TIUVD",$JOB,I))
+24 SET ^TMP("TIUVDA",$JOB,+$GET(^TMP("TIUVD",$JOB,I)))=C
End DoDot:1
+25 IF '+TIUMODE
IF '$DATA(^TMP("TIUVN",$JOB))
QUIT
+26 IF '$DATA(^TMP("TIUVN",$JOB))
QUIT
+27 IF '+TIUMODE
IF $GET(TIUDFLT)="LAST"
Begin DoDot:1
+28 NEW TIUI
SET TIUI=+$ORDER(^TMP("TIUVN",$JOB,0))
+29 SET TIUX=$GET(^TMP("TIUVN",$JOB,+TIUI))
End DoDot:1
if '+TIUX
QUIT
GOTO VADPT
+30 SET (TIUER,TIUOK,TIUI)=0
+31 WRITE !!,"The following",$SELECT(FILTER["H":" UNSCHEDULED",1:"")," VISITS are available:",!
+32 FOR
SET TIUI=$ORDER(^TMP("TIUVN",$JOB,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+33 NEW TIUVR
+34 SET TIUII=TIUI
SET TIUVR=$PIECE(^TMP("TIUVN",$JOB,TIUI),"^",2,20)
SET TIUVDA=+^(TIUI)
+35 DO WRITE
+36 IF '(TIUI#5)
DO BREAK
IF +$GET(TIUX)
IF ($LENGTH($GET(TIUX),";")=3)
DO VADPT^TIUVSIT
SET TIUOUT=1
QUIT
+37 IF $GET(X)["?"
SET X=""
SET TIUI=TIUI-5
End DoDot:1
if +TIUER!+TIUOK!+$GET(TIUOUT)
QUIT
+38 if $DATA(TIUOUT)
GOTO CLEAN
+39 if TIUER
GOTO AGN
+40 IF +$GET(TIUII)#5
DO BREAK
IF +$GET(TIUX)
IF ($LENGTH($GET(TIUX),";")=3)
DO VADPT^TIUVSIT
GOTO CLEAN
+41 IF +$GET(TIUOUT)
GOTO CLEAN
+42 IF +TIUER!($GET(X)["?")
GOTO AGN
+43 IF +TIUOK
IF '+$GET(TIUNVIS)
Begin DoDot:1
+44 SET TIUX=$GET(^TMP("TIUVN",$JOB,+TIUOK))
SET ^DISV(DUZ,"^AUPNVSIT(")=+TIUX
+45 WRITE " ",$$DATE^TIULS(+$PIECE(TIUX,U,2),"AMTH DD CCYY@HR:MIN")
End DoDot:1
VADPT ; Call PATVADPT^TIULV to fill TIUY array
+1 NEW TIUVSTR
+2 SET TIUVSTR=$PIECE(TIUX,U,23)_";"_$PIECE(TIUX,U,2)_";"_$PIECE(TIUX,U,8)
+3 DO PATVADPT^TIULV(.TIUY,DFN,"",TIUVSTR)
CLEAN KILL ^TMP("TIUVN",$JOB),^TMP("TIUVD",$JOB),^TMP("TIUVDA",$JOB)
+1 QUIT
BREAK ; Handle prompting
+1 NEW TIUARR,TIUAPT
+2 IF TIUII=1
SET (TIUOK,X)=1
+3 WRITE !,"CHOOSE 1-",TIUII," or"
+4 SET TIUARR("FLDS")="1;"
SET TIUARR(4)=DFN
SET TIUARR("MAX")=1
+5 SET TIUAPT=$$SDAPI^SDAMA301(.TIUARR)
+6 IF TIUAPT=-1
Begin DoDot:1
+7 WRITE !,"An error occurred while accessing the appointments database"
+8 WRITE !," Please contact IRM!",!
+9 SET (TIUER,TIUOUT)=1
+10 NEW X,X1,X2,TIUERR
+11 SET X1=DT
SET X2=90
DO C^%DTC
+12 SET ^XTMP("TIUSDAMA",0)=X_"^"_DT_"^"
+13 SET TIUERR=$ORDER(^TMP($JOB,"SDAMA301",""))
+14 if TIUERR
SET ^XTMP("TIUSDAMA",$$NOW^XLFDT,TIUERR)=$GET(^TMP($JOB,"SDAMA301",TIUERR))
+15 KILL ^TMP($JOB,"SDAMA301")
End DoDot:1
QUIT
+16 KILL ^TMP($JOB,"SDAMA301")
+17 if TIUAPT
WRITE !,"<F>UTURE VISITS, or"
if +LETNEW
WRITE " <N>EW VISIT"
+18 if $DATA(^TMP("TIUVN",$JOB,TIUII+1))
WRITE !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT"
+19 WRITE ": "
if $DATA(TIUPICK)
WRITE $PIECE(^TMP("TIUVN",$JOB,TIUPICK),U),"// "
READ X:DTIME
+20 SET X=$$UP^XLFSTR(X)
+21 IF $SELECT('$TEST:1,X["^":1,1:0)
SET (TIUER,TIUOUT)=1
QUIT
+22 if X=""&$DATA(TIUPICK)
SET X=TIUPICK
+23 IF X["?"
DO HELP(X)
QUIT
+24 IF $EXTRACT(X)="F"
SET (TIUFUTUR,TIUOUT)=1
QUIT
+25 IF +LETNEW'>0
IF (X="")
IF '$DATA(^TMP("TIUVN",$JOB,TIUII+1))
SET (TIUER,TIUOUT)=1
QUIT
+26 IF +LETNEW
IF $SELECT(X="N":1,X="NEW":1,X=""&'$DATA(^TMP("TIUVN",$JOB,TIUII+1)):1,1:0)
DO ADD^TIUVSIT(DFN,.TIUX,$SELECT(X="N":0,X="NEW":0,1:1),.TIUSDC)
SET TIUVTRY=1
IF +$GET(TIUX)'>0
SET (TIUER,TIUOUT)=1
QUIT
+27 IF $SELECT(X="":1,X="N":1,X="NEW":1,1:0)
QUIT
+28 IF X'=+X!'$DATA(^TMP("TIUVN",$JOB,+X))
WRITE !!,$CHAR(7),"INVALID RESPONSE",!
GOTO BREAK
+29 SET TIUOK=X
+30 QUIT
HELP(X) ; Offer help
+1 WRITE !!?3,"Indicate the visit with which the document is associated by choosing"
+2 WRITE !?3,"the corresponding number. To add a new visit (e.g., for unscheduled or"
+3 WRITE !?3,"telephone contacts), enter ""N"".",!!
+4 QUIT
WRITE ; Writes each list element
+1 NEW DIC,DIQ,DA,DR,TIUVISIT,I,J,X,Y
+2 SET DIC="^AUPNVSIT("
SET DIQ="TIUVISIT("
SET DIQ(0)="IE"
SET DA=+TIUVDA
+3 SET DR=".07;.08;.16;.21;.22"
DO EN^DIQ1
+4 WRITE !,$JUSTIFY(TIUI,4),"> ",$$DATE^TIULS(+TIUVR,"AMTH DD, CCYY@HR:MIN")
+5 WRITE ?27,$EXTRACT($GET(TIUVISIT(9000010,DA,.07,"E")),1,18)
+6 WRITE ?47,$EXTRACT($SELECT(TIUVISIT(9000010,DA,.22,"E")]"":TIUVISIT(9000010,DA,.22,"E"),1:TIUVISIT(9000010,DA,.08,"E")),1,18)
+7 ;W ?67,$E($G(TIUVISIT(9000010,DA,.22,"E")),1,12) I $G(TIUVISIT(9000010,DA,.21,"E"))]"" W !?23,TIUVISIT(9000010,DA,.21,"E")
+8 QUIT
