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

ACDDEM.m

Go to the documentation of this file. 
  1. ACDDEM ;IHS/ADC/EDE/KML - DATA ENTRY EDIT MODE;
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;
  1.  ;This is the data entry edit driver routine for CDMIS.  This
  1.  ;routine will ask for COMPONENT CODE/TYPE, then loop within
  1.  ;that component asking for TYPE CONTACT, and then if patient
  1.  ;related it will ask for patient and then date.  If not patient
  1.  ;related it will ask for date.  Once a visit is selected the
  1.  ;user will be able to optionally edit the visit and then the
  1.  ;subordinate file entries attached to the visit.
  1.  ;
  1. EDIT ; EP - EDIT CDMIS FORMS
  1.  S ACDMODE="E"
  1.  D MAIN
  1.  Q
  1.  ;
  1. MAIN ; MAINLINE LOGIC
  1.  D INIT^ACDDE2
  1.  I ACDQ D EOJ Q
  1.  F  D LOOP Q:ACDQ     ; loop within component code/type
  1.  D EOJ
  1.  Q
  1.  ;
  1. LOOP ; LOOP WITHIN COMPONENT CODE/TYPE
  1.  S ACDLPTYP=1
  1.  S (ACDPROV,ACDPROVN)=""
  1.  S (ACDCONT,ACDCONTL)=""
  1.  S (ACDVDTI,ACDVDTE)=""
  1.  S (ACDDFN,ACDDFNP)=""
  1.  D HDR^ACDDEU
  1.  S ACDNODEF=1
  1.  D GETTC^ACDDE2 ;     get type contact
  1.  Q:ACDQ
  1.  I ACDCONT'="IR",ACDCONT'="OT" D GETPAT
  1.  Q:ACDQ
  1.  D VISIT
  1.  S ACDQ=0
  1.  Q
  1.  ;
  1. GETPAT ; GET PATIENT
  1.  S ACDQ=1
  1.  S AUPNLK("ALL")=1
  1.  S DIC="^AUPNPAT(",DIC(0)="AEMQ",DIC("S")="I $D(^ACDVIS(""D"",+Y))" D DIC^ACDFMC
  1.  K AUPNLK("ALL")
  1.  Q:Y<0
  1.  S ACDDFNP=+Y,ACDDFN=$P(^DPT(ACDDFNP,0),U)
  1.  S ACDQ=0
  1.  Q
  1.  ;
  1. VISIT ; EDIT VISIT AND SUBORDINATE FILE ENTRIES
  1.  S DIC="^ACDVIS(",DIC(0)="AMQ",DIC("S")="I $P(^ACDVIS(+Y,0),U,2)=ACDCOMC,$P(^(0),U,7)=ACDCOMT,$P(^(0),U,4)=ACDCONT,'$P(^(0),U,25),$P(^(""BWP""),U)=ACDPGM" S:ACDDFNP DIC("S")=DIC("S")_",$D(^ACDVIS(""D"",ACDDFNP,+Y))"
  1.  D DIC^ACDFMC
  1.  Q:Y<0
  1.  S ACDVIEN=+Y
  1.  I (ACDFHCP+ACDFPCC),$G(ACDDFNP),ACDVIEN S ACDPCCL(ACDDFNP,ACDVIEN)=""
  1.  W !
  1.  D DSPVSIT^ACDDEU(ACDVIEN)
  1.  S DIR(0)="Y",DIR("A")="Do you want to edit the visit record",DIR("B")="NO" K DA D ^DIR K DIR
  1.  D:Y EDVISIT ;              go edit the visit record itself
  1.  D EDTTC ;                  go edit files based on type contact
  1.  I ACDFHCP,$G(ACDDFNP),$D(ACDPCCL(ACDDFNP)) D SAVBILL^ACDDE
  1.  I ACDFPCC,$G(ACDDFNP),$D(ACDPCCL(ACDDFNP)) D ^ACDPCCL
  1.  Q
  1.  ;
  1. EDVISIT ; EDIT CDMIS VISIT RECORD
  1.  I (ACDFHCP+ACDFPCC),$G(ACDDFNP),ACDVIEN S ACDPCCL(ACDDFNP,ACDVIEN)=1
  1.  S DIE="^ACDVIS(",DR="[ACD VISIT EDIT]",DA=ACDVIEN
  1.  D DIE^ACDFMC
  1.  Q
  1.  ;
  1. EDTTC ; EDIT FILES BASED ON TYPE CONTACT
  1.  W !
  1.  D @("EDT"_ACDCONT)
  1.  Q
  1.  ;
  1. EDTIN ; EDIT INITIAL
  1.  D EDTIIF ;            edit CDMIS INIT/INFO/FU
  1.  Q
  1.  ;
  1. EDTRE ; EDIT REOPEN
  1.  D EDTIIF ;            edit CDMIS INIT/INFO/FU
  1.  Q
  1.  ;
  1. EDTFU ; EDIT FOLLOWUP
  1.  D EDTIIF ;            edit CDMIS INIT/INFO/FU
  1.  Q
  1.  ;
  1. EDTTD ; EDIT TRANS/DISC/CLOSE
  1.  D EDTTDC ;           edit CDMIS TRANS/DISC/CLOSE
  1.  Q
  1.  ;
  1. EDTCS ; EDIT CLIENT SERVICE
  1.  D SLCTCS ;           select client service to edit
  1.  Q:'ACDCEIEN
  1.  S DIR(0)="SO^E:Edit;D:Delete",DIR("B")="Edit" K DA D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  I (ACDFHCP+ACDFPCC),$G(ACDDFNP) S ACDPCCL(ACDDFNP,ACDVIEN,"CS",ACDCEIEN)=$S(Y="D":"D",1:"")
  1.  I Y="D" S DIK="^ACDCS(",DA=ACDCEIEN D DIK^ACDFMC Q
  1.  S DIE="^ACDCS(",DR="[ACD CLIENT SVCS EDIT]",DA=ACDCEIEN
  1.  D DIE^ACDFMC
  1.  Q
  1.  ;
  1. SLCTCS ; SELECT ONE CS ENTRY
  1.  S ACDCEIEN=0
  1.  K ^TMP("ACD",$J,"CS"),ACDDDAY
  1.  S ACDVDATE=$P(^ACDVIS(ACDVIEN,0),U)
  1.  S (ACDCSC,Y)=0
  1.  F  S Y=$O(^ACDCS("C",ACDVIEN,Y)) Q:'Y  S X=^ACDCS(Y,0),^TMP("ACD",$J,"CS",$P(X,U),Y)=$P(X,U,2),X=$P(X,U) I '$D(ACDDDAY("DAY",X)) D
  1.  . NEW Y
  1.  . S ACDCSC=ACDCSC+1,ACDDDAY(ACDCSC)=X,Y=ACDVDATE,Y=Y+X
  1.  . D DD^%DT
  1.  . S ACDDDAY("DAY",X)=" <"_Y_">"
  1.  . Q
  1.  S ACDCSCUT=(ACDCSC\2)+(ACDCSC#2)
  1.  F I=1:1 Q:I>ACDCSCUT  S X=ACDDDAY(I) W !?5,I_") DAY "_$J(X,2)_ACDDDAY("DAY",X) S J=I+ACDCSCUT I $D(ACDDDAY(J)) S X=ACDDDAY(J) W ?40,J_") DAY "_$J(X,2)_ACDDDAY("DAY",X)
  1.  W !
  1.  S DIR(0)="NO^1:"_ACDCSC_":0",DIR("A")="Select one CS day" D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S ACDCSDAY=ACDDDAY(Y)
  1.  K ACDVDATE,ACDDDAY
  1.  K ACDX
  1.  S DIR(0)="SO^"
  1.  S ACDLC=0,W=ACDCSDAY S Y=0 F  S Y=$O(^TMP("ACD",$J,"CS",W,Y)) Q:'Y  S ACDLC=ACDLC+1,X=^ACDCS(Y,0),Z=$P(X,U,2),X=+X D PFTV^XBPFTV(9002170.6,Z,.Z) S DIR(0)=DIR(0)_$S($L(DIR(0))=3:"",1:";")_ACDLC_":"_X_" "_Z,ACDX(ACDLC)=Y
  1.  K ACDCSDAY,ACDLC,^TMP("ACD",$J,"CS")
  1.  S DIR("A")="Select one Client Service Entry"
  1.  K DA D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S ACDCEIEN=ACDX(Y)
  1.  Q
  1.  ;
  1. EDTOT ; EDIT CRISIS/BRIED INT
  1.  D EDTIIF ;           edit CDMIS INIT/INFO/FU
  1.  Q
  1.  ;
  1. EDTIR ; EDIT INFO/REFERRAL
  1.  D EDTIIF ;           edit CDMIS INIT/INFO/FU
  1.  Q
  1.  ;
  1. EDTIIF ; EDIT CDMIS INIT/INFO/FU
  1.  S DA=$O(^ACDIIF("C",ACDVIEN,0))
  1.  I 'DA W !,IORVON,"No CDMIS INIT/INFO/FU entry associated with this visit!",IORVOFF,! Q
  1.  I (ACDFHCP+ACDFPCC),$G(ACDDFNP) S ACDPCCL(ACDDFNP,ACDVIEN,"IIF",DA)=""
  1.  S DIE="^ACDIIF(",DR="[ACD INIT/INFO/FU EDIT]"
  1.  D DIE^ACDFMC
  1.  Q
  1.  ;
  1. EDTTDC ; EDIT CDMIS TRANS/DISC/CLOSE
  1.  S DA=$O(^ACDTDC("C",ACDVIEN,0))
  1.  I 'DA W !,IORVON,"No CDMIS TRANS/DISC/CLOSE entry associated with this visit!",IORVOFF,! Q
  1.  I (ACDFHCP+ACDFPCC),$G(ACDDFNP) S ACDPCCL(ACDDFNP,ACDVIEN,"TDC",DA)=""
  1.  S DIE="^ACDTDC(",DR="[ACD TRANS/DISC/CLOSE EDIT]"
  1.  D DIE^ACDFMC
  1.  Q
  1.  ;
  1. EOJ ; END OF JOB
  1.  D ^ACDKILL
  1.  Q