- PXBAPI2 ;ISL/DCM - API for check-out d/t ;7/10/96
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**26**;Aug 12, 1996
- CHIKOUT(ENCOWNTR,DFN,LOC,APTDT) ;Edit check-out date/time
- ; Input - ENCOWNTR - ien of ^SCE(DA,0)
- ; ENCOWNTR optional if DFN,LOC,APTDT params used
- ; DFN - ien of ^DPT(DFN, (only used if no ENCOWNTR)
- ; LOC - ien of ^SC(LOC, (only used if no ENCOWNTR)
- ; APTDT - Appointment Date/time (only used if no ENCOWNTR)
- ; Output - PXCHKOUT = Check out Date/time (-1 if not found or allowed)
- ; External References: ^SCE(DA,0)
- ; ^SC(DA(2),"S",DA(1),1,DA,"C")
- ; ^SC(DA,0)
- N I,XC,X0,ORG,DA,DEF,DEFX,DUOUT,DTOUT,DIRUT,DIROUT S PXCHKOUT=-1
- I $G(ENCOWNTR) Q:'$G(^SCE(+ENCOWNTR,0)) N APTDT,DFN,LOC,END S END=0,X0=^(0) D Q:END G ON
- . S APTDT=+X0,DFN=$P(X0,"^",2),LOC=$P(X0,"^",4),ORG=$P(X0,"^",8),DA=$P(X0,"^",9)
- . I ORG'=1 W !!,$C(7),">>> Only appointments have a check out date to edit." D PAUSE^PXCEHELP S END=1 Q
- . I '$P($G(^SC(LOC,"S",APTDT,1,DA,"C")),"^",3) W !!,$C(7),">>> No check out date for this appointment." D PAUSE^PXCEHELP S END=1 Q
- Q:'$G(DFN) I '$D(^SC(+$G(LOC),"S",+$G(APTDT))) Q ;Invalid input
- S I=0,DA=0 F S I=$O(^SC(LOC,"S",APTDT,1,I)) Q:I<1 I +^(I,0)=DFN S DA=I Q
- Q:'DA
- ON ;
- I APTDT,$P(APTDT,".")>DT W !!,"Check out dates for future appointments not allowed.",!,$C(7) Q
- S XC=$G(^SC(LOC,"S",APTDT,1,DA,"C")),IDT=$P(XC,"^"),(DEF,DEFX)=$P(XC,"^",3)
- ;If this is a CHECKED OUT time set the default to it, otherwise set it to NOW
- I DEF S Y=DEF X ^DD("DD") S DEF=Y
- E S DEF="NOW"
- AGN S PXCHKOUT=$$READ("DO^::EXTR^","Check out date and time",DEF,"^D HELP^%DTC")
- S:PXCHKOUT["^" PXCHKOUT=-1 Q
- I $P(PXCHKOUT,".")>DT W !!,"Check out date cannot be in the future.",!,$C(7) G AGN
- I +XC,PXCHKOUT<+XC W !!,"Check in date must be before Check out date.",!,$C(7) G AGN
- Q
- READ(TYPE,PROMPT,DEFAULT,HELP) ; Calls reader, returns response
- N DIR,DA,X,Y
- S DIR(0)=TYPE,DIR("A")=PROMPT I $D(DEFAULT) S DIR("B")=DEFAULT
- I $D(HELP) S DIR("?")=HELP
- D ^DIR
- Q Y
- TEST ;Test call to CHIKOUT
- N PXIFN S PXIFN=0
- F S PXIFN=$O(^SCE(PXIFN)) Q:PXIFN<1 K PXCHKOUT S DFN=$P(^(PXIFN,0),"^",2) W !!,PXIFN_" "_$P(^DPT(DFN,0),"^") D CHIKOUT(PXIFN) W:$D(PXCHKOUT) !,PXCHKOUT S %=1 W !,"Continue " D YN^DICN Q:%'=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBAPI2 2338 printed Feb 18, 2025@23:52:38 Page 2
- PXBAPI2 ;ISL/DCM - API for check-out d/t ;7/10/96
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**26**;Aug 12, 1996
- CHIKOUT(ENCOWNTR,DFN,LOC,APTDT) ;Edit check-out date/time
- +1 ; Input - ENCOWNTR - ien of ^SCE(DA,0)
- +2 ; ENCOWNTR optional if DFN,LOC,APTDT params used
- +3 ; DFN - ien of ^DPT(DFN, (only used if no ENCOWNTR)
- +4 ; LOC - ien of ^SC(LOC, (only used if no ENCOWNTR)
- +5 ; APTDT - Appointment Date/time (only used if no ENCOWNTR)
- +6 ; Output - PXCHKOUT = Check out Date/time (-1 if not found or allowed)
- +7 ; External References: ^SCE(DA,0)
- +8 ; ^SC(DA(2),"S",DA(1),1,DA,"C")
- +9 ; ^SC(DA,0)
- +10 NEW I,XC,X0,ORG,DA,DEF,DEFX,DUOUT,DTOUT,DIRUT,DIROUT
- SET PXCHKOUT=-1
- +11 IF $GET(ENCOWNTR)
- if '$GET(^SCE(+ENCOWNTR,0))
- QUIT
- NEW APTDT,DFN,LOC,END
- SET END=0
- SET X0=^(0)
- Begin DoDot:1
- +12 SET APTDT=+X0
- SET DFN=$PIECE(X0,"^",2)
- SET LOC=$PIECE(X0,"^",4)
- SET ORG=$PIECE(X0,"^",8)
- SET DA=$PIECE(X0,"^",9)
- +13 IF ORG'=1
- WRITE !!,$CHAR(7),">>> Only appointments have a check out date to edit."
- DO PAUSE^PXCEHELP
- SET END=1
- QUIT
- +14 IF '$PIECE($GET(^SC(LOC,"S",APTDT,1,DA,"C")),"^",3)
- WRITE !!,$CHAR(7),">>> No check out date for this appointment."
- DO PAUSE^PXCEHELP
- SET END=1
- QUIT
- End DoDot:1
- if END
- QUIT
- GOTO ON
- +15 ;Invalid input
- if '$GET(DFN)
- QUIT
- IF '$DATA(^SC(+$GET(LOC),"S",+$GET(APTDT)))
- QUIT
- +16 SET I=0
- SET DA=0
- FOR
- SET I=$ORDER(^SC(LOC,"S",APTDT,1,I))
- if I<1
- QUIT
- IF +^(I,0)=DFN
- SET DA=I
- QUIT
- +17 if 'DA
- QUIT
- ON ;
- +1 IF APTDT
- IF $PIECE(APTDT,".")>DT
- WRITE !!,"Check out dates for future appointments not allowed.",!,$CHAR(7)
- QUIT
- +2 SET XC=$GET(^SC(LOC,"S",APTDT,1,DA,"C"))
- SET IDT=$PIECE(XC,"^")
- SET (DEF,DEFX)=$PIECE(XC,"^",3)
- +3 ;If this is a CHECKED OUT time set the default to it, otherwise set it to NOW
- +4 IF DEF
- SET Y=DEF
- XECUTE ^DD("DD")
- SET DEF=Y
- +5 IF '$TEST
- SET DEF="NOW"
- AGN SET PXCHKOUT=$$READ("DO^::EXTR^","Check out date and time",DEF,"^D HELP^%DTC")
- +1 if PXCHKOUT["^"
- SET PXCHKOUT=-1
- QUIT
- +2 IF $PIECE(PXCHKOUT,".")>DT
- WRITE !!,"Check out date cannot be in the future.",!,$CHAR(7)
- GOTO AGN
- +3 IF +XC
- IF PXCHKOUT<+XC
- WRITE !!,"Check in date must be before Check out date.",!,$CHAR(7)
- GOTO AGN
- +4 QUIT
- READ(TYPE,PROMPT,DEFAULT,HELP) ; Calls reader, returns response
- +1 NEW DIR,DA,X,Y
- +2 SET DIR(0)=TYPE
- SET DIR("A")=PROMPT
- IF $DATA(DEFAULT)
- SET DIR("B")=DEFAULT
- +3 IF $DATA(HELP)
- SET DIR("?")=HELP
- +4 DO ^DIR
- +5 QUIT Y
- TEST ;Test call to CHIKOUT
- +1 NEW PXIFN
- SET PXIFN=0
- +2 FOR
- SET PXIFN=$ORDER(^SCE(PXIFN))
- if PXIFN<1
- QUIT
- KILL PXCHKOUT
- SET DFN=$PIECE(^(PXIFN,0),"^",2)
- WRITE !!,PXIFN_" "_$PIECE(^DPT(DFN,0),"^")
- DO CHIKOUT(PXIFN)
- if $DATA(PXCHKOUT)
- WRITE !,PXCHKOUT
- SET %=1
- WRITE !,"Continue "
- DO YN^DICN
- if %'=1
- QUIT
- +3 QUIT
