SDAMBMR ;ALB/MLI - AMBULATORY PROCEDURE MANAGEMENT REPORTS ; 4/24/00 9:20am
;;5.3;Scheduling;**140,132,159,180,556**;Aug 13, 1993;Build 3
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($$CPT^ICPTCOD(Y),U,7)",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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMBMR 4679 printed Dec 13, 2024@02:47:27 Page 2
SDAMBMR ;ALB/MLI - AMBULATORY PROCEDURE MANAGEMENT REPORTS ; 4/24/00 9:20am
+1 ;;5.3;Scheduling;**140,132,159,180,556**;Aug 13, 1993;Build 3
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($$CPT^ICPTCOD(Y),U,7)"
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
