- 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 Feb 19, 2025@00:06:02 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