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

SDAMWI.m

Go to the documentation of this file. 
  1. SDAMWI ;ALB/MJK - Unscheduled Appointments ; 5/3/05 5:50pm
  1.  ;;5.3;Scheduling;**63,94,241,250,296,380,327,1015**;Aug 13, 1993;Build 21
  1.  ;IHS/ANMC/LJF 7/6/2000 added screen for principal clinics under WI
  1.  ;            11/29/2000 added screen for clinics with prohibited access
  1.  ;            12/07/2000 added last reg update to walkin
  1.  ;             9/10/2001 added IHS1 line label to ask clinic again
  1.  ;
  1. EN(DFN,SC) ; -- main entry point
  1.  ;    input: DFN ; SC := clinic#
  1.  ; returned: success or fail := 1/0
  1.  ;
  1.  N SDY,SDAPTYP,SDRE,SDRE1,SDIN,SDSL,SDD,SDALLE,SDATD,SDDECOD,SDEC,SDEMP,SDOEL,SDPL,SDRT,SDSC,SDTTM,COLLAT,SDX,SDSTART,ORDER,SDREP,SDDA,SDCL
  1.  D 2^VADPT I +VADM(6) W !!?5,*7,"o  Patient has died!" D PAUSE^VALM1 S SDY=0 G ENQ
  1.  S SDCL=SC,SDSL=$S($D(^SC(SC,"SL")):+^("SL"),1:""),SDD=0
  1.  K SDRE,SDIN,SDRE1
  1.  I $D(^SC(SC,"I")) S Y=^("I"),SDIN=+Y,SDRE=+$P(Y,U,2),SDRE1=$$FDATE^VALM1(SDRE)
  1.  I $D(SDIN),SDIN,SDIN'>DT,SDRE,SDRE>DT W !!?5,*7,"o  Clinic is inactive from ",$$FTIME^VALM1(SDIN)," to "_SDRE1 D PAUSE^VALM1 S SDY=0 G ENQ
  1.  I $D(SDIN),SDIN,SDIN'>DT,'SDRE W !!?5,*7,"o  Clinic is inactive as of ",$$FTIME^VALM1(SDIN) D PAUSE^VALM1 S SDY=0 G ENQ
  1.  N SDRES S SDRES=$$CLNCK^SDUTL2(SC,1)
  1.  I 'SDRES W !,?5,*7,"o  Clinic MUST be corrected before continuing." D PAUSE^VALM1 S SDY=0 G ENQ
  1.  I '$$TIME(.DFN,.SC,.SDT) D WL^SDM1(SC) S SDY=0 G ENQ ;SD/327
  1.  S Y=SDT D ^SDM4 I X="^" S SDY=0 G ENQ
  1.  ; ** SD*5.3*250 MT Blocking check removed
  1.  ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T N EASACT S EASACT="W" I $$MT^EASMTCHK(DFN,+$G(SDAPTYP),EASACT) D PAUSE^VALM1 S SDY=0 G ENQ
  1.  ;-- get sub-category for appointment type
  1.  S SDXSCAT=$$SUB^DGSAUTL(SDAPTYP,2,"")
  1.  S SDY=$$MAKE^SDAMWI1(DFN,SDCL,SDT)
  1.  K SDXSCAT
  1. ENQ D KVAR^VADPT
  1.  Q SDY
  1.  ;
  1. TIME(DFN,SC,SDT) ; -- get appt date/time
  1.  ;    input: DFN ; SC := clinic#
  1.  ;   output: SDT := date/time of wi appt
  1.  ; returned: success or fail := 1/0
  1.  ;
  1.  N SDY,%DT
  1. ASK R !!,"APPOINTMENT TIME: NOW// ",X:DTIME S X=$$UPPER^VALM1(X)
  1.  I X["^"!('$T) S SDY=0 G TIMEQ
  1.  I X?.E1"?" D  G ASK
  1.  .W !,"  Enter a time or date@time for the appointment or return for 'NOW'."
  1.  .W !,"The date must be today or earlier."
  1.  S:X=""!(X="N")!(X="NO") X="NOW"
  1.  I X'="NOW",X'["@" S X="T@"_X
  1.  S %DT="TEP",%DT(0)=-(DT+1) D ^%DT G ASK:Y<0 S SDT=Y
  1.  G:'$$CANCHK(.SC,.SDT) ASK
  1.  I $D(^DPT(DFN,"S",SDT,0)) W !?5,*7,"o  Patient already has an appt on ",$$FTIME^VALM1(SDT) G ASK
  1.  S SDY=1
  1. TIMEQ Q SDY
  1.  ;
  1. CANCHK(SC,SDT) ; -- is clinic cancelled for date
  1.  ;    input: SC := clinic# ; SDT := date/time of wi appt
  1.  ; returned: success or fail := 1/0
  1.  ;
  1.  N SDY
  1.  S SDY=1
  1.  I $D(^SC(SC,"ST",$P(SDT,"."))),'$D(^SC(SC,"ST",$P(SDT,"."),"CAN")) G CANCHKQ
  1.  I $D(^SC(SC,"ST",$P(SDT,"."),"CAN")),$G(^SC(SC,"ST",$P(SDT,"."),1))["CANCEL" W !?5,*7,"o  This date's clinic has been cancelled!" S SDY=0 G CANCHKQ
  1.  I $D(^SC(SC,"ST",$P(SDT,"."),"CAN")),$G(^SC(SC,"ST",$P(SDT,"."),1))'["CANCEL" W !?5,*7,"o  Warning: Part of this day's clinic has been cancelled!" G CANCHKQ
  1.  S SDY=$$AVAIL(.SC,.SDT)
  1. CANCHKQ Q SDY
  1.  ;
  1. AVAIL(SC,SDT) ; -- does clinic meet
  1.  ;    input: SC := clinic# ; SDT := date/time of wi appt
  1.  ; returned: success or fail := 1/0
  1.  ;
  1.  N SDY
  1.  S X=$P(SDT,".") D DOW^SDM0
  1.  I $D(^SC(SC,"T"_Y)) S Z=$O(^SC(SC,"T"_Y,DT)) I Z'="",$D(^SC(SC,"T"_Y,Z,1)),^(1)]"" S SDY=1 G AVAILQ
  1.  W !?5,*7,"o  Clinic does not meet on this date!" S SDY=0
  1. AVAILQ Q SDY
  1.  ;
  1. CL(DFN) ; -- make wi appt
  1.  ;    input: DFN
  1.  ; returned: success or fail := 1/0
  1.  ;
  1.  W !?5,"Last Registration Update: ",$$LASTREG^BDGF2(DFN)  ;IHS/ANMC/LJF 12/07/2000
  1. IHS1 ;IHS/ANMC/LJF 9/10/2001 added line label    
  1.  S DIC="^SC(",DIC(0)="AEMQ",DIC("A")="Select Clinic: ",DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS""))"
  1.  S DIC("S")=DIC("S")_",'$D(^SC(""AIHSPC"",+Y))"  ;IHS/ANMC/LJF 7/6/2000
  1.  D ^DIC K DIC
  1.  I Y<0 S SDY=0 G CLQ
  1.  ;
  1.  ;IHS/ANMC/LJF 11/29/2000;9/10/2001
  1.  I $D(^SC(+Y,"SDPROT")),$P(^("SDPROT"),U)="Y",'$D(^SC(+Y,"SDPRIV",DUZ)),'$D(^SC($$PC^BSDU(+Y),"SDPRIV",DUZ)) W !,"Access to ",$$GET1^DIQ(44,+Y,.01)," is prohibited!",!,"Only users with a special code may access this clinic." D PAUSE^BDGF G IHS1
  1.  ;
  1.  S SC=+Y S SDY=$$EN(.DFN,.SC)
  1. CLQ Q SDY
  1.  ;
  1. PT(SC) ;
  1.  ;    input:  SC := clinic#
  1.  ; returned: success or fail := 1/0
  1.  ;
  1.  S DIC="^DPT(",DIC(0)="AEMQ",DIC("A")="Select Patient: "
  1.  D ^DIC K DIC
  1.  I Y<0 S SDY=0 G PTQ
  1.  S DFN=+Y S SDY=$$EN(.DFN,.SC)
  1. PTQ Q SDY
  1.  ;