TIUVSIT1 ; SLC/JER - Visit look-up (cont'd) ;31-Dec-2012 15:46;DU
;;1.0;TEXT INTEGRATION UTILITIES;**39,179,1007,190,221,1011**;Jun 20, 1997;Build 13
;IHS/MSC/MGH IHS appointment lookup added for mod after patch 179
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
D GETAPPT^BTIUVSIT(DFN,$G(CLINIC),$G(OCCLIM),$G(INDEX),$G(COUNT),$G(LAST),$G(EARLY)) Q ;IHS/ITSC/LJF 02/27/2003
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
TIUVSIT1 ; SLC/JER - Visit look-up (cont'd) ;31-Dec-2012 15:46;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**39,179,1007,190,221,1011**;Jun 20, 1997;Build 13
+2 ;IHS/MSC/MGH IHS appointment lookup added for mod after patch 179
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 ;IHS/ITSC/LJF 02/27/2003
DO GETAPPT^BTIUVSIT(DFN,$GET(CLINIC),$GET(OCCLIM),$GET(INDEX),$GET(COUNT),$GET(LAST),$GET(EARLY))
QUIT
+3 NEW TIUCNT,TIUI,TIUSREC,TIUJ,TIUFLIM,TIUARRAY,LATE,TIUK,TIUNUM
+4 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+5 SET TIUFLIM=$SELECT(+$PIECE(TIUPRM0,U,14)>0&+$GET(FUTURE):$PIECE(TIUPRM0,U,14),1:1)
+6 SET OCCLIM=$SELECT(+$GET(OCCLIM):+$GET(OCCLIM),1:20)
+7 IF '+$GET(DT)
SET DT=$$DT^XLFDT
+8 SET EARLY=+$GET(EARLY)
+9 SET LATE=$SELECT(+$GET(INDEX):+$GET(INDEX),1:$$FMADD^XLFDT(DT,TIUFLIM)_"."_235959)
+10 SET (LAST,TIUCNT,TIUK)=0
SET TIUJ=$SELECT(+$GET(COUNT):+$GET(COUNT),1:0)
+11 SET TIUARRAY(1)=EARLY_";"_LATE
+12 IF $GET(EARLY)=0
SET TIUARRAY(1)=";"_LATE
+13 SET TIUARRAY(4)=DFN
+14 SET TIUARRAY("SORT")="P"
+15 SET TIUARRAY("FLDS")="1;2;3;10;12;22"
+16 SET TIUNUM=$$SDAPI^SDAMA301(.TIUARRAY)
IF 'TIUNUM
QUIT
+17 SET TIUI=LATE+.000001
+18 IF TIUNUM=-1
Begin DoDot:1
+19 SET ^TMP("TIUVERR",$JOB)="Could not retrieve patient information due to a problem with the database."
+20 IF $DATA(^TMP($JOB,"SDAMA301",115))
SET ^TMP("TIUVERR",$JOB,115)="This patient may not have an assigned ICN."
End DoDot:1
QUIT
+21 ;VMP/ELR ADDED NEXT LINE PATCH TIU 1 221 DBIA 3356 FOR XQY0
+22 IF $GET(TIUNUM)>1
IF $GET(XQY0)["TIU UPLOAD DOCUMENTS"
NEW TIUONEC
SET TIUONEC=$$CLCNT()
+23 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
+24 NEW APPTDT,APPTCL,APPTST,APPTTY,OPENC,STATUS
+25 ;VMP/ELR ADDED NEXT LINE PATCH TIU 1 221
+26 IF $GET(XQY0)["TIU UPLOAD DOCUMENTS"
IF $GET(TIUNUM)>1
IF $GET(TIUONEC)>1
IF $LENGTH(TIUVDT)
IF TIUVDT'=TIUI
QUIT
+27 SET TIUCNT=+$GET(TIUCNT)+1
SET TIUJ=+$GET(TIUJ)+1
+28 SET APPTCL=$PIECE(^TMP($JOB,"SDAMA301",DFN,TIUI),U,2)
+29 SET APPTST=$PIECE(^TMP($JOB,"SDAMA301",DFN,TIUI),U,3)
+30 SET APPTTY=$PIECE(^TMP($JOB,"SDAMA301",DFN,TIUI),U,10)
+31 SET OPENC=$PIECE(^TMP($JOB,"SDAMA301",DFN,TIUI),U,12)
+32 SET STATUS=$PIECE(^TMP($JOB,"SDAMA301",DFN,TIUI),U,22)
+33 IF +$GET(CLINIC)
IF (+APPTCL'=+CLINIC)
QUIT
+34 ;Set up internal value array
+35 SET ^TMP("TIUVNI",$JOB,TIUJ)=TIUI_U_+APPTCL
+36 IF $PIECE(APPTST,";")="R"
SET ^TMP("TIUVNI",$JOB,TIUJ)=^TMP("TIUVNI",$JOB,TIUJ)_U
+37 IF $PIECE(APPTST,";")'="R"
SET ^TMP("TIUVNI",$JOB,TIUJ)=^TMP("TIUVNI",$JOB,TIUJ)_U_$PIECE(APPTST,";")
+38 SET ^TMP("TIUVNI",$JOB,TIUJ)=^TMP("TIUVNI",$JOB,TIUJ)_U_+APPTTY
+39 SET ^TMP("TIUVNI",$JOB,TIUJ)=^TMP("TIUVNI",$JOB,TIUJ)_U_$GET(OPENC)
+40 ;Set up external value array
+41 SET ^TMP("TIUVN",$JOB,TIUJ)=$$DATE^TIULS(TIUI,"AMTH DD, CCYY@HR:MIN")
+42 SET ^TMP("TIUVN",$JOB,TIUJ)=^TMP("TIUVN",$JOB,TIUJ)_U_$PIECE(APPTCL,";",2)
+43 SET ^TMP("TIUVN",$JOB,TIUJ)=^TMP("TIUVN",$JOB,TIUJ)_U_$PIECE(STATUS,";",3)
+44 SET ^TMP("TIUVN",$JOB,TIUJ)=^TMP("TIUVN",$JOB,TIUJ)_U_$PIECE(APPTTY,";",2)
+45 ;Set up index by date
+46 SET ^TMP("TIUVDT",$JOB,TIUI)=TIUJ
+47 ;Set up array of appts to exclude dup visit creation if appt is for today
+48 IF $PIECE(APPTST,";")="R"
SET ^TMP("TIUNOT",$JOB,+$PIECE($GET(^TMP($JOB,"SDAMA301",DFN,TIUI)),U,2),+TIUI)=TIUJ
End DoDot:1
+49 KILL ^TMP($JOB,"SDAMA301")
+50 QUIT
+51 ;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
