SDAMBMR.m

SDAMBMR ;ALB/MLI - AMBULATORY PROCEDURE MANAGEMENT REPORTS ; 4/24/00 9:20am

 ;;5.3;Scheduling;**140,132,159,180,1015**;Aug 13, 1993;Build 21

EN D Q,ASK2^SDDIV G:Y<0 Q S U="^",SDAS=0

1 S SDFL=0 K DIC W !!,"****Date Range Selection****",!!,"Enter fiscal year or date range within fiscal year",!

 S %DT="AE",%DT("A")="   Beginning DATE : " D ^%DT G Q:Y<0,FY:'$E(Y,4,7) S SDB=Y-.1,%DT(0)=Y W ! S %DT("A")="   Ending DATE : " D ^%DT K %DT G:Y<0 Q W ! D CK G:SDFL 1 S SDE=Y+.9

2 R !,"Sort by 'C'linic or 'S'ervice: C// ",X:DTIME G Q:(X="^")!'$T S Z="^CLINIC^SERVICE" W:X["?" !,"Enter: ",!,?5,"'C' to sort data by clinic",!,?5,"'S' to sort by service" I X="" S X="C" W X

 D IN^DGHELP S SDSC=X G 2:%=-1,4:X="C"

3 F SDI=0:0 W !,"Enter Service: " W:'$D(SDS) "ALL//" R X:DTIME Q:X=""!(X="^")!'$T  D:X["?" QS^SDAMBMR1 S Z="^MEDICINE^SURGERY^PSYCHIATRY^REHAB MEDICINE^NEUROLOGY" D IN^DGHELP I %'=-1 S SDS(X)=""

 G Q:X="^"!'$T I X="",'$D(SDS) S SDS="",SDAS=1

 S VAUTC="" G 5

4 S VAUTNI=1 D CLINIC^VAUTOMA G Q:Y<0

5 R !,"Brief or Expanded Report? B//",X:DTIME G Q:X="^"!'$T S Z="^BRIEF^EXPANDED" W:X["?" !,"Enter 'B'rief to see a simple breakdown by clinic or service",!,"or 'E'xpanded to be able to sort by procedure or by patient" I X="" S X="B" W X

 ;D IN^DGHELP S SDRT=X G 5:%=-1,9:X="B"

 D IN^DGHELP S SDRT=X G 5:%=-1 I SDRT="B" S SDMOD=0 G 9

6 R !,"Sort by 'P'rocedure or patient 'N'ame: P//",X:DTIME G Q:X="^"!'$T S Z="^PROCEDURE^NAME" W:X["?" !,"Enter:",!,"'P'to sort by procedure",!,"'N' to sort by patient name" I X="" S X="P" W X

 D IN^DGHELP S SDPN=X G 6:%=-1,8:X="P"

7 S VAUTNI=1 D PATIENT^VAUTOMA G Q:Y<0 D MOD G 9

8 S DIC="^ICPT(",DIC("S")="I '$P(^(0),U,4)",VAUTNI=1,VAUTSTR="CPT code",VAUTVB="SD" D FIRST^VAUTOMA G Q:Y<0 S SDP=SD

 I $D(SD) F I=0:0 S I=$O(SD(I)) Q:I'?5AN  S SDP(SD(I))=I K SD(I)

 K SD

 D MOD

PN W !,"Do you want to see patient names" S %=2 D YN^DICN I %Y["?" W !,"Enter 'Y'es to see patients alphabetized within procedure",!,"'N'o to see just subtotals of number of patients receiving each procedure."

 G Q:%Y["^",PN:%'>0 S SDPT=%

9 W !,"*** Note: this report not designed to display on a CRT.  ***" S DGVAR="SDAS^VAUTD#^SDB^SDE^SDSC^SDS#^VAUTC#^SDRT^SDPN^VAUTN#^SDP#^SDPT^SDMOD",DGPGM="10^SDAMBMR" D ZIS^DGUTQ G:POP Q U IO D 10 Q

10 N SDDT,SDOE,SDOE0,SDVIEN,SDOEP,SDCODT,SDVCPT

 K ^TMP("SDVSTS",$J)

 K ^TMP("SDV",$J)

 S SDFG=0

 S VADAT("F")=1,VADAT("D")="/" D ^VADATE

 D INIT^SDAMBMR3

 S SDNOW=$TR($$FMTE^XLFDT(VADATE("I"),"5F")," ","0")

 D KVAR^VADATE

 ;

 S SDDT=SDB F  S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>SDE)  D

 . S SDI=SDDT

 . S SDOE=0

 . F  S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE  D

 . . I $$OKAE^SDVSIT2(SDOE),$D(^SCE(SDOE,0)) D

 . . . S SDOE0=$G(^SCE(SDOE,0))

 . . . S DFN=+$P(SDOE0,U,2)

 . . . S SDVIEN=+$P(SDOE0,U,5)

 . . . S SDOEP=+$P(SDOE0,U,6)

 . . . S SDCODT=+$P(SDOE0,U,7)

 . . . ;

 . . . ; -- checks

 . . . Q:SDOEP                                   ; -- can't have a parent

 . . . Q:'SDCODT                                 ; -- co must be completed

 . . . Q:'$D(^DPT(DFN,0))                        ; -- pat record must exist

 . . . IF SDVIEN,$D(^TMP("SDVSTS",$J,SDVIEN)) Q  ; -- only process visit once

 . . . IF 'SDVIEN,$D(^TMP("SDV",$J,DFN,+$P(+SDOE0,"."),+$P(SDOE,U,4))) Q  ; -- only process dfn/date/clinic once for old encounters

 . . . Q:'$$CPT^SDOE(SDOE)                       ; -- at least one cpt exists

 . . . Q:$P($G(^SC(+$P(SDOE0,U,4),0)),U,3)'="C"  ; -- location must be a clinic

 . . . ;

 . . . D ^SDAMBMR1

 . . . IF SDVIEN S ^TMP("SDVSTS",$J,SDVIEN)=SDOE

 . . . IF 'SDVIEN S ^TMP("SDV",$J,DFN,+$P(+SDOE0,"."),+$P(SDOE,U,4))=SDOE

 K ^TMP("SDVSTS",$J)

 K ^TMP("SDV",$J)

 ;

 D 1^SDAMBMR2:SDTOT,NONE^SDAMBMR1:'SDTOT

Q W ! K SDAGE,SDAGEH,SDAGET,SDAGETT,SDAS,SDB,SDCL,SDCT,SDDIV,SDE,SDF,SDFG,SDFL,SDFY,SDHI,SDI,SDINFO,SDJ,SDN,SDNOW,SDP,SDPG,SDPN,SDPR,SDPRC,SDPRO,SDPT,SDRT,SDS,SDSC,SDSTP,SDSTR,SDSXF,SDSXM,SDT,SDTOT,SDTT,SDTXT,SDVB,SDX,SDY,SDVST

 K %,^TMP($J),%DT,%Y,DFN,DGPGM,DGVAR,DIC,I,I1,J,J1,K,K1,L,L1,M,N,POP,PR,SDMOD,VAUTC,VAUTD,VAUTN,X,Y,Z,QUES,%I,%QMK,%YN,ANS,C,DEF D KVAR^VADPT,KVAR^VADATE,CLOSE^DGUTQ Q

FY S SDFY=$E(Y,1,3),SDB=((SDFY-1_"1001")-.1),SDE=(SDFY_"0930")+.9 G 2

QQ S SDTXT=$P($P(DIC("A")," ",2),":") W !,"Enter a ",SDTXT," or 'return' when all ",SDTXT,"s have been selected",!,"You may select a maximum of 20 ",SDTXT,"s" Q

CK S SDY=$S($E(SDB,4,5)>9:$E(SDB,1,3)+1,1:$E(SDB,1,3)) I Y>(SDY_"1000") W !,"Dates must be within fiscal year" S SDFL=1 Q

 Q

MOD N DIR,Y,DTOUT,DIRUT,DUOUT

 S DIR(0)="Y"

 S DIR("A")="Do you want to include CPT modifiers on the report"

 S DIR("B")="Yes"

 D ^DIR

 I $D(DTOUT)!($D(DIRUT)) G Q

 S SDMOD=+Y

 Q

SDAMBMR   ;ALB/MLI - AMBULATORY PROCEDURE MANAGEMENT REPORTS ; 4/24/00 9:20am

 +1       ;;5.3;Scheduling;**140,132,159,180,1015**;Aug 13, 1993;Build 21

EN         DO Q

           DO ASK2^SDDIV

           IF Y<0

               GOTO Q

           SET U="^"

           SET SDAS=0

1          SET SDFL=0

           KILL DIC

           WRITE !!,"****Date Range Selection****",!!,"Enter fiscal year or date range within fiscal year",!

 +1        SET %DT="AE"

           SET %DT("A")="   Beginning DATE : "

           DO ^%DT

           IF Y<0

               GOTO Q

           IF '$EXTRACT(Y,4,7)

               GOTO FY

           SET SDB=Y-.1

           SET %DT(0)=Y

           WRITE !

           SET %DT("A")="   Ending DATE : "

           DO ^%DT

           KILL %DT

           IF Y<0

               GOTO Q

           WRITE !

           DO CK

           IF SDFL

               GOTO 1

           SET SDE=Y+.9

2          READ !,"Sort by 'C'linic or 'S'ervice: C// ",X:DTIME

           IF (X="^")!'$TEST

               GOTO Q

           SET Z="^CLINIC^SERVICE"

           IF X["?"

               WRITE !,"Enter: ",!,?5,"'C' to sort data by clinic",!,?5,"'S' to sort by service"

           IF X=""

               SET X="C"

               WRITE X

 +1        DO IN^DGHELP

           SET SDSC=X

           IF %=-1

               GOTO 2

           IF X="C"

               GOTO 4

3          FOR SDI=0:0

               WRITE !,"Enter Service: "

               IF '$DATA(SDS)

                   WRITE "ALL//"

               READ X:DTIME

               IF X=""!(X="^")!'$TEST

                   QUIT 

               IF X["?"

                   DO QS^SDAMBMR1

               SET Z="^MEDICINE^SURGERY^PSYCHIATRY^REHAB MEDICINE^NEUROLOGY"

               DO IN^DGHELP

               IF %'=-1

                   SET SDS(X)=""

 +1        IF X="^"!'$TEST

               GOTO Q

           IF X=""

               IF '$DATA(SDS)

                   SET SDS=""

                   SET SDAS=1

 +2        SET VAUTC=""

           GOTO 5

4          SET VAUTNI=1

           DO CLINIC^VAUTOMA

           IF Y<0

               GOTO Q

5          READ !,"Brief or Expanded Report? B//",X:DTIME

           IF X="^"!'$TEST

               GOTO Q

           SET Z="^BRIEF^EXPANDED"

           IF X["?"

               WRITE !,"Enter 'B'rief to see a simple breakdown by clinic or service",!,"or 'E'xpanded to be able to sort by procedure or by patient"

           IF X=""

               SET X="B"

               WRITE X

 +1       ;D IN^DGHELP S SDRT=X G 5:%=-1,9:X="B"

 +2        DO IN^DGHELP

           SET SDRT=X

           IF %=-1

               GOTO 5

           IF SDRT="B"

               SET SDMOD=0

               GOTO 9

6          READ !,"Sort by 'P'rocedure or patient 'N'ame: P//",X:DTIME

           IF X="^"!'$TEST

               GOTO Q

           SET Z="^PROCEDURE^NAME"

           IF X["?"

               WRITE !,"Enter:",!,"'P'to sort by procedure",!,"'N' to sort by patient name"

           IF X=""

               SET X="P"

               WRITE X

 +1        DO IN^DGHELP

           SET SDPN=X

           IF %=-1

               GOTO 6

           IF X="P"

               GOTO 8

7          SET VAUTNI=1

           DO PATIENT^VAUTOMA

           IF Y<0

               GOTO Q

           DO MOD

           GOTO 9

8          SET DIC="^ICPT("

           SET DIC("S")="I '$P(^(0),U,4)"

           SET VAUTNI=1

           SET VAUTSTR="CPT code"

           SET VAUTVB="SD"

           DO FIRST^VAUTOMA

           IF Y<0

               GOTO Q

           SET SDP=SD

 +1        IF $DATA(SD)

               FOR I=0:0

                   SET I=$ORDER(SD(I))

                   IF I'?5AN

                       QUIT 

                   SET SDP(SD(I))=I

                   KILL SD(I)

 +2        KILL SD

 +3        DO MOD

PN         WRITE !,"Do you want to see patient names"

           SET %=2

           DO YN^DICN

           IF %Y["?"

               WRITE !,"Enter 'Y'es to see patients alphabetized within procedure",!,"'N'o to see just subtotals of number of patients receiving each procedure."

 +1        IF %Y["^"

               GOTO Q

           IF %'>0

               GOTO PN

           SET SDPT=%

9          WRITE !,"*** Note: this report not designed to display on a CRT.  ***"

           SET DGVAR="SDAS^VAUTD#^SDB^SDE^SDSC^SDS#^VAUTC#^SDRT^SDPN^VAUTN#^SDP#^SDPT^SDMOD"

           SET DGPGM="10^SDAMBMR"

           DO ZIS^DGUTQ

           IF POP

               GOTO Q

           USE IO

           DO 10

           QUIT 

10         NEW SDDT,SDOE,SDOE0,SDVIEN,SDOEP,SDCODT,SDVCPT

 +1        KILL ^TMP("SDVSTS",$JOB)

 +2        KILL ^TMP("SDV",$JOB)

 +3        SET SDFG=0

 +4        SET VADAT("F")=1

           SET VADAT("D")="/"

           DO ^VADATE

 +5        DO INIT^SDAMBMR3

 +6        SET SDNOW=$TRANSLATE($$FMTE^XLFDT(VADATE("I"),"5F")," ","0")

 +7        DO KVAR^VADATE

 +8       ;

 +9        SET SDDT=SDB

           FOR 

               SET SDDT=$ORDER(^SCE("B",SDDT))

               IF 'SDDT!(SDDT>SDE)

                   QUIT 

               Begin DoDot:1

 +10               SET SDI=SDDT

 +11               SET SDOE=0

 +12               FOR 

                       SET SDOE=$ORDER(^SCE("B",SDDT,SDOE))

                       IF 'SDOE

                           QUIT 

                       Begin DoDot:2

 +13                       IF $$OKAE^SDVSIT2(SDOE)

                               IF $DATA(^SCE(SDOE,0))

                                   Begin DoDot:3

 +14                                   SET SDOE0=$GET(^SCE(SDOE,0))

 +15                                   SET DFN=+$PIECE(SDOE0,U,2)

 +16                                   SET SDVIEN=+$PIECE(SDOE0,U,5)

 +17                                   SET SDOEP=+$PIECE(SDOE0,U,6)

 +18                                   SET SDCODT=+$PIECE(SDOE0,U,7)

 +19      ;

 +20      ; -- checks

 +21      ; -- can't have a parent

                                       IF SDOEP

                                           QUIT 

 +22      ; -- co must be completed

                                       IF 'SDCODT

                                           QUIT 

 +23      ; -- pat record must exist

                                       IF '$DATA(^DPT(DFN,0))

                                           QUIT 

 +24      ; -- only process visit once

                                       IF SDVIEN

                                           IF $DATA(^TMP("SDVSTS",$JOB,SDVIEN))

                                               QUIT 

 +25      ; -- only process dfn/date/clinic once for old encounters

                                       IF 'SDVIEN

                                           IF $DATA(^TMP("SDV",$JOB,DFN,+$PIECE(+SDOE0,"."),+$PIECE(SDOE,U,4)))

                                               QUIT 

 +26      ; -- at least one cpt exists

                                       IF '$$CPT^SDOE(SDOE)

                                           QUIT 

 +27      ; -- location must be a clinic

                                       IF $PIECE($GET(^SC(+$PIECE(SDOE0,U,4),0)),U,3)'="C"

                                           QUIT 

 +28      ;

 +29                                   DO ^SDAMBMR1

 +30                                   IF SDVIEN

                                           SET ^TMP("SDVSTS",$JOB,SDVIEN)=SDOE

 +31                                   IF 'SDVIEN

                                           SET ^TMP("SDV",$JOB,DFN,+$PIECE(+SDOE0,"."),+$PIECE(SDOE,U,4))=SDOE

                                   End DoDot:3

                       End DoDot:2

               End DoDot:1

 +32       KILL ^TMP("SDVSTS",$JOB)

 +33       KILL ^TMP("SDV",$JOB)

 +34      ;

 +35       IF SDTOT

               DO 1^SDAMBMR2

           IF 'SDTOT

               DO NONE^SDAMBMR1

Q          WRITE !

           KILL SDAGE,SDAGEH,SDAGET,SDAGETT,SDAS,SDB,SDCL,SDCT,SDDIV,SDE,SDF,SDFG,SDFL,SDFY,SDHI,SDI,SDINFO,SDJ,SDN,SDNOW,SDP,SDPG,SDPN,SDPR,SDPRC,SDPRO,SDPT,SDRT,SDS,SDSC,SDSTP,SDSTR,SDSXF,SDSXM,SDT,SDTOT,SDTT,SDTXT,SDVB,SDX,SDY,SDVST

 +1        KILL %,^TMP($JOB),%DT,%Y,DFN,DGPGM,DGVAR,DIC,I,I1,J,J1,K,K1,L,L1,M,N,POP,PR,SDMOD,VAUTC,VAUTD,VAUTN,X,Y,Z,QUES,%I,%QMK,%YN,ANS,C,DEF

           DO KVAR^VADPT

           DO KVAR^VADATE

           DO CLOSE^DGUTQ

           QUIT 

FY         SET SDFY=$EXTRACT(Y,1,3)

           SET SDB=((SDFY-1_"1001")-.1)

           SET SDE=(SDFY_"0930")+.9

           GOTO 2

QQ         SET SDTXT=$PIECE($PIECE(DIC("A")," ",2),":")

           WRITE !,"Enter a ",SDTXT," or 'return' when all ",SDTXT,"s have been selected",!,"You may select a maximum of 20 ",SDTXT,"s"

           QUIT 

CK         SET SDY=$SELECT($EXTRACT(SDB,4,5)>9:$EXTRACT(SDB,1,3)+1,1:$EXTRACT(SDB,1,3))

           IF Y>(SDY_"1000")

               WRITE !,"Dates must be within fiscal year"

               SET SDFL=1

               QUIT 

 +1        QUIT 

MOD        NEW DIR,Y,DTOUT,DIRUT,DUOUT

 +1        SET DIR(0)="Y"

 +2        SET DIR("A")="Do you want to include CPT modifiers on the report"

 +3        SET DIR("B")="Yes"

 +4        DO ^DIR

 +5        IF $DATA(DTOUT)!($DATA(DIRUT))

               GOTO Q

 +6        SET SDMOD=+Y

 +7        QUIT