SCDXSUP1 ;RENO/KEITH ALB/SCK - Supervisory Options for Ambulatory Care Reporting; 2/26/97
;;5.3;Scheduling;**104,127,132**;Aug 13,1993
Q
;
APPTY ; Edit Appointment type for Add/Edit
N DIC,DTOUT,DUTOUT,SCDFN,SCI,SCG,SCOUT,SCDT,DIR,DIRUT
;
S SCBD=$$ASKDT("Beginning") G:SCBD<0 APPQ
APP1 S SCED=$$ASKDT("Ending") G:SCED<0 APPQ
I SCED<SCBD D G APP1
. W !!,"Ending date cannot be earlier than the beginning date!"
;
ASK S DIC="^DPT(",DIC(0)="AEMQ"
D ^DIC K DIC
G:$D(DTOUT)!$D(DUOUT) APPQ
G:Y'>0 EXIT
S SCDFN=+Y
;
I '$D(^SCE("C",SCDFN)) D G ASK
. W !!,"This patient has no outpatient encounters on file!",!!
;
K ^TMP("SCEA",$J)
S (SCI,SCG,SCOUT)=0
;
D WAIT^DICD
W !
S SCDT=SCED+.999999
F S SCDT=$O(^SCE("ADFN",SCDFN,SCDT),-1) Q:'SCDT!(SCOUT)!(SCDT<SCBD) D
. S SCI=SCI+1
. S SCDT=$P(SCDT,".") ; -- reset to stop processing date
. S ^TMP("SCEA",$J,1,SCI)=SCDT
. W !,SCI,?5,$$FMTE^XLFDT(SCDT,"1P")
. I SCI#5=0 D GET(SCI)
;
I SCI'>0 D G ASK
. W !!,"No encounters on file for this patient during this date range.",!
;
I SCI#5'=0 D GET(SCI)
D:SCG SCED
G ASK
APPQ ;
K DIE,DR,DTOUT,DUOUT
Q
;
EXIT ;
Q
;
GET(SCN) ; Select appointment from list
N DIR,DIRUT,DUOUT,DTOUT
K DIR
W !
S DIR(0)="NO^1:"_SCN,DIR("A")="Select number, or ENTER to continue"
S DIR("?",1)="Select entry to edit appointment type for from the list above"
S DIR("?")="Press ENTER to continue."
D ^DIR K DIR
I $D(DUOUT)!($D(DTOUT)) S SCOUT=1 Q
I $D(DIRUT) Q
I Y S SCG=Y,SCOUT=1
Q
;
SCED ; Select stop code
N DIC,DIR,DIE,DR,SCK,DA,SCY,SCLINE,SUCCESS,SCDT,SCDATE,SCE,SCE0,SDLOG
;
S SCDATE=^TMP("SCEA",$J,1,SCG)
;
S SCDT=SCDATE
F S SCDT=$O(^SCE("ADFN",SCDFN,SCDT)) Q:'SCDT!($P(SCDT,".")'=SCDATE) D
. S SCE=0
. F S SCE=$O(^SCE("ADFN",SCDFN,SCDT,SCE)) Q:'SCE D
. . S SCE0=$G(^SCE(SCE,0))
. . I $P($G(^SC(+$P(SCE0,U,4),"OOS")),U),$G(^SCE(SCE,"CG")) D SET
;
I '$D(SCK) D Q
. W !!,"No occasion-of-service add/edits for this patient/date.",!
;
I $D(SCK) D
. W !!,"Appt. DT",?24,"Location",?60,"Appt. Type"
. S SCLINE="",$P(SCLINE,"-",(IOM-1))="" W !,SCLINE
;
S SCE=0
F S SCE=$O(SCK(SCE)) Q:'SCE D W !!
. S Y=$P(SCK(SCE),U) X ^DD("DD")
. W !,Y,?24,$E($P(SCK(SCE),U,2),1,30),?60,$E($P(SCK(SCE),U,3),1,18)
;
K DIC
S DIC="^SD(409.1,",DIC(0)="AEMQ"
S DIC("A")="Select new appointment type for these encounters: "
S DIC("B")="COMPUTER GENERATED"
D ^DIC K DIC
Q:$D(DTOUT)!$D(DUOUT)
Q:Y<1
S SCY=$P(Y,U)
;
K DIR
S DIR(0)="Y",DIR("A")="OK to change to "_$P(Y,U,2),DIR("B")="YES"
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)
Q:'Y
;
K DIE,DR
S DA=0
F S DA=$O(SCK(DA)) Q:'DA D
. K SUCCESS
. L +^SCE(DA):5 S SUCCESS=$S(($T):1,1:0)
. I SUCCESS D
.. S DIE="^SCE(",DR=".1////^S X=SCY"
.. D ^DIE K DIE
.. D LOGDATA^SDAPIAP(DA,.SDLOG)
. E D
.. W !,"Outpatient Encounter entry: "_DA_" for "_$P($G(^DPT(SCDFN,0)),U)_" is in use, cannot edit."
. L -^SCE(DA)
;
W !,"Done."
Q
;
SET ;
N SCDT,SCCL,SCTY
;
S SCDT=+SCE0
S SCCL=$P(^SC($P(SCE0,U,4),0),U)
S SCTY=$P($G(^SD(409.1,+$P(SCE0,U,10),0)),U)
S:SCDT SCK(SCE)=SCDT_U_SCCL_U_SCTY
Q
;
ASKDT(TXT) ; Enter beginning date for searching outpatient encounter file
S DIR(0)="DA^2961001:NOW:EXP",DIR("A")="Enter "_TXT_" date for search: "
S DIR("?")="^D HELP^%DTC"
S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT())
D ^DIR K DIR
S:$D(DIRUT) Y=-1
K DIRUT
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXSUP1 3465 printed Apr 09, 2024@21:48:40 Page 2
SCDXSUP1 ;RENO/KEITH ALB/SCK - Supervisory Options for Ambulatory Care Reporting; 2/26/97
+1 ;;5.3;Scheduling;**104,127,132**;Aug 13,1993
+2 QUIT
+3 ;
APPTY ; Edit Appointment type for Add/Edit
+1 NEW DIC,DTOUT,DUTOUT,SCDFN,SCI,SCG,SCOUT,SCDT,DIR,DIRUT
+2 ;
+3 SET SCBD=$$ASKDT("Beginning")
if SCBD<0
GOTO APPQ
APP1 SET SCED=$$ASKDT("Ending")
if SCED<0
GOTO APPQ
+1 IF SCED<SCBD
Begin DoDot:1
+2 WRITE !!,"Ending date cannot be earlier than the beginning date!"
End DoDot:1
GOTO APP1
+3 ;
ASK SET DIC="^DPT("
SET DIC(0)="AEMQ"
+1 DO ^DIC
KILL DIC
+2 if $DATA(DTOUT)!$DATA(DUOUT)
GOTO APPQ
+3 if Y'>0
GOTO EXIT
+4 SET SCDFN=+Y
+5 ;
+6 IF '$DATA(^SCE("C",SCDFN))
Begin DoDot:1
+7 WRITE !!,"This patient has no outpatient encounters on file!",!!
End DoDot:1
GOTO ASK
+8 ;
+9 KILL ^TMP("SCEA",$JOB)
+10 SET (SCI,SCG,SCOUT)=0
+11 ;
+12 DO WAIT^DICD
+13 WRITE !
+14 SET SCDT=SCED+.999999
+15 FOR
SET SCDT=$ORDER(^SCE("ADFN",SCDFN,SCDT),-1)
if 'SCDT!(SCOUT)!(SCDT<SCBD)
QUIT
Begin DoDot:1
+16 SET SCI=SCI+1
+17 ; -- reset to stop processing date
SET SCDT=$PIECE(SCDT,".")
+18 SET ^TMP("SCEA",$JOB,1,SCI)=SCDT
+19 WRITE !,SCI,?5,$$FMTE^XLFDT(SCDT,"1P")
+20 IF SCI#5=0
DO GET(SCI)
End DoDot:1
+21 ;
+22 IF SCI'>0
Begin DoDot:1
+23 WRITE !!,"No encounters on file for this patient during this date range.",!
End DoDot:1
GOTO ASK
+24 ;
+25 IF SCI#5'=0
DO GET(SCI)
+26 if SCG
DO SCED
+27 GOTO ASK
APPQ ;
+1 KILL DIE,DR,DTOUT,DUOUT
+2 QUIT
+3 ;
EXIT ;
+1 QUIT
+2 ;
GET(SCN) ; Select appointment from list
+1 NEW DIR,DIRUT,DUOUT,DTOUT
+2 KILL DIR
+3 WRITE !
+4 SET DIR(0)="NO^1:"_SCN
SET DIR("A")="Select number, or ENTER to continue"
+5 SET DIR("?",1)="Select entry to edit appointment type for from the list above"
+6 SET DIR("?")="Press ENTER to continue."
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DUOUT)!($DATA(DTOUT))
SET SCOUT=1
QUIT
+9 IF $DATA(DIRUT)
QUIT
+10 IF Y
SET SCG=Y
SET SCOUT=1
+11 QUIT
+12 ;
SCED ; Select stop code
+1 NEW DIC,DIR,DIE,DR,SCK,DA,SCY,SCLINE,SUCCESS,SCDT,SCDATE,SCE,SCE0,SDLOG
+2 ;
+3 SET SCDATE=^TMP("SCEA",$JOB,1,SCG)
+4 ;
+5 SET SCDT=SCDATE
+6 FOR
SET SCDT=$ORDER(^SCE("ADFN",SCDFN,SCDT))
if 'SCDT!($PIECE(SCDT,".")'=SCDATE)
QUIT
Begin DoDot:1
+7 SET SCE=0
+8 FOR
SET SCE=$ORDER(^SCE("ADFN",SCDFN,SCDT,SCE))
if 'SCE
QUIT
Begin DoDot:2
+9 SET SCE0=$GET(^SCE(SCE,0))
+10 IF $PIECE($GET(^SC(+$PIECE(SCE0,U,4),"OOS")),U)
IF $GET(^SCE(SCE,"CG"))
DO SET
End DoDot:2
End DoDot:1
+11 ;
+12 IF '$DATA(SCK)
Begin DoDot:1
+13 WRITE !!,"No occasion-of-service add/edits for this patient/date.",!
End DoDot:1
QUIT
+14 ;
+15 IF $DATA(SCK)
Begin DoDot:1
+16 WRITE !!,"Appt. DT",?24,"Location",?60,"Appt. Type"
+17 SET SCLINE=""
SET $PIECE(SCLINE,"-",(IOM-1))=""
WRITE !,SCLINE
End DoDot:1
+18 ;
+19 SET SCE=0
+20 FOR
SET SCE=$ORDER(SCK(SCE))
if 'SCE
QUIT
Begin DoDot:1
+21 SET Y=$PIECE(SCK(SCE),U)
XECUTE ^DD("DD")
+22 WRITE !,Y,?24,$EXTRACT($PIECE(SCK(SCE),U,2),1,30),?60,$EXTRACT($PIECE(SCK(SCE),U,3),1,18)
End DoDot:1
WRITE !!
+23 ;
+24 KILL DIC
+25 SET DIC="^SD(409.1,"
SET DIC(0)="AEMQ"
+26 SET DIC("A")="Select new appointment type for these encounters: "
+27 SET DIC("B")="COMPUTER GENERATED"
+28 DO ^DIC
KILL DIC
+29 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+30 if Y<1
QUIT
+31 SET SCY=$PIECE(Y,U)
+32 ;
+33 KILL DIR
+34 SET DIR(0)="Y"
SET DIR("A")="OK to change to "_$PIECE(Y,U,2)
SET DIR("B")="YES"
+35 DO ^DIR
KILL DIR
+36 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+37 if 'Y
QUIT
+38 ;
+39 KILL DIE,DR
+40 SET DA=0
+41 FOR
SET DA=$ORDER(SCK(DA))
if 'DA
QUIT
Begin DoDot:1
+42 KILL SUCCESS
+43 LOCK +^SCE(DA):5
SET SUCCESS=$SELECT(($TEST):1,1:0)
+44 IF SUCCESS
Begin DoDot:2
+45 SET DIE="^SCE("
SET DR=".1////^S X=SCY"
+46 DO ^DIE
KILL DIE
+47 DO LOGDATA^SDAPIAP(DA,.SDLOG)
End DoDot:2
+48 IF '$TEST
Begin DoDot:2
+49 WRITE !,"Outpatient Encounter entry: "_DA_" for "_$PIECE($GET(^DPT(SCDFN,0)),U)_" is in use, cannot edit."
End DoDot:2
+50 LOCK -^SCE(DA)
End DoDot:1
+51 ;
+52 WRITE !,"Done."
+53 QUIT
+54 ;
SET ;
+1 NEW SCDT,SCCL,SCTY
+2 ;
+3 SET SCDT=+SCE0
+4 SET SCCL=$PIECE(^SC($PIECE(SCE0,U,4),0),U)
+5 SET SCTY=$PIECE($GET(^SD(409.1,+$PIECE(SCE0,U,10),0)),U)
+6 if SCDT
SET SCK(SCE)=SCDT_U_SCCL_U_SCTY
+7 QUIT
+8 ;
ASKDT(TXT) ; Enter beginning date for searching outpatient encounter file
+1 SET DIR(0)="DA^2961001:NOW:EXP"
SET DIR("A")="Enter "_TXT_" date for search: "
+2 SET DIR("?")="^D HELP^%DTC"
+3 SET DIR("B")=$$FMTE^XLFDT($$DT^XLFDT())
+4 DO ^DIR
KILL DIR
+5 if $DATA(DIRUT)
SET Y=-1
+6 KILL DIRUT
+7 QUIT Y
