SDACSCGP.m

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       ;