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

ACDDE3A.m

Go to the documentation of this file. 
  1. ACDDE3A ;IHS/ADC/EDE/KML - DATA ENTRY/CHECK CONTACT TYPES;
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;
  1. CHKRE ; EP - CHECK REOPEN
  1.  ; ADD MODE
  1.  ; should have been a t/d/c, may have followups
  1.  S ACDX="A",ACDQ=0
  1.  F  S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX),-1) Q:ACDX=""  D  Q:ACDQ
  1.  . Q:ACDX>ACDVDTI  ;       ignore later dates
  1.  . S ACDY="A"
  1.  . F  S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY),-1) Q:'ACDY  D  Q:ACDQ
  1.  .. S X=^ACDVIS(ACDY,0)
  1.  .. I $P(X,U,2)=ACDCOMC,$P(X,U,7)=ACDCOMT,$P(X,U,4)="TD" S ACDQ=1 Q
  1.  .. Q
  1.  . Q:ACDQ
  1.  . S ACDY="A"
  1.  . F  S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY),-1) Q:'ACDY  D  Q:ACDQ
  1.  .. S X=^ACDVIS(ACDY,0)
  1.  .. I $P(X,U,2)=ACDCOMC,$P(X,U,7)=ACDCOMT,$P(X,U,4)'="FU" S ACDQ=1 Q
  1.  .. Q
  1.  . Q
  1.  S ACDQ=0
  1.  I ACDY,$P(X,U,4)'="TD" W !,IORVON,"Last non-followup CDMIS VISIT for component ",ACDCOMCL,"/",ACDCOMTL,!,"on or prior to ",ACDVDTE," was not a TRANS/DISC/CLOSE.",IORVOFF,! D DSPVSIT^ACDDEU(ACDY) D  Q
  1.  . S DIR(0)="Y",DIR("A")="Do you want to add this CDMIS VISIT anyway",DIR("B")="N" K DA D ^DIR K DIR
  1.  . S:'Y ACDQ=1
  1.  . Q
  1.  S ACDFLG=0
  1.  I ACDY S ACDX=ACDX-1 F  S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX)) Q:ACDX=""  D  Q:ACDQ
  1.  . S ACDY=+ACDY F  S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY)) Q:'ACDY  D  Q:ACDQ
  1.  .. S X=^ACDVIS(ACDY,0)
  1.  .. I $P(X,U,2)=ACDCOMC,$P(X,U,7)=ACDCOMT D  Q
  1.  ... I $P(X,U,4)="TD" S ACDFLG=1,ACDQ=1 Q
  1.  ... I $P(X,U,4)="RE" S ACDFLG=2,ACDQ=1 Q
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  S ACDQ=0
  1.  I ACDFLG W !,IORVON,"Subsequent ",$S(ACDFLG=1:"TRANS/DISC/CLOSE",1:"REOPEN")," CDMIS VISIT for component ",ACDCOMCL,"/",ACDCOMTL,!,"after ",ACDVDTE,".",IORVOFF,! D
  1.  . D DSPHIST^ACDDEU
  1.  . S DIR(0)="Y",DIR("A")="Do you want to add this CDMIS VISIT anyway",DIR("B")="N" K DA D ^DIR K DIR
  1.  . S:'Y ACDQ=2
  1.  . Q
  1.  Q:ACDQ
  1.  Q
  1.  ;
  1. CHKFU ; EP - CHECK FOLLOWUP
  1.  ; ADD MODE
  1.  ; should have been a t/d/c, may have followups
  1.  S ACDX=""
  1.  F  S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX),-1) Q:ACDX=""  D  Q:ACDQ
  1.  . Q:ACDX>ACDVDTI  ;       ignore later dates
  1.  . S ACDY="A"
  1.  . F  S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY),-1) Q:'ACDY  D  Q:ACDQ
  1.  .. S X=^ACDVIS(ACDY,0)
  1.  .. I $P(X,U,2)=ACDCOMC,$P(X,U,7)=ACDCOMT,$P(X,U,4)'="FU" S ACDQ=1 Q
  1.  .. Q
  1.  . Q
  1.  S ACDQ=0
  1.  I ACDY,$P(X,U,4)'="TD" W !,IORVON,"Last non-followup CDMIS VISIT for component ",ACDCOMCL,"/",ACDCOMTL,!,"was not a TRANS/DISC/CLOSE.",IORVOFF,! D DSPVSIT^ACDDEU(ACDY) D  Q
  1.  . S DIR(0)="Y",DIR("A")="Do you want to add this CDMIS VISIT anyway",DIR("B")="N" K DA D ^DIR K DIR
  1.  . S:'Y ACDQ=1
  1.  . Q
  1.  Q
  1.  ;
  1. CHKTD ; EP - CHECK TRANS/DISC/CLOSE
  1.  ; ADD MODE
  1.  ; should be initial or reopen with no t/d/c
  1.  S ACDX="A"
  1.  F  S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX),-1) Q:ACDX=""  D  Q:ACDQ
  1.  . Q:ACDX>ACDVDTI  ;       ignore later dates
  1.  . S ACDY="A"
  1.  . F  S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY),-1) Q:'ACDY  D  Q:ACDQ
  1.  .. S X=^ACDVIS(ACDY,0)
  1.  .. I $P(X,U,2)=ACDCOMC,$P(X,U,7)=ACDCOMT,($P(X,U,4)="TD"!($P(X,U,4)="IN")!($P(X,U,4)="RE")) S ACDQ=1 Q
  1.  .. Q
  1.  . Q
  1.  S ACDQ=0
  1.  I 'ACDY W !,IORVON,"Impossible error in ADDTD^ACDDE.  Notify programmer.",IORVOFF,!! S ACDQ=1 S:$D(^%ZOSF("$ZE")) X="CDMIS VISIT",@^("$ZE") D @^%ZOSF("ERRTN") D PAUSE^ACDDEU Q  ;    should have been caught by CHKFIN
  1.  I $P(X,U,4)="TD" W !,IORVON,"There is already a TRANS/DISC/CLOSE CDMIS VISIT for component",!,ACDCOMCL,"/",ACDCOMTL," on or before ",ACDVDTE,".",IORVOFF,! D DSPVSIT^ACDDEU(ACDY),PAUSE^ACDDEU S ACDQ=1 Q
  1.  I ACDY S ACDX=ACDX-1 F  S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX)) Q:ACDX=""  D  Q:ACDQ
  1.  . S ACDY=+ACDY F  S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY)) Q:'ACDY  D  Q:ACDQ
  1.  .. S X=^ACDVIS(ACDY,0)
  1.  .. I $P(X,U,2)=ACDCOMC,$P(X,U,7)=ACDCOMT D  Q
  1.  ... I $P(X,U,4)="TD" S ACDQ=1 Q
  1.  ... I $P(X,U,4)="RE" S ACDY=0,ACDQ=1 Q
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  S ACDQ=0
  1.  I ACDY W !,IORVON,"Subsequent TRANS/DISC/CLOSE CDMIS VISIT for component ",ACDCOMCL,"/",ACDCOMTL,!,"after ",ACDVDTE,".",IORVOFF,! D
  1.  . D DSPHIST^ACDDEU
  1.  . S DIR(0)="Y",DIR("A")="Do you want to add this CDMIS VISIT anyway",DIR("B")="N" K DA D ^DIR K DIR
  1.  . S:'Y ACDQ=2
  1.  . Q
  1.  Q:ACDQ
  1.  Q
  1.  ;
  1. CHKCS ; EP - CHECK CLIENT SERVICE
  1.  ; ADD MODE
  1.  ; should be initial or reopen with no t/d/c
  1.  S ACDX="A",ACDLI="",ACDLT=""
  1.  F  S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX),-1) Q:ACDX=""  D  Q:ACDQ
  1.  . Q:$E(ACDX,1,5)>$E(ACDVDTI,1,5)  ;       ignore later months
  1.  . S ACDY="A"
  1.  . F  S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY),-1) Q:'ACDY  D  I ACDLI]"",ACDLT]"" S ACDQ=1 Q
  1.  .. S X=^ACDVIS(ACDY,0)
  1.  .. I $P(X,U,2)=ACDCOMC,$P(X,U,7)=ACDCOMT D  Q
  1.  ... I $P(X,U,4)="TD" S ACDLT=ACDX Q
  1.  ... I $P(X,U,4)="IN"!($P(X,U,4)="RE") S ACDLI=ACDX Q
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  S ACDQ=0
  1.  I ACDLT>ACDLI,$E(ACDLT,1,5)<$E(ACDVDTI,1,5) W !,IORVON,"There is a TRANS/DISC/CLOSE CDMIS VISIT for component",!,ACDCOMCL,"/",ACDCOMTL," before ",ACDVDTE,".",IORVOFF,! D DSPVSIT^ACDDEU(ACDY),PAUSE^ACDDEU S ACDQ=1 Q
  1.  ;I ACDLT>ACDLI W !,IORVON,"Not an open component.",IORVOFF S DIR(0)="Y",DIR("A")="Are you sure you want to add CS to this component",DIR("B")="Y" K DA D ^DIR K DIR I 'Y S ACDQ=1 Q
  1.  Q