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

SDAMEX.m

Go to the documentation of this file. 
  1. SDAMEX ;ALB/MJK,RMO - Appointment Check In/Check Out ; 12/1/91
  1.  ;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21
  1.  ;
  1. EN ; -- main entry point
  1.  N SDATA,SDTOT,DFN,SDACT,SDATE,SDT,SDCL,SDDA,SDASH,SDAMDD,SDMAX
  1.  I '$$INIT G ENQ
  1.  S SDACT=$$ASK(DT) G ENQ:SDACT']""
  1.  F  Q:'$$DATE(.SDATE)  K SDCL D  Q:SDTOT'<SDMAX
  1.  .F  Q:'$$CLINIC(SDATE,.SDCL)  K DFN D  Q:SDTOT'<SDMAX
  1.  ..F  Q:'$$PAT(.SDATE,.SDCL,SDACT,.DFN,.SDT,.SDDA)  D  Q:SDTOT'<SDMAX
  1.  ...S SDTOT=SDTOT+$$CK^SDAMEX1(DFN,SDCL,SDT,SDDA,SDACT)
  1.  W !!?5,"Total Appointments Processed: ",SDTOT
  1. ENQ Q
  1.  ;
  1. INIT() ; -- set up vars
  1.  S SDTOT=0,SDMAX=9999,$P(SDASH,"_",IOM)="",SDAMDD=$P(^DD(2.98,3,0),U,3)
  1.  Q 1
  1.  ;
  1. ASK(SDDT) ; -- select appt CI or CO
  1.  N DIR,DIRUT,DTOUT,DUOUT,Y
  1.  S DIR(0)="SB^CI:Check In;CO:Check Out"
  1.  S DIR("A")="Select Appointment Check In or Check Out"
  1.  S:$G(SDDT) DIR("B")=$S($$REQ^SDM1A(SDDT)="CO":"Check Out",1:"Check In")
  1.  W ! D ^DIR S:$D(DIRUT) Y=""
  1.  Q $G(Y)
  1.  ;
  1. DATE(SDATE) ; -- get appt date
  1.  ;    input: none
  1.  ;   output: SDATE := appt date selected
  1.  ; returned: date selected [1 := yes | 0 := no]
  1.  ;
  1.  S DIR(0)="DO^:"_DT_":EPX",DIR("A")=$S($D(SDATE):"Next ",1:"")_"Appointment Date"
  1.  S:'$D(SDATE) DIR("B")="TODAY"
  1.  W ! D ^DIR K DIR S SDATE=Y
  1.  Q $S($D(DIRUT):0,Y:1,1:0)
  1.  ;
  1. CLINIC(SDATE,SDCL) ; -- get clinic
  1.  ;    input: SDATE := appt date selected
  1.  ;   output: SDCL := ifn of selected clinic
  1.  ; returned: clinic selected [1 := yes | 0 := no]
  1.  ;
  1.  N X,Y,SDDEF
  1. CL W !,$S($D(SDCL):"Next",1:"Select")_" Clinic: "
  1.  S SDDEF=$S($P($O(^SC(+$G(^DISV(DUZ,"^SC(")),"S",SDATE)),".")=SDATE:+$G(^DISV(DUZ,"^SC(")),1:0)
  1.  I '$D(SDCL),$G(^SC(SDDEF,0))]"" W $P(^(0),U)_"// "
  1.  R X:DTIME
  1.  I X="",SDDEF,'$D(SDCL) S X="`"_SDDEF
  1.  I "^"[X S SDCL=0 G CLINICQ
  1.  S:X?1" "1N.N X="`"_$E(X,2,99)
  1.  S DIC(0)="NEMQ",DIC="^SC("
  1.  S DIC("S")="I $P(^(0),U,3)[""C"",$P($O(^(""S"",SDATE)),""."")=SDATE"
  1.  D ^DIC K DIC G CL:Y<1 S SDCL=+Y
  1. CLINICQ Q SDCL>0
  1.  ;
  1. PAT(SDATE,SDCL,SDACT,DFN,SDT,SDDA) ; -- ask for pats & get appt
  1.  ;    input: SDATE := appt date
  1.  ;            SDCL := ifn of clinic
  1.  ;           SDACT := action CI or CO
  1.  ;   output:   DFN 
  1.  ;             SDT := appt date/time
  1.  ;            SDDA := ifn of ^sc multiple
  1.  ; returned: appt selected [1 := yes | 0 := no]
  1.  ;
  1.  N X,SDCNT,SDLCNT,SDAPPT
  1. PT W !,SDASH S (SDDA,SDT)=0
  1.  W !!,$S($D(DFN):"Next",1:"Select")_" Patient: " R X:DTIME G PATQ:"^"[X
  1.  IF X["?" D PTHLP(SDCL,SDATE) G PT
  1.  D RT S DIC="^DPT(",DIC(0)="QEM" D ^DIC K DIC G PT:Y<1
  1.  S DFN=+Y
  1.  S (SDLCNT,SDCNT)=$$LIST(.DFN,.SDCL,.SDATE,.SDAPPT)
  1.  I 'SDCNT W !?7,"o  No appointments for this patient.",*7 G PT
  1.  I SDCNT>1 D  G PT:'SDCNT
  1.  .S DIR(0)="N^1:"_SDCNT,SDCNT=0,DIR("A")="Select Appointment" D ^DIR K DIR S SDCNT=+Y
  1.  I $D(SDAPPT(SDCNT)) D  G PT:'SDDA
  1.  .S SDT=+SDAPPT(SDCNT),SDDA=+$P(SDAPPT(SDCNT),U,2),SDATA=$G(^DPT(DFN,"S",SDT,0))
  1.  .I SDLCNT>1 W ! D PRT
  1.  .I 'SDDA K SDAPPT W !?7,"o  This appointment cannot be checked ",$S(SDACT="CO":"out",1:"in"),".",*7
  1. PATQ Q SDDA>0
  1.  ;
  1. LIST(DFN,SDCL,SDATE,SDAPPT) ;
  1.  ;    input: DFN
  1.  ;             SDCL := ifn of clinic
  1.  ;            SDATE := appt date ; SDCL := ifn of clinic
  1.  ;   output  SDAPPT := array of choices (appt d/t ^ multiple ifn)
  1.  ; returned: count of appts for date
  1.  ;
  1.  N SDCNT
  1.  W !!?5,"Clinic",?30,"Appointment Date/Time",?55,"Status"
  1.  W !?5,"------",?30,"---------------------",?55,"------"
  1.  S SDT=SDATE,DATE=0,SDCNT=0
  1.  F  S SDT=$O(^DPT(DFN,"S",SDT)) Q:'SDT!(SDT>(SDATE_".2359"))  I $D(^(SDT,0)) S SDATA=^(0) I SDCL=+SDATA D
  1.  .S SDCNT=SDCNT+1,SDAPPT(SDCNT)=SDT_U_+$$FIND^SDAM2(DFN,SDT,SDCL)
  1.  .D PRT
  1. LISTQ Q SDCNT
  1.  ;
  1. PRT W !?1,SDCNT,?5,$E($P($G(^SC(SDCL,0)),U),1,25),?30,$$FTIME^VALM1(SDT),?55,$P($$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA),";",3)
  1.  Q
  1.  ;
  1. RT ; -- is this a rt rec
  1.  N C
  1.  I X?.N1"/"1N.ANP S C=$$CHAR($E(X,1,$L(X)-1)) I C]"",C=$E(X,$L(X)),$D(^RT(+$P(X,"/",2),0)),$P(^(0),U,9) S X="`"_+$P(^(0),U,9)
  1.  Q
  1. CHAR(X) ; -- char checksum for code 39
  1.  N C,Z,I,Y
  1.  S C="",Z="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%"
  1.  F I=1:1:$L(X) S Y=$F(Z,$E(X,I))-2 Q:Y<0  S C=C+Y
  1.  Q $S(Y'<0:$E(Z,(C#43)+1),1:"")
  1.  ;
  1. PTHLP(SDCL,START) ;
  1.  N END,SDT,SDDA,SDATA,SDCNT,X,DFN,SDESC,VA
  1.  S END=START+.2359,SDCNT=0,SDESC=0
  1.  W !,"The following appointments are listed for the clinic on the selected date:"
  1.  F SDT=START:0 S SDT=$O(^SC(SDCL,"S",SDT)) Q:'SDT!(SDT>END)  D  Q:SDESC
  1.  .S SDDA=0 F  S SDDA=$O(^SC(SDCL,"S",SDT,1,SDDA)) Q:'SDDA  S X=^SC(SDCL,"S",SDT,1,SDDA,0) D  Q:SDESC
  1.  ..S DFN=+X,SDATA=$G(^DPT(DFN,"S",SDT,0))
  1.  ..I SDCL=+SDATA,$$VALID^SDAM2(DFN,SDCL,SDT,SDDA) S SDCNT=SDCNT+1 D PID^VADPT6 D
  1.  ...W !,$E($P($G(^DPT(DFN,0)),U),1,20),?21,VA("BID"),?30,$$FTIME^VALM1(SDT),?55,$P($$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA),";",3)
  1.  ...I '(SDCNT#20) S DIR(0)="E" D ^DIR K DIR S SDESC='Y
  1.  I SDCNT=0 W !!?5,"...There are no appointments for this clinic on this date.",*7
  1.  Q