SDACSCG ;ALB/TET - Print/Edit Computer Generated Appt Types ;3/18/92 14:18
;;5.3;Scheduling;**16,22,132,202,1015**;Aug 13, 1993;Build 21
;
Q
CK ; -- check the number of computer generated visits
N SDT,SDOE,CT
S (SDT,CT)=0
F S SDT=$O(^SCE("ACG",SDT)) Q:'SDT D
. S SDOE=0
. F S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE S CT=CT+1
;
I CT D
. W !?5,"There are ",CT," encounter(s) with a 'Computer Generated' appointment type.",*7,!
E D
. W !?5,"There are no 'Computer Generated' appointment type encounters."
Q
;
PRINT ;print those CG types which need to be manually updated
S DGPGM="QUE^SDACSCG"
D ZIS^DGUTQ
Q:POP
;
QUE ; -- queue entry point
N SDOE,SDOE0,SDT,DSAH,SDY,CT,Y,X,VA,VADM,VAERR,CT,%DT
S DASH="",$P(DASH,"-",79)=""
S (SDT,CT)=0,%DT="SX"
D HDR
F S SDT=$O(^SCE("ACG",SDT)) Q:'SDT D G:$D(DTOUT)!($D(DUOUT)) EXIT
. S Y=SDT D DD^%DT S SDY=Y
. S SDOE=0
. F S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE D Q:$D(DTOUT)!($D(DUOUT))
. . S SDOE0=$G(^SCE(SDOE,0))
. . S DFN=+$P(SDOE0,U,2)
. . D DEM^VADPT
. . D:$Y+6>IOSL CR,HDR
. . Q:$D(DTOUT)!($D(DUOUT))
. . W !,SDY,?25,$S(VAERR=0:VADM(1),1:"UNKNOWN"),?60,VA("PID")
. . S CT=CT+1
I CT D:$Y+4>IOSL CR W !!,CT," MATCHES FOUND.",!
;
EXIT ; -- exit processing
K %DT,CT,D,DA,DASH,DE,DFN,DFN0,DGPGM,DIC,DIE,DIRUT,DQ
K DR,DTOUT,DUOUT,FR,I,J,POP,SDA,SDAPTYP,SDBEG,SDCSNODE
K SDDIV,SDEND,SDUPDT,SDY,SDZN,SDTYPE,TO,VADM,VAEL,VAERR,VA,X,Y
Q
;
CR ; -- end of page processing
Q:$E(IOST,1,2)'="C-"
W !!,"Press RETURN to continue or '^' to exit: "
R SDXX:DTIME S:'$T DTOUT=1
Q:$D(DTOUT)!(SDXX="")
I SDXX="^" S DUOUT=1 Q
W !?5,"Enter an '^' to exit the listing, or enter RETURN to continue."
G CR
;
HDR ; -- header processing
W:$D(IOF) @IOF W !,"COMPUTER GENERATED APPOINTMENT TYPES"
W !,"ENCOUNTER DATE/TIME",?25,"PATIENT",?60,"PT ID",!,DASH,!!
Q
;
EDIT ; -- edit computer generated appt types
N DIR,SDOUT,%DT
I '$O(^SCE("ACG",0)) W !!?5,"There are no 'Computer Generated' Appointment Types which need updating." G EDITQ
;
W !
S DIR("A",1)="You may enter one of the following:"
S DIR("A",2)=" Encounter Date - edit 'Computer Generated' entries for a specific date"
S DIR("A",3)=" Patient Name (or SSN) - edit 'Computer Generated' entries for one patient"
S DIR("A",4)=" The default of 'ALL' - edit all entries which are 'Computer Generated'"
S DIR("A")="Select Encounter Date"
S DIR("B")="ALL"
S DIR(0)="F^1:30"
S %DT(0)="-DT"
S DIR("?")="^D QUE^SDACSCG"
D ^DIR K DIR
G:$D(DIRUT) EDITQ
;
S SDOUT=0
D
.N SDZ
.I "ALLall"[Y D Q
..D ALL
.S (X,SDZ)=Y,%DT="PX"
.D ^%DT
.I Y'=-1 D Q
..S Y=SDZ
..D DATE
.S Y=SDZ
.I Y?9N!(Y?1A4N)!(Y?.AP)!(Y?4N) D Q
..D DPT
;
I 'SDOUT G EDIT
;
EDITQ D EXIT
Q
;
DATE ;
N CT,%DT,Y,SDBEG,SDEND
S CT=0
S %DT="EPTXS"
S %DT(0)=-DT
D ^%DT S Y=+Y
IF $D(DTOUT) S SDOUT=1 G DATEQ
G DATEQ:Y=-1
;
S SDBEG=$S(Y[".":Y-.000001,1:Y)
S SDEND=$S(Y[".":Y,1:Y_.999999)
D LOOP(SDBEG,SDEND)
;
G:SDOUT DATEQ
W:'CT !,"There are no 'Computer Generated' appt types for selection.",*7,!
DATEQ Q
;
ALL ; -- loop through and edit all computer generated appt types
N CT
S CT=0
;
D LOOP()
;
ALLQ Q
;
DPT ; -- look up in patient file & loop through acg for selected dfn
;
N DIC,D,CT,Y
S CT=0
S DIC="^DPT(",DIC(0)="EQMZ"
S D=$S(X?9N:"SSN",X?1A.4N:"B5",1:"B")
D IX^DIC
G DPTQ:Y'>0
;
D LOOP(,,+Y)
;
G:SDOUT DPTQ
W:'CT !,"There are no 'Computer Generated' appt types for selected entry.",*7,!
DPTQ Q
;
LOOP(SDBEG,SDEND,SDFN) ;
N SDY,DFN,VA,VAERR,VAADM,SDT,SDOE
;
IF '$G(SDBEG) N SDBEG S SDBEG=0
IF '$G(SDEND) N SDEND S SDEND=9999999
IF '$G(SDFN) N SDFN S SDFN=0
;
S SDT=SDBEG
F S SDT=$O(^SCE("ACG",SDT)) Q:'SDT!(SDT>SDEND) D Q:SDOUT
. S SDOE=0
. F S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE D Q:SDOUT
. . IF SDFN,SDFN'=+$P($G(^SCE(SDOE,0)),"^",2) Q
. . D DEM(SDOE),DEMW
. . D DIE(SDOE)
LOOPQ Q
;
DEM(SDOE) ; -- get pt name,ssn and visit date
N SDOE0,Y,DFN
S SDOE0=$G(^SCE(SDOE,0))
S DFN=+$P(SDOE0,"^",2)
D DEM^VADPT
S Y=+SDOE0 D DD^%DT S SDY=Y
Q
;
DEMW ; -- write patient demographics
W !!,SDY,?25,$S(VAERR=0:VADM(1),1:"UNKNOWN"),?60,VA("PID")
Q
;
DIE(SDOE) ; -- do edit
N DR,DIE,DE,DQ
S DR=".1d;I $P(^(0),U,10)=10 S Y=""@99"";202///@;@99"
S DIE="^SCE("
S DA=SDOE
D ^DIE
S:$D(DTOUT)!($D(Y)'=0) SDOUT=1
S CT=CT+1
Q
;
SDACSCG ;ALB/TET - Print/Edit Computer Generated Appt Types ;3/18/92 14:18
+1 ;;5.3;Scheduling;**16,22,132,202,1015**;Aug 13, 1993;Build 21
+2 ;
+3 QUIT
CK ; -- check the number of computer generated visits
+1 NEW SDT,SDOE,CT
+2 SET (SDT,CT)=0
+3 FOR
SET SDT=$ORDER(^SCE("ACG",SDT))
IF 'SDT
QUIT
Begin DoDot:1
+4 SET SDOE=0
+5 FOR
SET SDOE=$ORDER(^SCE("ACG",SDT,SDOE))
IF 'SDOE
QUIT
SET CT=CT+1
End DoDot:1
+6 ;
+7 IF CT
Begin DoDot:1
+8 WRITE !?5,"There are ",CT," encounter(s) with a 'Computer Generated' appointment type.",*7,!
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 WRITE !?5,"There are no 'Computer Generated' appointment type encounters."
End DoDot:1
+11 QUIT
+12 ;
PRINT ;print those CG types which need to be manually updated
+1 SET DGPGM="QUE^SDACSCG"
+2 DO ZIS^DGUTQ
+3 IF POP
QUIT
+4 ;
QUE ; -- queue entry point
+1 NEW SDOE,SDOE0,SDT,DSAH,SDY,CT,Y,X,VA,VADM,VAERR,CT,%DT
+2 SET DASH=""
SET $PIECE(DASH,"-",79)=""
+3 SET (SDT,CT)=0
SET %DT="SX"
+4 DO HDR
+5 FOR
SET SDT=$ORDER(^SCE("ACG",SDT))
IF 'SDT
QUIT
Begin DoDot:1
+6 SET Y=SDT
DO DD^%DT
SET SDY=Y
+7 SET SDOE=0
+8 FOR
SET SDOE=$ORDER(^SCE("ACG",SDT,SDOE))
IF 'SDOE
QUIT
Begin DoDot:2
+9 SET SDOE0=$GET(^SCE(SDOE,0))
+10 SET DFN=+$PIECE(SDOE0,U,2)
+11 DO DEM^VADPT
+12 IF $Y+6>IOSL
DO CR
DO HDR
+13 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+14 WRITE !,SDY,?25,$SELECT(VAERR=0:VADM(1),1:"UNKNOWN"),?60,VA("PID")
+15 SET CT=CT+1
End DoDot:2
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
End DoDot:1
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+16 IF CT
IF $Y+4>IOSL
DO CR
WRITE !!,CT," MATCHES FOUND.",!
+17 ;
EXIT ; -- exit processing
+1 KILL %DT,CT,D,DA,DASH,DE,DFN,DFN0,DGPGM,DIC,DIE,DIRUT,DQ
+2 KILL DR,DTOUT,DUOUT,FR,I,J,POP,SDA,SDAPTYP,SDBEG,SDCSNODE
+3 KILL SDDIV,SDEND,SDUPDT,SDY,SDZN,SDTYPE,TO,VADM,VAEL,VAERR,VA,X,Y
+4 QUIT
+5 ;
CR ; -- end of page processing
+1 IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 WRITE !!,"Press RETURN to continue or '^' to exit: "
+3 READ SDXX:DTIME
IF '$TEST
SET DTOUT=1
+4 IF $DATA(DTOUT)!(SDXX="")
QUIT
+5 IF SDXX="^"
SET DUOUT=1
QUIT
+6 WRITE !?5,"Enter an '^' to exit the listing, or enter RETURN to continue."
+7 GOTO CR
+8 ;
HDR ; -- header processing
+1 IF $DATA(IOF)
WRITE @IOF
WRITE !,"COMPUTER GENERATED APPOINTMENT TYPES"
+2 WRITE !,"ENCOUNTER DATE/TIME",?25,"PATIENT",?60,"PT ID",!,DASH,!!
+3 QUIT
+4 ;
EDIT ; -- edit computer generated appt types
+1 NEW DIR,SDOUT,%DT
+2 IF '$ORDER(^SCE("ACG",0))
WRITE !!?5,"There are no 'Computer Generated' Appointment Types which need updating."
GOTO EDITQ
+3 ;
+4 WRITE !
+5 SET DIR("A",1)="You may enter one of the following:"
+6 SET DIR("A",2)=" Encounter Date - edit 'Computer Generated' entries for a specific date"
+7 SET DIR("A",3)=" Patient Name (or SSN) - edit 'Computer Generated' entries for one patient"
+8 SET DIR("A",4)=" The default of 'ALL' - edit all entries which are 'Computer Generated'"
+9 SET DIR("A")="Select Encounter Date"
+10 SET DIR("B")="ALL"
+11 SET DIR(0)="F^1:30"
+12 SET %DT(0)="-DT"
+13 SET DIR("?")="^D QUE^SDACSCG"
+14 DO ^DIR
KILL DIR
+15 IF $DATA(DIRUT)
GOTO EDITQ
+16 ;
+17 SET SDOUT=0
+18 Begin DoDot:1
+19 NEW SDZ
+20 IF "ALLall"[Y
Begin DoDot:2
+21 DO ALL
End DoDot:2
QUIT
+22 SET (X,SDZ)=Y
SET %DT="PX"
+23 DO ^%DT
+24 IF Y'=-1
Begin DoDot:2
+25 SET Y=SDZ
+26 DO DATE
End DoDot:2
QUIT
+27 SET Y=SDZ
+28 IF Y?9N!(Y?1A4N)!(Y?.AP)!(Y?4N)
Begin DoDot:2
+29 DO DPT
End DoDot:2
QUIT
End DoDot:1
+30 ;
+31 IF 'SDOUT
GOTO EDIT
+32 ;
EDITQ DO EXIT
+1 QUIT
+2 ;
DATE ;
+1 NEW CT,%DT,Y,SDBEG,SDEND
+2 SET CT=0
+3 SET %DT="EPTXS"
+4 SET %DT(0)=-DT
+5 DO ^%DT
SET Y=+Y
+6 IF $DATA(DTOUT)
SET SDOUT=1
GOTO DATEQ
+7 IF Y=-1
GOTO DATEQ
+8 ;
+9 SET SDBEG=$SELECT(Y[".":Y-.000001,1:Y)
+10 SET SDEND=$SELECT(Y[".":Y,1:Y_.999999)
+11 DO LOOP(SDBEG,SDEND)
+12 ;
+13 IF SDOUT
GOTO DATEQ
+14 IF 'CT
WRITE !,"There are no 'Computer Generated' appt types for selection.",*7,!
DATEQ QUIT
+1 ;
ALL ; -- loop through and edit all computer generated appt types
+1 NEW CT
+2 SET CT=0
+3 ;
+4 DO LOOP()
+5 ;
ALLQ QUIT
+1 ;
DPT ; -- look up in patient file & loop through acg for selected dfn
+1 ;
+2 NEW DIC,D,CT,Y
+3 SET CT=0
+4 SET DIC="^DPT("
SET DIC(0)="EQMZ"
+5 SET D=$SELECT(X?9N:"SSN",X?1A.4N:"B5",1:"B")
+6 DO IX^DIC
+7 IF Y'>0
GOTO DPTQ
+8 ;
+9 DO LOOP(,,+Y)
+10 ;
+11 IF SDOUT
GOTO DPTQ
+12 IF 'CT
WRITE !,"There are no 'Computer Generated' appt types for selected entry.",*7,!
DPTQ QUIT
+1 ;
LOOP(SDBEG,SDEND,SDFN) ;
+1 NEW SDY,DFN,VA,VAERR,VAADM,SDT,SDOE
+2 ;
+3 IF '$GET(SDBEG)
NEW SDBEG
SET SDBEG=0
+4 IF '$GET(SDEND)
NEW SDEND
SET SDEND=9999999
+5 IF '$GET(SDFN)
NEW SDFN
SET SDFN=0
+6 ;
+7 SET SDT=SDBEG
+8 FOR
SET SDT=$ORDER(^SCE("ACG",SDT))
IF 'SDT!(SDT>SDEND)
QUIT
Begin DoDot:1
+9 SET SDOE=0
+10 FOR
SET SDOE=$ORDER(^SCE("ACG",SDT,SDOE))
IF 'SDOE
QUIT
Begin DoDot:2
+11 IF SDFN
IF SDFN'=+$PIECE($GET(^SCE(SDOE,0)),"^",2)
QUIT
+12 DO DEM(SDOE)
DO DEMW
+13 DO DIE(SDOE)
End DoDot:2
IF SDOUT
QUIT
End DoDot:1
IF SDOUT
QUIT
LOOPQ QUIT
+1 ;
DEM(SDOE) ; -- get pt name,ssn and visit date
+1 NEW SDOE0,Y,DFN
+2 SET SDOE0=$GET(^SCE(SDOE,0))
+3 SET DFN=+$PIECE(SDOE0,"^",2)
+4 DO DEM^VADPT
+5 SET Y=+SDOE0
DO DD^%DT
SET SDY=Y
+6 QUIT
+7 ;
DEMW ; -- write patient demographics
+1 WRITE !!,SDY,?25,$SELECT(VAERR=0:VADM(1),1:"UNKNOWN"),?60,VA("PID")
+2 QUIT
+3 ;
DIE(SDOE) ; -- do edit
+1 NEW DR,DIE,DE,DQ
+2 SET DR=".1d;I $P(^(0),U,10)=10 S Y=""@99"";202///@;@99"
+3 SET DIE="^SCE("
+4 SET DA=SDOE
+5 DO ^DIE
+6 IF $DATA(DTOUT)!($DATA(Y)'=0)
SET SDOUT=1
+7 SET CT=CT+1
+8 QUIT
+9 ;
