SCENI01 ;ALB/SCK - INCOMPLETE ENCOUNTER MGMT MAIN LM DISPLAY PROTOCOLS; 07-MAY-1997 ; 07 May 99 9:45 PM
;;5.3;Scheduling;**66,194,323**;AUG 13, 1993
;
ASKDT(SDT) ; Ask for begin and end date for search
; Variable Input
; SDT - Returns Begin date^End date
;
; Returns
; 0 - No dates selected
; 1 - Dates selected
;
N X,SDT1
S SDT1=$G(SDT)
;
S X=$P($G(^DG(43,1,"SCLR")),U,12)
S SDBDT=$$FMADD^XLFDT($$DT^XLFDT,-X)
;
W !!,"Date Range for Encounters"
S DIR(0)="DA^2961001:NOW:EXP",DIR("A")="Enter begin date for search: "
S DIR("?")="^D HELP^%DTC"
S DIR("B")=$$FMTE^XLFDT(SDBDT)
D ^DIR K DIR
I $D(DIRUT) S SDT="" G DTQ ; SD*5.3*323 Change K SDT to S SDT=""
K DIRUT,DIR
S SDT=Y
;
S DIR(0)="DA^2961001:NOW:EXP",DIR("A")="Enter end date for search: "
S DIR("B")="TODAY"
D ^DIR K DIR
I $D(DIRUT) S SDT="" G DTQ ; SD*5.3*323 Change K SDT to S SDT=""
S SDT=SDT_U_Y
DTQ S X=1
I SDT1,'$D(SDT) S SDT=SDT1,X=0
I SDT=SDT1 S X=0
Q X
;
CCLN ; Change Clinic
K DIRUT
D FULL^VALM1
S VALMBCK="R"
W !
S VAUTNI=2
S DIR(0)="P^44:EMZ",DIR("A")="Select Clinic"
S DIR("S")="I $$CLINIC^SDAMU(Y),$S(VAUTD:1,$D(VAUTD(+$P(^SC(Y,0),U,15))):1,'$P(^(0),U,15)&$D(VAUTD(+$O(^DG(40.8,0)))):1,1:0)"
D ^DIR K DIR
I $D(DIRUT) D Q
. W !,"Clinic has not been changed"
. D PAUSE^VALM1
K SDFN,VAUTC
S SDENTYP="C",VAUTC=0,VAUTC(+Y)=$P(^SC(+Y,0),U)
D HDR^SCENI0,INIT^SCENI0
Q
;
CPAT ; Change Patient
D FULL^VALM1
S VALMBCK="R"
W !
S DIR(0)="P^2:EM"
S DIR("A")="Select Patient"
D ^DIR K DIR
I $D(DIRUT) D Q
. W !,"Patient was not changed."
. D PAUSE^VALM1
K VAUTC
S VAUTC=1,SDENTYP="P",SDFN=+Y
D HDR^SCENI0,INIT^SCENI0
Q
;
CDT ; Change Date range
N SCOK
D FULL^VALM1
S VALMBCK="R"
I '$$ASKDT(.SDDT) D Q
. W !,"Date range has not been changed"
. D PAUSE^VALM1
D HDR^SCENI0,INIT^SCENI0
Q
;
CER ; Change Error Code
D FULL^VALM1
S VALMBCK="R"
W !
S DIR(0)="P^409.76:EM"
S DIR("A")="Select New Error"
D ^DIR K DIR
I $D(DIRUT) D Q
. W !,"Error Code has not been changed"
. D PAUSE^VALM1
S SDEVAL=+Y,SDENTYP="E"
D HDR^SCENI0,INIT^SCENI0
Q
;
DSPLYER ; Display transmission errors
N SDXPTR
;
S LINENBR=$$SELXENC
I $D(SDXPTR) D
. S VALMBCK=""
. D EN^SCENIA0
. S VALMBCK="R"
. D SELECT^VALM10(LINENBR,1) ; This line will hilight the entry and not rebuild the list
K SDXPTR,LINENBR
Q
;
EXP ; Expand enounter using the Appointment Management Expand protocol.
; This protocol uses the SDAMIDX Tmp global, so if this global already
; exisits (IEMM LM being called from inside Apt. Manager) save off the
; existing global before proceeding, and restore it before returning.
;
K ^TMP("SCENI TMP",$J)
I $D(^TMP("SDAMIDX",$J)) D
. M ^TMP("SCENI TMP",$J)=^TMP("SDAMIDX",$J)
;
K ^TMP("SDAMIDX",$J)
M ^TMP("SDAMIDX",$J)=^TMP("SCENIDX",$J)
K ^TMP("SDAMEP",$J)
S VALMBCK=""
D SEL^SDAMEP G EXPQ:'$D(SDW)!(SDERR)
N SDWIDTH,SDPT,SDSC,SDXMT,SCINF
;
S SDXMT=$O(^TMP("SCENI",$J,"XMT",SDW,0))
I $$OPENC^SCUTIE1(SDXMT,"SCINF")>-1,SCINF("AE") D G EXPQ
. W !!,$C(7),"This encounter is not an appointment, and cannot be expanded."
. W !,"Press any key to continue..."
. S DIR(0)="FAO" D ^DIR K DIR
;
W ! D WAIT^DICD,EN^VALM("SDAM APPT PROFILE")
S VALMBCK="R"
;
EXPQ K ^TMP("SDCOIDX",$J),^TMP("SDAMIDX",$J)
I $D(^TMP("SCENI TMP",$J)) D
. M ^TMP("SDAMIDX",$J)=^TMP("SCENI TMP",$J)
. K ^TMP("SCENI TMP",$J)
Q
;
SELXENC() ; Select transmitted encounter to display errors if no encounter passed in.
N VALMI,VALMAT,VALMY
;
D FULL^VALM1
D EN^VALM2(XQORNOD(0),"S") S VALMI=0
I '$D(VALMY) S VALMBCK="R" Q 0
S SDN1="",SDN2=$O(VALMY(SDN1))
S SDXPTR="",SDXPTR=$O(^TMP("SCENI",$J,"XMT",SDN2,SDXPTR))
Q +SDN2
;
EXIT ;
I $D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2)
K SDBT,SDEDT,SDN1,SDN2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCENI01 3959 printed Dec 13, 2024@02:39:45 Page 2
SCENI01 ;ALB/SCK - INCOMPLETE ENCOUNTER MGMT MAIN LM DISPLAY PROTOCOLS; 07-MAY-1997 ; 07 May 99 9:45 PM
+1 ;;5.3;Scheduling;**66,194,323**;AUG 13, 1993
+2 ;
ASKDT(SDT) ; Ask for begin and end date for search
+1 ; Variable Input
+2 ; SDT - Returns Begin date^End date
+3 ;
+4 ; Returns
+5 ; 0 - No dates selected
+6 ; 1 - Dates selected
+7 ;
+8 NEW X,SDT1
+9 SET SDT1=$GET(SDT)
+10 ;
+11 SET X=$PIECE($GET(^DG(43,1,"SCLR")),U,12)
+12 SET SDBDT=$$FMADD^XLFDT($$DT^XLFDT,-X)
+13 ;
+14 WRITE !!,"Date Range for Encounters"
+15 SET DIR(0)="DA^2961001:NOW:EXP"
SET DIR("A")="Enter begin date for search: "
+16 SET DIR("?")="^D HELP^%DTC"
+17 SET DIR("B")=$$FMTE^XLFDT(SDBDT)
+18 DO ^DIR
KILL DIR
+19 ; SD*5.3*323 Change K SDT to S SDT=""
IF $DATA(DIRUT)
SET SDT=""
GOTO DTQ
+20 KILL DIRUT,DIR
+21 SET SDT=Y
+22 ;
+23 SET DIR(0)="DA^2961001:NOW:EXP"
SET DIR("A")="Enter end date for search: "
+24 SET DIR("B")="TODAY"
+25 DO ^DIR
KILL DIR
+26 ; SD*5.3*323 Change K SDT to S SDT=""
IF $DATA(DIRUT)
SET SDT=""
GOTO DTQ
+27 SET SDT=SDT_U_Y
DTQ SET X=1
+1 IF SDT1
IF '$DATA(SDT)
SET SDT=SDT1
SET X=0
+2 IF SDT=SDT1
SET X=0
+3 QUIT X
+4 ;
CCLN ; Change Clinic
+1 KILL DIRUT
+2 DO FULL^VALM1
+3 SET VALMBCK="R"
+4 WRITE !
+5 SET VAUTNI=2
+6 SET DIR(0)="P^44:EMZ"
SET DIR("A")="Select Clinic"
+7 SET DIR("S")="I $$CLINIC^SDAMU(Y),$S(VAUTD:1,$D(VAUTD(+$P(^SC(Y,0),U,15))):1,'$P(^(0),U,15)&$D(VAUTD(+$O(^DG(40.8,0)))):1,1:0)"
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
Begin DoDot:1
+10 WRITE !,"Clinic has not been changed"
+11 DO PAUSE^VALM1
End DoDot:1
QUIT
+12 KILL SDFN,VAUTC
+13 SET SDENTYP="C"
SET VAUTC=0
SET VAUTC(+Y)=$PIECE(^SC(+Y,0),U)
+14 DO HDR^SCENI0
DO INIT^SCENI0
+15 QUIT
+16 ;
CPAT ; Change Patient
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 WRITE !
+4 SET DIR(0)="P^2:EM"
+5 SET DIR("A")="Select Patient"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
Begin DoDot:1
+8 WRITE !,"Patient was not changed."
+9 DO PAUSE^VALM1
End DoDot:1
QUIT
+10 KILL VAUTC
+11 SET VAUTC=1
SET SDENTYP="P"
SET SDFN=+Y
+12 DO HDR^SCENI0
DO INIT^SCENI0
+13 QUIT
+14 ;
CDT ; Change Date range
+1 NEW SCOK
+2 DO FULL^VALM1
+3 SET VALMBCK="R"
+4 IF '$$ASKDT(.SDDT)
Begin DoDot:1
+5 WRITE !,"Date range has not been changed"
+6 DO PAUSE^VALM1
End DoDot:1
QUIT
+7 DO HDR^SCENI0
DO INIT^SCENI0
+8 QUIT
+9 ;
CER ; Change Error Code
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 WRITE !
+4 SET DIR(0)="P^409.76:EM"
+5 SET DIR("A")="Select New Error"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
Begin DoDot:1
+8 WRITE !,"Error Code has not been changed"
+9 DO PAUSE^VALM1
End DoDot:1
QUIT
+10 SET SDEVAL=+Y
SET SDENTYP="E"
+11 DO HDR^SCENI0
DO INIT^SCENI0
+12 QUIT
+13 ;
DSPLYER ; Display transmission errors
+1 NEW SDXPTR
+2 ;
+3 SET LINENBR=$$SELXENC
+4 IF $DATA(SDXPTR)
Begin DoDot:1
+5 SET VALMBCK=""
+6 DO EN^SCENIA0
+7 SET VALMBCK="R"
+8 ; This line will hilight the entry and not rebuild the list
DO SELECT^VALM10(LINENBR,1)
End DoDot:1
+9 KILL SDXPTR,LINENBR
+10 QUIT
+11 ;
EXP ; Expand enounter using the Appointment Management Expand protocol.
+1 ; This protocol uses the SDAMIDX Tmp global, so if this global already
+2 ; exisits (IEMM LM being called from inside Apt. Manager) save off the
+3 ; existing global before proceeding, and restore it before returning.
+4 ;
+5 KILL ^TMP("SCENI TMP",$JOB)
+6 IF $DATA(^TMP("SDAMIDX",$JOB))
Begin DoDot:1
+7 MERGE ^TMP("SCENI TMP",$JOB)=^TMP("SDAMIDX",$JOB)
End DoDot:1
+8 ;
+9 KILL ^TMP("SDAMIDX",$JOB)
+10 MERGE ^TMP("SDAMIDX",$JOB)=^TMP("SCENIDX",$JOB)
+11 KILL ^TMP("SDAMEP",$JOB)
+12 SET VALMBCK=""
+13 DO SEL^SDAMEP
if '$DATA(SDW)!(SDERR)
GOTO EXPQ
+14 NEW SDWIDTH,SDPT,SDSC,SDXMT,SCINF
+15 ;
+16 SET SDXMT=$ORDER(^TMP("SCENI",$JOB,"XMT",SDW,0))
+17 IF $$OPENC^SCUTIE1(SDXMT,"SCINF")>-1
IF SCINF("AE")
Begin DoDot:1
+18 WRITE !!,$CHAR(7),"This encounter is not an appointment, and cannot be expanded."
+19 WRITE !,"Press any key to continue..."
+20 SET DIR(0)="FAO"
DO ^DIR
KILL DIR
End DoDot:1
GOTO EXPQ
+21 ;
+22 WRITE !
DO WAIT^DICD
DO EN^VALM("SDAM APPT PROFILE")
+23 SET VALMBCK="R"
+24 ;
EXPQ KILL ^TMP("SDCOIDX",$JOB),^TMP("SDAMIDX",$JOB)
+1 IF $DATA(^TMP("SCENI TMP",$JOB))
Begin DoDot:1
+2 MERGE ^TMP("SDAMIDX",$JOB)=^TMP("SCENI TMP",$JOB)
+3 KILL ^TMP("SCENI TMP",$JOB)
End DoDot:1
+4 QUIT
+5 ;
SELXENC() ; Select transmitted encounter to display errors if no encounter passed in.
+1 NEW VALMI,VALMAT,VALMY
+2 ;
+3 DO FULL^VALM1
+4 DO EN^VALM2(XQORNOD(0),"S")
SET VALMI=0
+5 IF '$DATA(VALMY)
SET VALMBCK="R"
QUIT 0
+6 SET SDN1=""
SET SDN2=$ORDER(VALMY(SDN1))
+7 SET SDXPTR=""
SET SDXPTR=$ORDER(^TMP("SCENI",$JOB,"XMT",SDN2,SDXPTR))
+8 QUIT +SDN2
+9 ;
EXIT ;
+1 IF $DATA(VALMBCK)
IF VALMBCK="R"
DO REFRESH^VALM
SET VALMBCK=$PIECE(VALMBCK,"R")_$PIECE(VALMBCK,"R",2)
+2 KILL SDBT,SDEDT,SDN1,SDN2
+3 QUIT
