SDACSCGP ;ALB/TET - Print Computer Generated Appt Types or Stop Codes ;3/18/92 14:26
;;5.3;Scheduling;**132,202,1015**;Aug 13, 1993;Build 21
;
Q
;
EN ; -- print either CG stop codes or CG appt types
; ('ag' or 'acg' cross ref)
;
; SDX=X-ref ACG=Computer Generated not resolved
; AG =Computer Generated viits, all appointment types.
;
READ ;enter here to read
Q:'$D(SDX)
D ASK2^SDDIV G EXIT:Y<0
;
S %H=+$H
D YX^%DTC
S %DT="AE"
S %DT("A")="Enter Beginning Date: "
S %DT("B")=Y
F D Q:X="^"!(Y>0)
.D ^%DT
.I Y>DT&(X'="^") D Q:X="^"!(Y>0)
..W !,"You have entered a future or invalid date, please enter a valid date.",!
..S Y=-1
.S:$D(DTOUT) X="^"
G:X="^" EXIT
K %DT
S SDBEG=Y
D DD^%DT S FR=Y
;
S Y=DT D DD^%DT
S TO=Y
S %DT="AE"
S %DT("A")="Enter Ending Date ("_FR_" - "_TO_") "
S %DT("B")=Y
F D Q:X="^"!(Y>0)
.D ^%DT
.I Y<SDBEG&(X'="^") D Q
..W !,"A date before the begin date is not allowed, please enter a valid date.",!
..S Y=-1
.I Y>DT D Q
..W !,"Future dates are not allowed, please enter a valid date.",!
..S Y=-1
.I Y=-1&(X'="^") D Q
..W !,"You have entered an invalid date, please enter a valid date."
.S:$D(DTOUT) X="^"
G:X="^" EXIT
S SDBEG=SDBEG-.0001
S SDEND=Y_".9999"
D DD^%DT S TO=Y
;
STOP ; -- one,many,all selection of stop codes
S VAUTNI=2
S VAUTSTR="clinic stop code"
S VAUTVB="SDC"
S DIC=40.7
D FIRST^VAUTOMA
G EXIT:Y<0
;
S DGVAR="SDC#^SDBEG^SDEND^SDX^VAUTD#^TO^FR"
S DGPGM="QUE^SDACSCGP"
D ZIS^DGUTQ
G:POP EXIT
;
QUE ; -- entry point
N SDOE,SDOE0,SDOECG,DFN,SDDIV,SDT,SDSTOP,SDAPTYPR
S DASH="",$P(DASH,"-",79)=""
;
I '$O(^SCE(SDX,0)) W !!?5,"There are no 'Computer Generated' ",$S(SDX="AG":"Stop Codes.",1:"Appointment Types which need updating.") G EXIT
;
S SDT=SDBEG
F S SDT=$O(^SCE(SDX,SDT)) Q:'SDT!(SDT>SDEND) D
. S SDOE=0
. F S SDOE=$O(^SCE(SDX,SDT,SDOE)) Q:'SDOE D
. . S SDOE0=$G(^SCE(SDOE,0))
. . S SDOECG=$G(^SCE(SDOE,"CG"))
. . S SDDIV=+$P(SDOE0,U,11)
. . S DFN=+$P(SDOE0,U,2) D DEM^VADPT
. . I VAUTD!($D(VAUTD(SDDIV))) D
. . . S SDSTOP=$P(SDOE0,U,3)
. . . S SDAPTYPR=+$P(SDOECG,U,2)
. . . I SDC!($D(SDC(SDSTOP))) D SORT
;
PRINT ; -- loop thru division and stop code
S (PG,SDDIV)=0
F S SDDIV=$O(^TMP($J,SDDIV)) G:'SDDIV EXIT D:PG CR G:$D(DIRUT) EXIT D G:$D(DTOUT)!($D(DUOUT)) EXIT
. D DIV,HDR
. S SDSTOP=0
. F S SDSTOP=$O(^TMP($J,SDDIV,SDSTOP)) Q:'SDSTOP D SCHDR S CT=0 D P1 Q:$D(DTOUT)!($D(DUOUT)) D SCFTR Q:$D(DTOUT)!($D(DUOUT))
;
; -- loop thru tmp global - do write
P1 S SDNAM=0
F S SDNAM=$O(^TMP($J,SDDIV,SDSTOP,SDNAM)) Q:SDNAM']"" D
. S SDSSN=""
. F S SDSSN=$O(^TMP($J,SDDIV,SDSTOP,SDNAM,SDSSN)) Q:SDSSN']"" D:$Y+6>IOSL CR,HDR Q:$D(DTOUT)!($D(DUOUT)) D DAT
Q
;
EXIT K CT,D,DA,DASH,DE,DFN,DGPGM,DGVAR,DIC,DIE,DIRUT,DQ,DR,DTOUT,DUOUT,I,L,POP,SDA,SDAPTYP,SDBEG,SDC,SDCSNODE,SDDAT,SDEND,SDI,SDJ,SDNAM,SDSSN,SDUPDT,SDX,SDY,SDZNODE,TYPE,VA,VADM,VAERR,VAUTD,Y
K FR,PG,TO,SDCSN,SDDIV,SDDIVNAM,SDHDR,SDSTOP,SDSTNUM,SDSTNAM,SDSTZ,VAUTNI,VAUTSTR,VAUTVB,^TMP($J)
D CLOSE^DGUTQ
Q
;
DAT ; -- get and print data
S SDDAT=0
F S SDDAT=$O(^TMP($J,SDDIV,SDSTOP,SDNAM,SDSSN,SDDAT)) Q:'SDDAT D
. N SDIEN
. S SDIEN=0
. F S SDIEN=$O(^TMP($J,SDDIV,SDSTOP,SDNAM,SDSSN,SDDAT,SDIEN)) Q:'SDIEN D
. . S SDAPTYPR=$G(^TMP($J,SDDIV,SDSTOP,SDNAM,SDSSN,SDDAT,SDIEN))
. . S Y=SDDAT X ^DD("DD")
. . S CT=CT+1
. . W !,$E(SDNAM,1,20),?25,SDSSN,?45,Y
. . W:SDX="ACG" ?70,$S(SDAPTYPR=2:"C&P",SDAPTYPR=1:"ELIG",1:"")
Q
;
SORT ; -- set tmp global to sort in alpha order by ssn & date, count sets
S CT=0
S SDNAM=$S('VAERR:VADM(1),1:"UNKNOWN")
S SDSSN=$S('VAERR:VA("PID"),1:"UNKNOWN")
S SDDIV=$S(+SDDIV:SDDIV,1:"UNKNOWN")
S SDSTOP=$S(+SDSTOP:SDSTOP,1:"UNKNOWN")
S ^TMP($J,SDDIV,SDSTOP,SDNAM,SDSSN,+SDOE0,SDOE)=SDAPTYPR
S CT=CT+1
Q
;
CR ; -- carriage return
I $D(IOST),$E(IOST,1,2)="C-" S DIR(0)="E" W ! D ^DIR Q:$D(DTOUT)!($D(DUOUT))
Q
;
DIV ; -- get division name for header
S SDDIVNAM=$S($D(^DG(40.8,+SDDIV,0)):$P(^(0),"^"),1:"UNKNOWN")
Q
;
HDR ; -- page header
S PG=PG+1
S SDHDR=$S(SDX="ACG":"APPOINTMENT TYPE",1:"STOP CODES")
W:$D(IOF) @IOF W !,?IOM-(11+$L(SDDIVNAM))/2,"DIVISION: ",SDDIVNAM,!,"COMPUTER GENERATED "_SDHDR,?40,FR," TO ",TO,?70,"PAGE ",PG,!,"PATIENT",?25,"PATIENT ID",?45,"VISIT DATE/TIME"
W:SDX="ACG" ?70,"REASON"
W !,DASH,!!
Q
;
SCHDR ; -- stop code header
S SDSTZ=$S($D(^DIC(40.7,+SDSTOP,0)):^(0),1:"")
S SDSTNAM=$S(SDSTZ]"":$P(SDSTZ,"^"),1:"UNKNOWN")
S SDSTNUM=$S(SDSTZ]"":$P(SDSTZ,"^",2),1:"000")
W !?3,"STOP CODE: ",SDSTNAM
Q
;
SCFTR ; -- footer
D:$Y+6>IOSL CR,HDR
Q:$D(DTOUT)!($D(DUOUT))
W !!,CT," Computer Generated ",$S(SDX="ACG":"Appointment Types ",1:"Stop Codes "),"for Stop Code, ",SDSTNUM,", ",SDSTNAM,!
Q
;
AG ; -- test ag
N SDX
S SDX="AG"
D EN
Q
;
ACG ; -- test ag
N SDX
S SDX="ACG"
D EN
Q
;
SDACSCGP ;ALB/TET - Print Computer Generated Appt Types or Stop Codes ;3/18/92 14:26
+1 ;;5.3;Scheduling;**132,202,1015**;Aug 13, 1993;Build 21
+2 ;
+3 QUIT
+4 ;
EN ; -- print either CG stop codes or CG appt types
+1 ; ('ag' or 'acg' cross ref)
+2 ;
+3 ; SDX=X-ref ACG=Computer Generated not resolved
+4 ; AG =Computer Generated viits, all appointment types.
+5 ;
READ ;enter here to read
+1 IF '$DATA(SDX)
QUIT
+2 DO ASK2^SDDIV
IF Y<0
GOTO EXIT
+3 ;
+4 SET %H=+$HOROLOG
+5 DO YX^%DTC
+6 SET %DT="AE"
+7 SET %DT("A")="Enter Beginning Date: "
+8 SET %DT("B")=Y
+9 FOR
Begin DoDot:1
+10 DO ^%DT
+11 IF Y>DT&(X'="^")
Begin DoDot:2
+12 WRITE !,"You have entered a future or invalid date, please enter a valid date.",!
+13 SET Y=-1
End DoDot:2
IF X="^"!(Y>0)
QUIT
+14 IF $DATA(DTOUT)
SET X="^"
End DoDot:1
IF X="^"!(Y>0)
QUIT
+15 IF X="^"
GOTO EXIT
+16 KILL %DT
+17 SET SDBEG=Y
+18 DO DD^%DT
SET FR=Y
+19 ;
+20 SET Y=DT
DO DD^%DT
+21 SET TO=Y
+22 SET %DT="AE"
+23 SET %DT("A")="Enter Ending Date ("_FR_" - "_TO_") "
+24 SET %DT("B")=Y
+25 FOR
Begin DoDot:1
+26 DO ^%DT
+27 IF Y<SDBEG&(X'="^")
Begin DoDot:2
+28 WRITE !,"A date before the begin date is not allowed, please enter a valid date.",!
+29 SET Y=-1
End DoDot:2
QUIT
+30 IF Y>DT
Begin DoDot:2
+31 WRITE !,"Future dates are not allowed, please enter a valid date.",!
+32 SET Y=-1
End DoDot:2
QUIT
+33 IF Y=-1&(X'="^")
Begin DoDot:2
+34 WRITE !,"You have entered an invalid date, please enter a valid date."
End DoDot:2
QUIT
+35 IF $DATA(DTOUT)
SET X="^"
End DoDot:1
IF X="^"!(Y>0)
QUIT
+36 IF X="^"
GOTO EXIT
+37 SET SDBEG=SDBEG-.0001
+38 SET SDEND=Y_".9999"
+39 DO DD^%DT
SET TO=Y
+40 ;
STOP ; -- one,many,all selection of stop codes
+1 SET VAUTNI=2
+2 SET VAUTSTR="clinic stop code"
+3 SET VAUTVB="SDC"
+4 SET DIC=40.7
+5 DO FIRST^VAUTOMA
+6 IF Y<0
GOTO EXIT
+7 ;
+8 SET DGVAR="SDC#^SDBEG^SDEND^SDX^VAUTD#^TO^FR"
+9 SET DGPGM="QUE^SDACSCGP"
+10 DO ZIS^DGUTQ
+11 IF POP
GOTO EXIT
+12 ;
QUE ; -- entry point
+1 NEW SDOE,SDOE0,SDOECG,DFN,SDDIV,SDT,SDSTOP,SDAPTYPR
+2 SET DASH=""
SET $PIECE(DASH,"-",79)=""
+3 ;
+4 IF '$ORDER(^SCE(SDX,0))
WRITE !!?5,"There are no 'Computer Generated' ",$SELECT(SDX="AG":"Stop Codes.",1:"Appointment Types which need updating.")
GOTO EXIT
+5 ;
+6 SET SDT=SDBEG
+7 FOR
SET SDT=$ORDER(^SCE(SDX,SDT))
IF 'SDT!(SDT>SDEND)
QUIT
Begin DoDot:1
+8 SET SDOE=0
+9 FOR
SET SDOE=$ORDER(^SCE(SDX,SDT,SDOE))
IF 'SDOE
QUIT
Begin DoDot:2
+10 SET SDOE0=$GET(^SCE(SDOE,0))
+11 SET SDOECG=$GET(^SCE(SDOE,"CG"))
+12 SET SDDIV=+$PIECE(SDOE0,U,11)
+13 SET DFN=+$PIECE(SDOE0,U,2)
DO DEM^VADPT
+14 IF VAUTD!($DATA(VAUTD(SDDIV)))
Begin DoDot:3
+15 SET SDSTOP=$PIECE(SDOE0,U,3)
+16 SET SDAPTYPR=+$PIECE(SDOECG,U,2)
+17 IF SDC!($DATA(SDC(SDSTOP)))
DO SORT
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;
PRINT ; -- loop thru division and stop code
+1 SET (PG,SDDIV)=0
+2 FOR
SET SDDIV=$ORDER(^TMP($JOB,SDDIV))
IF 'SDDIV
GOTO EXIT
IF PG
DO CR
IF $DATA(DIRUT)
GOTO EXIT
Begin DoDot:1
+3 DO DIV
DO HDR
+4 SET SDSTOP=0
+5 FOR
SET SDSTOP=$ORDER(^TMP($JOB,SDDIV,SDSTOP))
IF 'SDSTOP
QUIT
DO SCHDR
SET CT=0
DO P1
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
DO SCFTR
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
End DoDot:1
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+6 ;
+7 ; -- loop thru tmp global - do write
P1 SET SDNAM=0
+1 FOR
SET SDNAM=$ORDER(^TMP($JOB,SDDIV,SDSTOP,SDNAM))
IF SDNAM']""
QUIT
Begin DoDot:1
+2 SET SDSSN=""
+3 FOR
SET SDSSN=$ORDER(^TMP($JOB,SDDIV,SDSTOP,SDNAM,SDSSN))
IF SDSSN']""
QUIT
IF $Y+6>IOSL
DO CR
DO HDR
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
DO DAT
End DoDot:1
+4 QUIT
+5 ;
EXIT KILL CT,D,DA,DASH,DE,DFN,DGPGM,DGVAR,DIC,DIE,DIRUT,DQ,DR,DTOUT,DUOUT,I,L,POP,SDA,SDAPTYP,SDBEG,SDC,SDCSNODE,SDDAT,SDEND,SDI,SDJ,SDNAM,SDSSN,SDUPDT,SDX,SDY,SDZNODE,TYPE,VA,VADM,VAERR,VAUTD,Y
+1 KILL FR,PG,TO,SDCSN,SDDIV,SDDIVNAM,SDHDR,SDSTOP,SDSTNUM,SDSTNAM,SDSTZ,VAUTNI,VAUTSTR,VAUTVB,^TMP($JOB)
+2 DO CLOSE^DGUTQ
+3 QUIT
+4 ;
DAT ; -- get and print data
+1 SET SDDAT=0
+2 FOR
SET SDDAT=$ORDER(^TMP($JOB,SDDIV,SDSTOP,SDNAM,SDSSN,SDDAT))
IF 'SDDAT
QUIT
Begin DoDot:1
+3 NEW SDIEN
+4 SET SDIEN=0
+5 FOR
SET SDIEN=$ORDER(^TMP($JOB,SDDIV,SDSTOP,SDNAM,SDSSN,SDDAT,SDIEN))
IF 'SDIEN
QUIT
Begin DoDot:2
+6 SET SDAPTYPR=$GET(^TMP($JOB,SDDIV,SDSTOP,SDNAM,SDSSN,SDDAT,SDIEN))
+7 SET Y=SDDAT
XECUTE ^DD("DD")
+8 SET CT=CT+1
+9 WRITE !,$EXTRACT(SDNAM,1,20),?25,SDSSN,?45,Y
+10 IF SDX="ACG"
WRITE ?70,$SELECT(SDAPTYPR=2:"C&P",SDAPTYPR=1:"ELIG",1:"")
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
SORT ; -- set tmp global to sort in alpha order by ssn & date, count sets
+1 SET CT=0
+2 SET SDNAM=$SELECT('VAERR:VADM(1),1:"UNKNOWN")
+3 SET SDSSN=$SELECT('VAERR:VA("PID"),1:"UNKNOWN")
+4 SET SDDIV=$SELECT(+SDDIV:SDDIV,1:"UNKNOWN")
+5 SET SDSTOP=$SELECT(+SDSTOP:SDSTOP,1:"UNKNOWN")
+6 SET ^TMP($JOB,SDDIV,SDSTOP,SDNAM,SDSSN,+SDOE0,SDOE)=SDAPTYPR
+7 SET CT=CT+1
+8 QUIT
+9 ;
CR ; -- carriage return
+1 IF $DATA(IOST)
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
WRITE !
DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+2 QUIT
+3 ;
DIV ; -- get division name for header
+1 SET SDDIVNAM=$SELECT($DATA(^DG(40.8,+SDDIV,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+2 QUIT
+3 ;
HDR ; -- page header
+1 SET PG=PG+1
+2 SET SDHDR=$SELECT(SDX="ACG":"APPOINTMENT TYPE",1:"STOP CODES")
+3 IF $DATA(IOF)
WRITE @IOF
WRITE !,?IOM-(11+$LENGTH(SDDIVNAM))/2,"DIVISION: ",SDDIVNAM,!,"COMPUTER GENERATED "_SDHDR,?40,FR," TO ",TO,?70,"PAGE ",PG,!,"PATIENT",?25,"PATIENT ID",?45,"VISIT DATE/TIME"
+4 IF SDX="ACG"
WRITE ?70,"REASON"
+5 WRITE !,DASH,!!
+6 QUIT
+7 ;
SCHDR ; -- stop code header
+1 SET SDSTZ=$SELECT($DATA(^DIC(40.7,+SDSTOP,0)):^(0),1:"")
+2 SET SDSTNAM=$SELECT(SDSTZ]"":$PIECE(SDSTZ,"^"),1:"UNKNOWN")
+3 SET SDSTNUM=$SELECT(SDSTZ]"":$PIECE(SDSTZ,"^",2),1:"000")
+4 WRITE !?3,"STOP CODE: ",SDSTNAM
+5 QUIT
+6 ;
SCFTR ; -- footer
+1 IF $Y+6>IOSL
DO CR
DO HDR
+2 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+3 WRITE !!,CT," Computer Generated ",$SELECT(SDX="ACG":"Appointment Types ",1:"Stop Codes "),"for Stop Code, ",SDSTNUM,", ",SDSTNAM,!
+4 QUIT
+5 ;
AG ; -- test ag
+1 NEW SDX
+2 SET SDX="AG"
+3 DO EN
+4 QUIT
+5 ;
ACG ; -- test ag
+1 NEW SDX
+2 SET SDX="ACG"
+3 DO EN
+4 QUIT
+5 ;
