Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUVISIT

TIUVISIT.m

Go to the documentation of this file. 
  1. 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
  1. MAIN(TIUY,DFN,TIUSSN,TIUVDT,TIULDT,TIUDFLT,TIUMODE,TIULOC,TIUOCC,LETNEW,FILTER,UNSONLY,TIUFUTUR) ;Control
  1. AGN K ^TMP("TIUVN",$J),^TMP("TIUVD",$J),^TMP("TIUVDA",$J)
  1.  N C,I,N,TIUI,TIUII,TIUVDA,TIUER,TIUOK,TIUX,X,TIUNVIS,TIUVDATE
  1.  S LETNEW=$G(LETNEW,1),UNSONLY=+$G(UNSONLY)
  1.  S:+$G(DFN)'>0 DFN=+$$PATIENT^TIULA($G(TIUSSN)) I +DFN'>0 S TIUOUT=1 Q
  1.  S TIUMODE=$G(TIUMODE,1),TIUOCC=$G(TIUOCC,20)
  1.  S TIULOC=$S(+$G(TIULOC):TIULOC,$G(TIULOC)]"":+$O(^SC("B",TIULOC,0)),1:"")
  1.  I +$G(TIUVDT) S TIUVDATE=(9999999-$P(TIUVDT,"."))_"."_$P(TIUVDT,".",2)
  1.  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)
  1.  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
  1.  E  S TIUVDT=$G(TIUVDATE)
  1.  I '$D(^AUPNVSIT("AA",DFN)) W !,"No UNSCHEDULED VISITS on file",! Q
  1.  S I=TIULDT F  S I=$O(^AUPNVSIT("AA",DFN,I)) Q:+I'>0!(+I>TIUVDT)  D
  1.  . N N S N=0
  1.  . F  S N=$O(^AUPNVSIT("AA",DFN,I,N)) Q:+N'>0  D
  1.  . . N D
  1.  . . S:$G(FILTER)'["XD" FILTER=$G(FILTER)_"XD"
  1.  . . Q:'$D(^AUPNVSIT(+N,0))!(FILTER[$P($G(^AUPNVSIT(+N,0)),U,7))
  1.  . . ; If unscheduled visits only, then omit scheduled visits
  1.  . . I +UNSONLY,$$CHKAPPT^TIUPXAP2(N) Q
  1.  . . S D=^AUPNVSIT(+N,0)
  1.  . . I +$G(TIULOC)>0,($P(D,U,22)'=TIULOC) Q
  1.  . . S ^TMP("TIUVD",$J,(9999999-+D))=N_U_D
  1.  S (C,I)=0 F  S I=$O(^TMP("TIUVD",$J,I)) Q:+I'>0  D
  1.  . S C=C+1,^TMP("TIUVN",$J,C)=$G(^TMP("TIUVD",$J,I))
  1.  . S ^TMP("TIUVDA",$J,+$G(^TMP("TIUVD",$J,I)))=C
  1.  I '+TIUMODE,'$D(^TMP("TIUVN",$J)) Q
  1.  I '$D(^TMP("TIUVN",$J)) Q
  1.  I '+TIUMODE,$G(TIUDFLT)="LAST" D  Q:'+TIUX  G VADPT
  1.  . N TIUI S TIUI=+$O(^TMP("TIUVN",$J,0))
  1.  . S TIUX=$G(^TMP("TIUVN",$J,+TIUI))
  1.  S (TIUER,TIUOK,TIUI)=0
  1.  W !!,"The following",$S(FILTER["H":" UNSCHEDULED",1:"")," VISITS are available:",!
  1.  F  S TIUI=$O(^TMP("TIUVN",$J,TIUI)) Q:+TIUI'>0  D  Q:+TIUER!+TIUOK!+$G(TIUOUT)
  1.  . N TIUVR
  1.  . S TIUII=TIUI,TIUVR=$P(^TMP("TIUVN",$J,TIUI),"^",2,20),TIUVDA=+^(TIUI)
  1.  . D WRITE
  1.  . I '(TIUI#5) D BREAK I +$G(TIUX),($L($G(TIUX),";")=3) D VADPT^TIUVSIT S TIUOUT=1 Q
  1.  . I $G(X)["?" S X="",TIUI=TIUI-5
  1.  G:$D(TIUOUT) CLEAN
  1.  G AGN:TIUER
  1.  I +$G(TIUII)#5 D BREAK I +$G(TIUX),($L($G(TIUX),";")=3) D VADPT^TIUVSIT G CLEAN
  1.  I +$G(TIUOUT) G CLEAN
  1.  I +TIUER!($G(X)["?") G AGN
  1.  I +TIUOK,'+$G(TIUNVIS) D
  1.  . S TIUX=$G(^TMP("TIUVN",$J,+TIUOK)),^DISV(DUZ,"^AUPNVSIT(")=+TIUX
  1.  . W "  ",$$DATE^TIULS(+$P(TIUX,U,2),"AMTH DD CCYY@HR:MIN")
  1. VADPT ; Call PATVADPT^TIULV to fill TIUY array
  1.  N TIUVSTR
  1.  S TIUVSTR=$P(TIUX,U,23)_";"_$P(TIUX,U,2)_";"_$P(TIUX,U,8)
  1.  D PATVADPT^TIULV(.TIUY,DFN,"",TIUVSTR)
  1. CLEAN K ^TMP("TIUVN",$J),^TMP("TIUVD",$J),^TMP("TIUVDA",$J)
  1.  Q
  1. BREAK ; Handle prompting
  1.  N TIUARR,TIUAPT
  1.  I TIUII=1 S (TIUOK,X)=1
  1.  W !,"CHOOSE 1-",TIUII," or"
  1.  S TIUARR("FLDS")="1;",TIUARR(4)=DFN,TIUARR("MAX")=1
  1.  S TIUAPT=$$SDAPI^SDAMA301(.TIUARR)
  1.  I TIUAPT=-1 D  Q
  1.  . W !,"An error occurred while accessing the appointments database"
  1.  . W !,"    Please contact IRM!",!
  1.  . S (TIUER,TIUOUT)=1
  1.  . N X,X1,X2,TIUERR
  1.  . S X1=DT,X2=90 D C^%DTC
  1.  . S ^XTMP("TIUSDAMA",0)=X_"^"_DT_"^"
  1.  . S TIUERR=$O(^TMP($J,"SDAMA301",""))
  1.  . S:TIUERR ^XTMP("TIUSDAMA",$$NOW^XLFDT,TIUERR)=$G(^TMP($J,"SDAMA301",TIUERR))
  1.  . K ^TMP($J,"SDAMA301")
  1.  K ^TMP($J,"SDAMA301")
  1.  W:TIUAPT !,"<F>UTURE VISITS, or" W:+LETNEW " <N>EW VISIT"
  1.  W:$D(^TMP("TIUVN",$J,TIUII+1)) !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT"
  1.  W ": " W:$D(TIUPICK) $P(^TMP("TIUVN",$J,TIUPICK),U),"// " R X:DTIME
  1.  S X=$$UP^XLFSTR(X)
  1.  I $S('$T:1,X["^":1,1:0) S (TIUER,TIUOUT)=1 Q
  1.  S:X=""&$D(TIUPICK) X=TIUPICK
  1.  I X["?" D HELP(X) Q
  1.  I $E(X)="F" S (TIUFUTUR,TIUOUT)=1 Q
  1.  I +LETNEW'>0,(X=""),'$D(^TMP("TIUVN",$J,TIUII+1)) S (TIUER,TIUOUT)=1 Q
  1.  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
  1.  I $S(X="":1,X="N":1,X="NEW":1,1:0) Q
  1.  I X'=+X!'$D(^TMP("TIUVN",$J,+X)) W !!,$C(7),"INVALID RESPONSE",! G BREAK
  1.  S TIUOK=X
  1.  Q
  1. HELP(X) ; Offer help
  1.  W !!?3,"Indicate the visit with which the document is associated by choosing"
  1.  W !?3,"the corresponding number.  To add a new visit (e.g., for unscheduled or"
  1.  W !?3,"telephone contacts), enter ""N"".",!!
  1.  Q
  1. WRITE ; Writes each list element
  1.  N DIC,DIQ,DA,DR,TIUVISIT,I,J,X,Y
  1.  S DIC="^AUPNVSIT(",DIQ="TIUVISIT(",DIQ(0)="IE",DA=+TIUVDA
  1.  S DR=".07;.08;.16;.21;.22" D EN^DIQ1
  1.  W !,$J(TIUI,4),">  ",$$DATE^TIULS(+TIUVR,"AMTH DD, CCYY@HR:MIN")
  1.  W ?27,$E($G(TIUVISIT(9000010,DA,.07,"E")),1,18)
  1.  W ?47,$E($S(TIUVISIT(9000010,DA,.22,"E")]"":TIUVISIT(9000010,DA,.22,"E"),1:TIUVISIT(9000010,DA,.08,"E")),1,18)
  1.  ;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")
  1.  Q