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