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

AMHVRL2.m

Go to the documentation of this file.
  1. AMHVRL2 ; IHS/CMI/LAB - DEMO/APPTS ACTION ;
  1. ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1. ;
  1. SENDPAT ;EP - called from protocol
  1. D FULL^VALM1
  1. S AMHVSAV=DFN
  1. S Y=DFN D ^AUPNPAT
  1. I '$$PKGCK^AMHVU("LROW","LAB VERSION 5.2") Q
  1. Q:'$G(DFN)
  1. I '$D(^AMHSITE(DUZ(2),14,"B",DUZ)) W !!,$C(7),$C(7),"I am sorry, you do not have access to this option. See your supervisor." H 2 Q
  1. D SENDPAT^LRORD
  1. S DFN=AMHVSAV
  1. D RESET^AMHVRL
  1. Q
  1. APPT(DFN) ;EP; called by AMHV APPT protocol
  1. NEW AUPNPAT,AUPNSEX,AUPNDOB,AUPNDOD
  1. S AMHVSAV=DFN
  1. S Y=DFN D ^AUPNPAT
  1. I $T(EN1^SDAM)]"" Q:'$G(DFN) S SDY=DFN_";DPT(" D EN1^SDAM S (DFN,AMHPAT)=AMHVSAV Q
  1. I '$$PKGCK^AMHVU("ASDI","SCHEDULING VERSION 5.0") Q
  1. Q:'$G(DFN)
  1. ;
  1. NEW DIR,I,DIRUT
  1. D ^XBCLS
  1. D MSG^AMHVU($$SP(10)_"SCHEDULING ACTIONS AVAILABLE",2,2,0)
  1. S DIR(0)="NO^1:4",DIR("A")="Select Action by number"
  1. F I=1:1:4 S DIR("A",I)=$P($T(CHOICE+I),";;",2)
  1. D ^DIR K DIR Q:$D(DIRUT) D @Y G MENU
  1. ;
  1. 1 ; -- make appt
  1. NEW SDPEP,SDMM,DIC
  1. D MSG^AMHVU($$SP(10)_"Make Appointment for "_$$NAME,2,2,0)
  1. S SDPEP=1,SDMM=0 D EN1^SDM S DFN=AMHVSAV
  1. Q
  1. ;
  1. 2 ; -- cancel appt
  1. NEW SDPEP,DA,NAME
  1. D MSG^AMHVU($$SP(10)_"Cancel Appointment for "_$$NAME,2,2,0)
  1. S SDPEP=1,DA=DFN,NAME=$$NAME D EN^SDCNP S DFN=AMHVSAV
  1. Q
  1. ;
  1. 3 ; -- check-in/walkin
  1. NEW SDPEP,DIV
  1. S SDPEP=1 D PAT2^ASDI,RETURN^AMHVU S DFN=AMHVSAV
  1. Q
  1. ;
  1. 4 ; -- display appts
  1. NEW SDPEP,HDT,APL,SDRG,SDEDT,OTH,SDEND,DA,NAME
  1. S SDPEP=1,NAME=$$NAME,HDT=DT,(APL,SDEDT,OTH)="",(SDRG,SDEND)=0
  1. S DA=DFN D RD1^SDDPA,RETURN^AMHVU S DFN=AMHVSAV
  1. Q
  1. ;
  1. HDR ; -- print header
  1. NEW X
  1. S X=IOUON_$$PAD($$SP(10)_"APPOINTMENTS"_$$SP(8)_$$NOW,77)_IOUOFF
  1. D MSG^AMHVU(X,1,0,0)
  1. D MSG^AMHVU($$SP(10)_$$CONFID^AMHVU("Patient"),0,0,0)
  1. D MSG^AMHVU($$NAME_$$SP(5)_$$HRCN,1,0,0)
  1. D MSG^AMHVU($$REPEAT^XLFSTR("_",80),1,1,0)
  1. Q
  1. ;
  1. NOW() ; -- returns readable now
  1. Q $$FMTE^XLFDT($$NOW^XLFDT,1)
  1. ;
  1. NAME() ; -- returns printable name
  1. Q $$VAL^XBDIQ1(9000001,DFN,.01)
  1. ;
  1. HRCN() ; -- returns chart # for this facility
  1. Q "#"_$P($G(^AUPNPAT(DFN,41,+DUZ(2),0)),U,2)
  1. ;
  1. PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
  1. Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
  1. ;
  1. SP(NUM) ; -- SUBRTN to pad spaces
  1. Q $$PAD(" ",NUM)
  1. ;
  1. PIMS ;
  1. Q:'$G(DFN)
  1. D EN1^SDAM
  1. Q
  1. CHOICE ;;
  1. ;; 1. MAKE APPOINTMENT
  1. ;; 2. CANCEL APPOINTMENT
  1. ;; 3. CHECK-IN/WALK-IN/CHART REQUEST
  1. ;; 4. DISPLAY APPOINTMENT