SDACSCGB ;ALBISC/TET - BATCH UPDATE COMP GEN APPT TYPES FOR C&P'S ;3/23/92 13:59
;;5.3;Scheduling;**132**;Aug 13, 1993
;
BATCH ; - enter here for batch update cg appt types fm cg (possible C&P) to C&P
READ ;enter here to read
D ASK2^SDDIV G EXIT:Y<0
;
R1 ; -- get date range
S DIR(0)="D^::ET"
S DIR("A")="Enter Beginning Date"
S DIR("?")="^D HELP^%DTC"
D ^DIR K DIR G:$D(DIRUT) EXIT
S SDBEG=Y
I SDBEG>DT W !," Future dates are not allowed.",*7 G R1
D DD^%DT S FR=Y
;
S DIR(0)="D^"_SDBEG_":NOW:TE"
S DIR("A")="Enter Ending Date"
S DIR("?")="^D HELP^%DTC"
D ^DIR K DIR G:$D(DIRUT) EXIT
S SDBEG=SDBEG-.0001,SDEND=Y_".9999"
D DD^%DT S TO=Y
;
; -- display selections
W !!?8,"Selected date range begins on ",FR," and ends on ",TO
W !?8,"Division: ",$S(VAUTD:"ALL",1:"")
IF 'VAUTD S SDDIV=0 F I=1:1 S SDDIV=$O(VAUTD(SDDIV)) Q:'SDDIV D
. W:'(I#2) ?45,VAUTD(SDDIV),!
. W:(I#2) ?20,VAUTD(SDDIV)
W !!
;
S DIR("A",1)=" This option will automatically update the Computer Generated"
S DIR("A",2)=" appointment types which are possible C&P to C&P appointment"
S DIR("A",3)=" type for the above parameters."
S DIR("A",4)=""
S DIR("A")=" Are you sure you wish to continue"
S DIR("?")="Enter 'Yes' to automatically update appointment type, 'No' to exit."
S DIR("?",1)="You should exercise this option after you have reviewed"
S DIR("?",2)="visits which have an appointment type of 'Computer Generated'"
S DIR("?",3)="AND after you have selectively edited any possible C&Ps which are not."
S DIR("?",4)=" "
S DIR("?",5)="This option will then update all remaining visits which have"
S DIR("?",6)="a computer generated appointment type due to a possible C&P visit"
S DIR("?",7)="to a Comp & Pen appointment type for the parameters selected."
S DIR("?",8)=" "
S DIR(0)="YO"
D ^DIR K DIR G:$D(DIRUT)!('Y) EXIT
;
; -- queue job
S DGVAR="SDBEG^SDEND^VAUTD#"
S DGPGM="UPD^SDACSCGB"
D ZIS^DGUTQ
G:POP EXIT
;
UPD ; -- queue entry point
N SDT,SDOE,SDOE0,SDOECG,SDDIV,DFN,SDDAT,DASH,PG,CT,SDAPTYPR,Y,VA
;
S (PG,CT)=0
S DASH="",$P(DASH,"-",79)=""
W:$E(IOST,1,2)="C-" @IOF
D HDR
;
S SDT=0
F S SDT=$O(^SCE("ACG",SDT)) Q:'SDT D G:$D(DIRUT) EXIT
. S SDOE=0
. F S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE D Q:$D(DIRUT)
. . S SDOE0=$G(^SCE(SDOE,0))
. . S SDOECG=$G(^SCE(SDOE,"CG"))
. . S SDDAT=+SDOE0
. . S SDDIV=+$P(SDOE0,U,11)
. . S DFN=$P(SDOE0,U,2)
. . S SDAPTYPR=+$P(SDOECG,U,2)
. . IF VAUTD!($D(VAUTD(SDDIV))),SDDAT'<SDBEG,SDDAT'>SDEND D Q:$D(DIRUT)
. . . S Y=SDDAT D DD^%DT S SDY=Y
. . . D DEM^VADPT
. . . IF SDAPTYPR=2 D DIE
;
W !?10,CT," Visit"_$S(CT=1:"",1:"s")_" updated ...Batch update complete.",*7
;
EXIT ; -- exit logic
K %DT,CT,D,DA,DASH,DE,DFN,DFN0,DGPGM,DIC,DIE,DIRUT,DQ,DR
K DTOUT,DUOUT,FR,I,J,PG,POP,SDA,SDAPTYPR,SDBEG,SDCSNODE
K SDDAT,SDDIV,SDEND,SDUPDT,SDY,SDZN,SDTYPE,TO,VADM,VAEL
K VAERR,VAUTD,VA,X,Y
D CLOSE^DGUTQ
Q
;
DIE ; -- update entry
N DIE,DR,DA,DE,DQ
S DIE="^SCE(",DA=SDOE,DR=".1////^S X=1;202///@" D ^DIE
;
S CT=CT+1
D:$Y+6>IOSL CR Q:$D(DIRUT)
W !,SDY,?35,$S('VAERR:$E(VADM(1),1,30),1:"UNKNOWN")
Q
;
CR ; -- end of page processing
I $D(IOST),$E(IOST,1,2)="C-" D Q:$G(DIRUT)
. S DIR(0)="E"
. W ! D ^DIR K DIR
. I $D(DUOUT)!($D(DTOUT)) D
. . S DIRUT=1
. . W !,SDY,?35,$S('VAERR:$E(VADM(1),1,30),1:"UNKNOWN"),!!,"Update incomplete!",*7
W @IOF D HDR
Q
;
HDR ; -- header processing
S PG=PG+1
W !?17,"UPDATED COMPUTER GENERATED APPOINTMENT TYPES",!!,"Date/Time",?35,"Name",?68,"Page ",PG,!,DASH,!!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDACSCGB 3627 printed Dec 13, 2024@02:47 Page 2
SDACSCGB ;ALBISC/TET - BATCH UPDATE COMP GEN APPT TYPES FOR C&P'S ;3/23/92 13:59
+1 ;;5.3;Scheduling;**132**;Aug 13, 1993
+2 ;
BATCH ; - enter here for batch update cg appt types fm cg (possible C&P) to C&P
READ ;enter here to read
+1 DO ASK2^SDDIV
if Y<0
GOTO EXIT
+2 ;
R1 ; -- get date range
+1 SET DIR(0)="D^::ET"
+2 SET DIR("A")="Enter Beginning Date"
+3 SET DIR("?")="^D HELP^%DTC"
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+5 SET SDBEG=Y
+6 IF SDBEG>DT
WRITE !," Future dates are not allowed.",*7
GOTO R1
+7 DO DD^%DT
SET FR=Y
+8 ;
+9 SET DIR(0)="D^"_SDBEG_":NOW:TE"
+10 SET DIR("A")="Enter Ending Date"
+11 SET DIR("?")="^D HELP^%DTC"
+12 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+13 SET SDBEG=SDBEG-.0001
SET SDEND=Y_".9999"
+14 DO DD^%DT
SET TO=Y
+15 ;
+16 ; -- display selections
+17 WRITE !!?8,"Selected date range begins on ",FR," and ends on ",TO
+18 WRITE !?8,"Division: ",$SELECT(VAUTD:"ALL",1:"")
+19 IF 'VAUTD
SET SDDIV=0
FOR I=1:1
SET SDDIV=$ORDER(VAUTD(SDDIV))
if 'SDDIV
QUIT
Begin DoDot:1
+20 if '(I#2)
WRITE ?45,VAUTD(SDDIV),!
+21 if (I#2)
WRITE ?20,VAUTD(SDDIV)
End DoDot:1
+22 WRITE !!
+23 ;
+24 SET DIR("A",1)=" This option will automatically update the Computer Generated"
+25 SET DIR("A",2)=" appointment types which are possible C&P to C&P appointment"
+26 SET DIR("A",3)=" type for the above parameters."
+27 SET DIR("A",4)=""
+28 SET DIR("A")=" Are you sure you wish to continue"
+29 SET DIR("?")="Enter 'Yes' to automatically update appointment type, 'No' to exit."
+30 SET DIR("?",1)="You should exercise this option after you have reviewed"
+31 SET DIR("?",2)="visits which have an appointment type of 'Computer Generated'"
+32 SET DIR("?",3)="AND after you have selectively edited any possible C&Ps which are not."
+33 SET DIR("?",4)=" "
+34 SET DIR("?",5)="This option will then update all remaining visits which have"
+35 SET DIR("?",6)="a computer generated appointment type due to a possible C&P visit"
+36 SET DIR("?",7)="to a Comp & Pen appointment type for the parameters selected."
+37 SET DIR("?",8)=" "
+38 SET DIR(0)="YO"
+39 DO ^DIR
KILL DIR
if $DATA(DIRUT)!('Y)
GOTO EXIT
+40 ;
+41 ; -- queue job
+42 SET DGVAR="SDBEG^SDEND^VAUTD#"
+43 SET DGPGM="UPD^SDACSCGB"
+44 DO ZIS^DGUTQ
+45 if POP
GOTO EXIT
+46 ;
UPD ; -- queue entry point
+1 NEW SDT,SDOE,SDOE0,SDOECG,SDDIV,DFN,SDDAT,DASH,PG,CT,SDAPTYPR,Y,VA
+2 ;
+3 SET (PG,CT)=0
+4 SET DASH=""
SET $PIECE(DASH,"-",79)=""
+5 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+6 DO HDR
+7 ;
+8 SET SDT=0
+9 FOR
SET SDT=$ORDER(^SCE("ACG",SDT))
if 'SDT
QUIT
Begin DoDot:1
+10 SET SDOE=0
+11 FOR
SET SDOE=$ORDER(^SCE("ACG",SDT,SDOE))
if 'SDOE
QUIT
Begin DoDot:2
+12 SET SDOE0=$GET(^SCE(SDOE,0))
+13 SET SDOECG=$GET(^SCE(SDOE,"CG"))
+14 SET SDDAT=+SDOE0
+15 SET SDDIV=+$PIECE(SDOE0,U,11)
+16 SET DFN=$PIECE(SDOE0,U,2)
+17 SET SDAPTYPR=+$PIECE(SDOECG,U,2)
+18 IF VAUTD!($DATA(VAUTD(SDDIV)))
IF SDDAT'<SDBEG
IF SDDAT'>SDEND
Begin DoDot:3
+19 SET Y=SDDAT
DO DD^%DT
SET SDY=Y
+20 DO DEM^VADPT
+21 IF SDAPTYPR=2
DO DIE
End DoDot:3
if $DATA(DIRUT)
QUIT
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
+22 ;
+23 WRITE !?10,CT," Visit"_$SELECT(CT=1:"",1:"s")_" updated ...Batch update complete.",*7
+24 ;
EXIT ; -- exit logic
+1 KILL %DT,CT,D,DA,DASH,DE,DFN,DFN0,DGPGM,DIC,DIE,DIRUT,DQ,DR
+2 KILL DTOUT,DUOUT,FR,I,J,PG,POP,SDA,SDAPTYPR,SDBEG,SDCSNODE
+3 KILL SDDAT,SDDIV,SDEND,SDUPDT,SDY,SDZN,SDTYPE,TO,VADM,VAEL
+4 KILL VAERR,VAUTD,VA,X,Y
+5 DO CLOSE^DGUTQ
+6 QUIT
+7 ;
DIE ; -- update entry
+1 NEW DIE,DR,DA,DE,DQ
+2 SET DIE="^SCE("
SET DA=SDOE
SET DR=".1////^S X=1;202///@"
DO ^DIE
+3 ;
+4 SET CT=CT+1
+5 if $Y+6>IOSL
DO CR
if $DATA(DIRUT)
QUIT
+6 WRITE !,SDY,?35,$SELECT('VAERR:$EXTRACT(VADM(1),1,30),1:"UNKNOWN")
+7 QUIT
+8 ;
CR ; -- end of page processing
+1 IF $DATA(IOST)
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+2 SET DIR(0)="E"
+3 WRITE !
DO ^DIR
KILL DIR
+4 IF $DATA(DUOUT)!($DATA(DTOUT))
Begin DoDot:2
+5 SET DIRUT=1
+6 WRITE !,SDY,?35,$SELECT('VAERR:$EXTRACT(VADM(1),1,30),1:"UNKNOWN"),!!,"Update incomplete!",*7
End DoDot:2
End DoDot:1
if $GET(DIRUT)
QUIT
+7 WRITE @IOF
DO HDR
+8 QUIT
+9 ;
HDR ; -- header processing
+1 SET PG=PG+1
+2 WRITE !?17,"UPDATED COMPUTER GENERATED APPOINTMENT TYPES",!!,"Date/Time",?35,"Name",?68,"Page ",PG,!,DASH,!!
+3 QUIT
+4 ;
