- 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 Feb 19, 2025@00:13:27 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 ;