TIUVSIT1 ; SLC/JER - Visit look-up (cont'd) ;4/29/99@11:51:42 [1/18/05 9:22am]
;;1.0;TEXT INTEGRATION UTILITIES;**39,179,190,221**;Jun 20, 1997;Build 2
NOTFOUND() ; Ask <U>NSCHEDULED or <F>UTURE
N TIUY
W !,"CHOOSE <U>NSCHEDULED VISITS, <F>UTURE VISITS, or <N>EW VISIT"
W !,"<RETURN> TO CONTINUE"
S TIUY=$$READ^TIUU("FOA","OR '^' TO QUIT: ","","^D HELP^TIUVSITH(""?"")")
Q TIUY
GETAPPT(DFN,CLINIC,OCCLIM,INDEX,COUNT,LAST,EARLY,FUTURE) ; Get list
; of appointments
N TIUCNT,TIUI,TIUSREC,TIUJ,TIUFLIM,TIUARRAY,LATE,TIUK,TIUNUM
I '$D(TIUPRM0) D SETPARM^TIULE
S TIUFLIM=$S(+$P(TIUPRM0,U,14)>0&+$G(FUTURE):$P(TIUPRM0,U,14),1:1)
S OCCLIM=$S(+$G(OCCLIM):+$G(OCCLIM),1:20)
S:'+$G(DT) DT=$$DT^XLFDT
S EARLY=+$G(EARLY)
S LATE=$S(+$G(INDEX):+$G(INDEX),1:$$FMADD^XLFDT(DT,TIUFLIM)_"."_235959)
S (LAST,TIUCNT,TIUK)=0,TIUJ=$S(+$G(COUNT):+$G(COUNT),1:0)
S TIUARRAY(1)=EARLY_";"_LATE
I $G(EARLY)=0 S TIUARRAY(1)=";"_LATE
S TIUARRAY(4)=DFN
S TIUARRAY("SORT")="P"
S TIUARRAY("FLDS")="1;2;3;10;12;22"
S TIUNUM=$$SDAPI^SDAMA301(.TIUARRAY) Q:'TIUNUM
S TIUI=LATE+.000001
I TIUNUM=-1 D Q
. S ^TMP("TIUVERR",$J)="Could not retrieve patient information due to a problem with the database."
. I $D(^TMP($J,"SDAMA301",115)) S ^TMP("TIUVERR",$J,115)="This patient may not have an assigned ICN."
;VMP/ELR ADDED NEXT LINE PATCH TIU 1 221 DBIA 3356 FOR XQY0
I $G(TIUNUM)>1,$G(XQY0)["TIU UPLOAD DOCUMENTS" N TIUONEC S TIUONEC=$$CLCNT()
F S TIUI=$O(^TMP($J,"SDAMA301",DFN,TIUI),-1) S:+TIUI'>0 LAST=1 Q:+TIUI'>0!(+TIUCNT'<OCCLIM)!(+TIUI<EARLY) D
. N APPTDT,APPTCL,APPTST,APPTTY,OPENC,STATUS
. ;VMP/ELR ADDED NEXT LINE PATCH TIU 1 221
. I $G(XQY0)["TIU UPLOAD DOCUMENTS",$G(TIUNUM)>1,$G(TIUONEC)>1,$L(TIUVDT),TIUVDT'=TIUI Q
. S TIUCNT=+$G(TIUCNT)+1,TIUJ=+$G(TIUJ)+1
. S APPTCL=$P(^TMP($J,"SDAMA301",DFN,TIUI),U,2)
. S APPTST=$P(^TMP($J,"SDAMA301",DFN,TIUI),U,3)
. S APPTTY=$P(^TMP($J,"SDAMA301",DFN,TIUI),U,10)
. S OPENC=$P(^TMP($J,"SDAMA301",DFN,TIUI),U,12)
. S STATUS=$P(^TMP($J,"SDAMA301",DFN,TIUI),U,22)
. I +$G(CLINIC),(+APPTCL'=+CLINIC) Q
. ;Set up internal value array
. S ^TMP("TIUVNI",$J,TIUJ)=TIUI_U_+APPTCL
. I $P(APPTST,";")="R" S ^TMP("TIUVNI",$J,TIUJ)=^TMP("TIUVNI",$J,TIUJ)_U
. I $P(APPTST,";")'="R" S ^TMP("TIUVNI",$J,TIUJ)=^TMP("TIUVNI",$J,TIUJ)_U_$P(APPTST,";")
. S ^TMP("TIUVNI",$J,TIUJ)=^TMP("TIUVNI",$J,TIUJ)_U_+APPTTY
. S ^TMP("TIUVNI",$J,TIUJ)=^TMP("TIUVNI",$J,TIUJ)_U_$G(OPENC)
. ;Set up external value array
. S ^TMP("TIUVN",$J,TIUJ)=$$DATE^TIULS(TIUI,"AMTH DD, CCYY@HR:MIN")
. S ^TMP("TIUVN",$J,TIUJ)=^TMP("TIUVN",$J,TIUJ)_U_$P(APPTCL,";",2)
. S ^TMP("TIUVN",$J,TIUJ)=^TMP("TIUVN",$J,TIUJ)_U_$P(STATUS,";",3)
. S ^TMP("TIUVN",$J,TIUJ)=^TMP("TIUVN",$J,TIUJ)_U_$P(APPTTY,";",2)
. ;Set up index by date
. S ^TMP("TIUVDT",$J,TIUI)=TIUJ
. ;Set up array of appts to exclude dup visit creation if appt is for today
. I $P(APPTST,";")="R" S ^TMP("TIUNOT",$J,+$P($G(^TMP($J,"SDAMA301",DFN,TIUI)),U,2),+TIUI)=TIUJ
K ^TMP($J,"SDAMA301")
Q
;VMP/ELR ADDED NEXT TAG PATCH TIU 1 221
CLCNT() ;
N TIUICL,TIUCNT S TIUICL=TIUI,TIUCNT=0
F S TIUICL=$O(^TMP($J,"SDAMA301",DFN,TIUICL),-1) Q:+TIUICL'>0!(+TIUICL<EARLY) D
. I +$P(^TMP($J,"SDAMA301",DFN,TIUICL),U,2)=$G(CLINIC) S TIUCNT=TIUCNT+1
Q TIUCNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUVSIT1 3301 printed Apr 09, 2024@21:47:40 Page 2
TIUVSIT1 ; SLC/JER - Visit look-up (cont'd) ;4/29/99@11:51:42 [1/18/05 9:22am]
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**39,179,190,221**;Jun 20, 1997;Build 2
NOTFOUND() ; Ask <U>NSCHEDULED or <F>UTURE
+1 NEW TIUY
+2 WRITE !,"CHOOSE <U>NSCHEDULED VISITS, <F>UTURE VISITS, or <N>EW VISIT"
+3 WRITE !,"<RETURN> TO CONTINUE"
+4 SET TIUY=$$READ^TIUU("FOA","OR '^' TO QUIT: ","","^D HELP^TIUVSITH(""?"")")
+5 QUIT TIUY
GETAPPT(DFN,CLINIC,OCCLIM,INDEX,COUNT,LAST,EARLY,FUTURE) ; Get list
+1 ; of appointments
+2 NEW TIUCNT,TIUI,TIUSREC,TIUJ,TIUFLIM,TIUARRAY,LATE,TIUK,TIUNUM
+3 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+4 SET TIUFLIM=$SELECT(+$PIECE(TIUPRM0,U,14)>0&+$GET(FUTURE):$PIECE(TIUPRM0,U,14),1:1)
+5 SET OCCLIM=$SELECT(+$GET(OCCLIM):+$GET(OCCLIM),1:20)
+6 if '+$GET(DT)
SET DT=$$DT^XLFDT
+7 SET EARLY=+$GET(EARLY)
+8 SET LATE=$SELECT(+$GET(INDEX):+$GET(INDEX),1:$$FMADD^XLFDT(DT,TIUFLIM)_"."_235959)
+9 SET (LAST,TIUCNT,TIUK)=0
SET TIUJ=$SELECT(+$GET(COUNT):+$GET(COUNT),1:0)
+10 SET TIUARRAY(1)=EARLY_";"_LATE
+11 IF $GET(EARLY)=0
SET TIUARRAY(1)=";"_LATE
+12 SET TIUARRAY(4)=DFN
+13 SET TIUARRAY("SORT")="P"
+14 SET TIUARRAY("FLDS")="1;2;3;10;12;22"
+15 SET TIUNUM=$$SDAPI^SDAMA301(.TIUARRAY)
if 'TIUNUM
QUIT
+16 SET TIUI=LATE+.000001
+17 IF TIUNUM=-1
Begin DoDot:1
+18 SET ^TMP("TIUVERR",$JOB)="Could not retrieve patient information due to a problem with the database."
+19 IF $DATA(^TMP($JOB,"SDAMA301",115))
SET ^TMP("TIUVERR",$JOB,115)="This patient may not have an assigned ICN."
End DoDot:1
QUIT
+20 ;VMP/ELR ADDED NEXT LINE PATCH TIU 1 221 DBIA 3356 FOR XQY0
+21 IF $GET(TIUNUM)>1
IF $GET(XQY0)["TIU UPLOAD DOCUMENTS"
NEW TIUONEC
SET TIUONEC=$$CLCNT()
+22 FOR
SET TIUI=$ORDER(^TMP($JOB,"SDAMA301",DFN,TIUI),-1)
if +TIUI'>0
SET LAST=1
if +TIUI'>0!(+TIUCNT'<OCCLIM)!(+TIUI<EARLY)
QUIT
Begin DoDot:1
+23 NEW APPTDT,APPTCL,APPTST,APPTTY,OPENC,STATUS
+24 ;VMP/ELR ADDED NEXT LINE PATCH TIU 1 221
+25 IF $GET(XQY0)["TIU UPLOAD DOCUMENTS"
IF $GET(TIUNUM)>1
IF $GET(TIUONEC)>1
IF $LENGTH(TIUVDT)
IF TIUVDT'=TIUI
QUIT
+26 SET TIUCNT=+$GET(TIUCNT)+1
SET TIUJ=+$GET(TIUJ)+1
+27 SET APPTCL=$PIECE(^TMP($JOB,"SDAMA301",DFN,TIUI),U,2)
+28 SET APPTST=$PIECE(^TMP($JOB,"SDAMA301",DFN,TIUI),U,3)
+29 SET APPTTY=$PIECE(^TMP($JOB,"SDAMA301",DFN,TIUI),U,10)
+30 SET OPENC=$PIECE(^TMP($JOB,"SDAMA301",DFN,TIUI),U,12)
+31 SET STATUS=$PIECE(^TMP($JOB,"SDAMA301",DFN,TIUI),U,22)
+32 IF +$GET(CLINIC)
IF (+APPTCL'=+CLINIC)
QUIT
+33 ;Set up internal value array
+34 SET ^TMP("TIUVNI",$JOB,TIUJ)=TIUI_U_+APPTCL
+35 IF $PIECE(APPTST,";")="R"
SET ^TMP("TIUVNI",$JOB,TIUJ)=^TMP("TIUVNI",$JOB,TIUJ)_U
+36 IF $PIECE(APPTST,";")'="R"
SET ^TMP("TIUVNI",$JOB,TIUJ)=^TMP("TIUVNI",$JOB,TIUJ)_U_$PIECE(APPTST,";")
+37 SET ^TMP("TIUVNI",$JOB,TIUJ)=^TMP("TIUVNI",$JOB,TIUJ)_U_+APPTTY
+38 SET ^TMP("TIUVNI",$JOB,TIUJ)=^TMP("TIUVNI",$JOB,TIUJ)_U_$GET(OPENC)
+39 ;Set up external value array
+40 SET ^TMP("TIUVN",$JOB,TIUJ)=$$DATE^TIULS(TIUI,"AMTH DD, CCYY@HR:MIN")
+41 SET ^TMP("TIUVN",$JOB,TIUJ)=^TMP("TIUVN",$JOB,TIUJ)_U_$PIECE(APPTCL,";",2)
+42 SET ^TMP("TIUVN",$JOB,TIUJ)=^TMP("TIUVN",$JOB,TIUJ)_U_$PIECE(STATUS,";",3)
+43 SET ^TMP("TIUVN",$JOB,TIUJ)=^TMP("TIUVN",$JOB,TIUJ)_U_$PIECE(APPTTY,";",2)
+44 ;Set up index by date
+45 SET ^TMP("TIUVDT",$JOB,TIUI)=TIUJ
+46 ;Set up array of appts to exclude dup visit creation if appt is for today
+47 IF $PIECE(APPTST,";")="R"
SET ^TMP("TIUNOT",$JOB,+$PIECE($GET(^TMP($JOB,"SDAMA301",DFN,TIUI)),U,2),+TIUI)=TIUJ
End DoDot:1
+48 KILL ^TMP($JOB,"SDAMA301")
+49 QUIT
+50 ;VMP/ELR ADDED NEXT TAG PATCH TIU 1 221
CLCNT() ;
+1 NEW TIUICL,TIUCNT
SET TIUICL=TIUI
SET TIUCNT=0
+2 FOR
SET TIUICL=$ORDER(^TMP($JOB,"SDAMA301",DFN,TIUICL),-1)
if +TIUICL'>0!(+TIUICL<EARLY)
QUIT
Begin DoDot:1
+3 IF +$PIECE(^TMP($JOB,"SDAMA301",DFN,TIUICL),U,2)=$GET(CLINIC)
SET TIUCNT=TIUCNT+1
End DoDot:1
+4 QUIT TIUCNT
