- SCRPW20 ;RENO/KEITH - ACRP Ad Hoc Report ;15 Nov 98 4:31 PM
- ;;5.3;Scheduling;**144,171,593**;AUG 13, 1993;Build 13
- I $E(IOST)'="C" D Q
- .N SDX S SDX="Your current terminal type is "_IOST_"." W !?(IOM-$L(SDX)\2),SDX
- .S SDX="This option requires a CRT terminal type!" W !!?(IOM-$L(SDX)\2),SDX,! Q
- K ^TMP("SCRPW",$J),SDPAR D BLD^SCRPW21 N DIR,X,Y,SDOUT,T S (SDREV,SDOUT)=0,T="~"
- F SDTAG="INTRO","FMT","PERS","LIM","ORD","XPF","REVIEW" D @SDTAG Q:SDOUT!SDREV
- G:SDOUT EXIT^SCRPW27 D SAVT^SCRPW21(.SDPAR)
- QUE N ZTSAVE S ZTSAVE("SDPAR(")="" D MAR^SCRPW29,EN^XUTMDEVQ("RPT^SCRPW26","ACRP Ad Hoc Report",.ZTSAVE) G EXIT^SCRPW27
- ;
- INTRO K SDBOT S (SDTOP,SDBOT(1))="A C R P A d H o c R e p o r t" D DISP^SCRPW23(SDTOP,.SDBOT),INTRO^SCRPW26
- I $$REST^SCRPW22() H 1 S SDREV=1 G REVIEW
- Q:SDOUT I '$O(^SDD(409.91,0)) W !! K DIR S DIR(0)="E" S X=$$DIR^SCRPW23(.DIR,0)
- Q
- FMT ;Get format parameters
- S SDS1="F",(SDOUT,SDNUL)=0,SDBOT(1)="Report format selection",SDBOT(2)="Report format parameters determine the appearance of the report."
- D DISP^SCRPW23("R E P O R T F O R M A T",.SDBOT)
- F SDTAG="F1","F2","F3","F4","F5","F6" D @SDTAG Q:SDOUT
- G:$$VF^SCRPW29() FMT I SDREV G:$$VP^SCRPW29() PERS
- Q
- PERS ;Prompt for perspective
- K SDBOT S SDS1="P",(SDOUT,SDNUL)=0,SDBOT(1)="Report perspective selection",SDBOT(2)="The element selected for this parameter will determine how the statistics will",SDBOT(3)="be organized and sub-totaled."
- D DISP^SCRPW23("R E P O R T P E R S P E C T I V E",.SDBOT)
- D P1 G:$$VP^SCRPW29() PERS Q
- LIM ;Prompt for limitations
- K SDBOT S SDS1="L",(SDOUT,SDNUL)=0
- S SDBOT(1)="Report limitation selection",SDBOT(2)="Limiting factors determine which encounter records to count. Multiple limiting",SDBOT(3)="factors can be chosen and specified to only include (or exclude) specific data."
- D DISP^SCRPW23("R E P O R T L I M I T A T I O N S",.SDBOT)
- F SDTAG="L1","L2" D @SDTAG Q:SDOUT
- G:$$VL^SCRPW29() LIM Q
- ORD ;Prompt for print order
- K SDBOT S SDS1="O",(SDOUT,SDNUL)=0,SDBOT(1)="Report print order selection",SDBOT(2)="This parameter determines the order in which the report will be printed."
- D DISP^SCRPW23("R E P O R T P R I N T O R D E R",.SDBOT)
- K DIR D DIRB1^SCRPW23("O",1,"ALPHABETIC") S DIR("A")="Select report print order",DIR(0)="S^A:ALPHABETIC;E:ENCOUNTER TOTAL;V:VISIT TOTAL;U:UNIQUE TOTAL",DIR("?")="Specify the order to print elements of selected perspective."
- S SDX=$$DIR^SCRPW23(.DIR,0) S:$L(SDX) SDPAR("O",1)=SDX Q:SDOUT
- D DESC^SCRPW22 Q:SDOUT G:$$VO^SCRPW29() ORD Q
- ;
- XY(X) ;Maintain $X, $Y
- ;Required input: X=screen handling variable to write
- N DX,DY S DX=$X,DY=$Y W X X SDXY Q ""
- ;
- XPF ;Extra print fields
- D PF^SCRPW29 Q
- ;
- REVIEW ;Review selected parameters
- D REVSCR,REV0 Q
- ;
- REVSCR K SDBOT S SDTOP="S e l e c t e d R e p o r t P a r a m e t e r s",SDBOT(1)="Parameters selected for ACRP Ad Hoc Report",SDBOT(2)="These parameters will determine the appearance and data contained in the output."
- D DISP^SCRPW23(SDTOP,.SDBOT) Q
- ;
- VERS ;Verify segments
- W ! F SDX="VF","VP","VL","VO" S SDX="$$"_SDX_"^SCRPW29(1)" I @(SDX)
- Q
- ;
- REV0 N SDERR S SDREV=1,SDOUT=0 D PLIST^SCRPW22(0,15) S SDOUT=0
- REV1 D VERS W:SDOUT ! S SDOUT=0 W !?32,$$XY(IORVON)," Report action ",$$XY(IORVOFF)
- K DIR S DIR("A")="Select report action",DIR(0)="S^C:CONTINUE;E:EDIT PARAMETERS;R:RE-DISPLAY PARAMETERS;P:PRINT PARAMETERS;Q:QUIT",DIR("B")="CONTINUE",SDACT=$P($$DIR^SCRPW23(.DIR,0),U)
- I $D(DTOUT)!$D(DUOUT)!(SDACT="Q") S SDOUT=1 Q
- I SDACT="P" N ZTSAVE S ZTSAVE("SDPAR(")="" W ! D EN^XUTMDEVQ("PPAR^SCRPW27","ACRP Ad Hoc Report Parameters",.ZTSAVE) G REV1
- G:SDACT="R" REVIEW
- I SDACT="C" D Q:'SDOUT S SDOUT=0 S SDERR="" G REV1
- . S SDOUT=0 D VERS
- . I SDOUT W !!,"Required information missing. Unable to continue with queuing!" H 3 Q
- . S SDOUT=$$VERICD^SCRPW29(.SDERR)
- . I SDOUT W:$G(SDERR)]"" !!,SDERR W !!,"Unable to continue with queuing!" H 3 Q
- F S (SDOUT,SDNUL)=0 W !!?31,$$XY(IORVON)," Re-edit actions ",$$XY(IORVOFF) D RDIR S SDACT=$P($$DIR^SCRPW23(.DIR,0),U) Q:SDOUT!SDNUL D REV2,REVSCR Q:SDOUT!SDNUL
- S (SDOUT,SDNUL)=0 G REV1
- ;
- RDIR K DIR S DIR("A")="Select section to re-edit",DIR(0)="SO^F:FORMAT;P:PERSPECTIVE;L:LIMITATIONS;O:ORDER;"_$$PFC^SCRPW29()_"A:ALL SECTIONS;E:EXIT FROM RE-EDIT" Q
- ;
- REV2 I SDACT="E" S SDNUL=1 Q
- D @($S(SDACT="F":"FMT",SDACT="P":"PERS",SDACT="L":"LIM",SDACT="O":"ORD",SDACT="X":"XPF",1:"REV3")) Q
- ;
- REV3 F SDACT="FMT","PERS","LIM","ORD","XPF" D @SDACT Q:SDOUT
- Q
- ;
- F1 K DIR D DIRB1^SCRPW23("F",1,"SUMMARY") S DIR("A")="Select report format",DIR(0)="S^D:DETAILED;S:SUMMARY",DIR("?",1)="DETAILED format allows the listing of encounters, visits or uniques and ranked"
- S DIR("?",2)="lists of diagnoses and procedures for selected items in the selected",DIR("?",3)="perspective. SUMMARY format provides subtotals of encounters, visits and"
- S DIR("?",4)="uniques for all items in a selected perspective and allows subtotals to be",DIR("?")="compared to the same date range in the previous year.",SDX=$$DIR^SCRPW23(.DIR,0) S:$L(SDX) SDPAR("F",1)=SDX D PFR^SCRPW29 Q
- ;
- F2 I $P(SDPAR("F",1),U)="S" W ! K DIR D DIRB1^SCRPW23("F",2,"NO") S DIR("A")="Compare data to same date range for the previous year",DIR(0)="Y",SDX=$$DIR^SCRPW23(.DIR,0) S:$L(SDX) SDPAR("F",2)=SDX
- Q
- ;
- F3 Q:$P(SDPAR("F",1),U)="S" K DIR D DIRB1^SCRPW23("F",3)
- S DIR("A")="Select type of detail",DIR(0)="S^E:ENCOUNTER/VISIT/UNIQUE LIST;D:DIAGNOSIS/PROCEDURE RANKING;B:BOTH ACTIVITY & DX/PROC. LISTS",SDX=$$DIR^SCRPW23(.DIR,0) S:$L(SDX) SDPAR("F",3)=SDX D PFR^SCRPW29 Q
- ;
- F4 Q:$P(SDPAR("F",1),U)="S" Q:"BE"'[$P(SDPAR("F",3),U)
- K DIR D DIRB1^SCRPW23("F",4) S DIR("A")="List activity by",DIR(0)="S^E:ENCOUNTER;V:VISIT;U:UNIQUE",SDX=$$DIR^SCRPW23(.DIR,0) S:$L(SDX) SDPAR("F",4)=SDX D PFR^SCRPW29 Q
- ;
- F5 Q:$P(SDPAR("F",1),U)="S" Q:"BD"'[$P(SDPAR("F",3),U) K DIR
- W ! D DIRB1^SCRPW23("F",5,50) S DIR("A")="Limit Dx/procedure list to most frequent",DIR(0)="N^1:999:0",DIR("?")="Specify how many of the most frequent items to list.",SDX=$$DIR^SCRPW23(.DIR,0) S:$L(SDX) SDPAR("F",5)=SDX Q
- ;
- F6 K DIR W ! D DIRB1^SCRPW23("F",6,"FORMATTED TEXT") S DIR("A")="Produce output as",DIR(0)="S^F:FORMATTED TEXT;D:DELIMITED VALUES FOR EXPORT TO SPREADSHEET",SDX=$$DIR^SCRPW23(.DIR,0) S:$L(SDX) SDPAR("F",6)=SDX Q
- ;
- P1 K DIR,SDPAR("X") D DIRB1^SCRPW23("P",1) S DIR("A")="Select report perspective",DIR("?")="Specify the element to be used for report subtotals." S SDNUL=0,SDS1="P",SDS2=1 D CAT^SCRPW22($S(SDREV:"E",1:"A")) Q:SDOUT
- Q
- ;
- L1 N %DT,SDS1,I10DTI,I10DTE D SUBT^SCRPW50("*** Date Range Selection ***")
- S Y=$$IMP^SCRPWICD(30) S I10DTI=Y X ^DD("DD") S I10DTE=Y
- FDT W ! S %DT="AEPX",%DT("A")="Beginning date: ",%DT(0)="-TODAY" D DIRB1^SCRPW23("L",1) S:$D(DIR("B")) %DT("B")=DIR("B") D ^%DT I X=U!($D(DTOUT)) S SDOUT=1 Q
- G:Y<1 FDT K:Y>$G(SDPAR("L",2)) SDPAR("L",2) S SDS1=Y X ^DD("DD") S SDPAR("L",1)=SDS1_U_Y
- LDT W ! S %DT("A")=" Ending date: " D DIRB1^SCRPW23("L",2) S:$D(DIR("B")) %DT("B")=DIR("B") D ^%DT I X=U!($D(DTOUT)) S SDOUT=1 Q
- I Y<$P(SDPAR("L",1),U) W !!,$C(7),"Ending date must be after beginning date!" G LDT
- S SDS1=Y X ^DD("DD") S SDPAR("L",2)=SDS1_U_Y
- I ($P(SDPAR("L",1),U,1)<I10DTI),($P(SDPAR("L",2),U,1)'<I10DTI) D G FDT
- . W !!,$C(7),"Beginning and Ending dates must both be prior to "_I10DTE_" (ICD-9) or both be on or after "_I10DTE_" (ICD-10)."
- Q
- ;
- L2 I SDREV D AED^SCRPW22("L") Q
- L2A S SDS1="L",SDS2=$O(SDPAR(SDS1,""),-1),SDNUL=0 F Q:SDOUT!SDNUL S SDS2=SDS2+1 D:'$D(SDPAR(SDS1,SDS2)) L3
- Q
- L3 S SDX="Select "_$S(SDS2=3:"additional",1:"another")_" output limiting factor: (optional)" W !!?(80-$L(SDX)\2),$$XY(IORVON),SDX,$$XY(IORVOFF) D LDIR,CAT^SCRPW22("A") Q
- ;
- LDIR K DIR S DIR("A")="Select limiting factor",DIR("?")="Specify elements to be used to restrict the scope of data returned." Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW20 7898 printed Apr 23, 2025@18:57:54 Page 2
- SCRPW20 ;RENO/KEITH - ACRP Ad Hoc Report ;15 Nov 98 4:31 PM
- +1 ;;5.3;Scheduling;**144,171,593**;AUG 13, 1993;Build 13
- +2 IF $EXTRACT(IOST)'="C"
- Begin DoDot:1
- +3 NEW SDX
- SET SDX="Your current terminal type is "_IOST_"."
- WRITE !?(IOM-$LENGTH(SDX)\2),SDX
- +4 SET SDX="This option requires a CRT terminal type!"
- WRITE !!?(IOM-$LENGTH(SDX)\2),SDX,!
- QUIT
- End DoDot:1
- QUIT
- +5 KILL ^TMP("SCRPW",$JOB),SDPAR
- DO BLD^SCRPW21
- NEW DIR,X,Y,SDOUT,T
- SET (SDREV,SDOUT)=0
- SET T="~"
- +6 FOR SDTAG="INTRO","FMT","PERS","LIM","ORD","XPF","REVIEW"
- DO @SDTAG
- if SDOUT!SDREV
- QUIT
- +7 if SDOUT
- GOTO EXIT^SCRPW27
- DO SAVT^SCRPW21(.SDPAR)
- QUE NEW ZTSAVE
- SET ZTSAVE("SDPAR(")=""
- DO MAR^SCRPW29
- DO EN^XUTMDEVQ("RPT^SCRPW26","ACRP Ad Hoc Report",.ZTSAVE)
- GOTO EXIT^SCRPW27
- +1 ;
- INTRO KILL SDBOT
- SET (SDTOP,SDBOT(1))="A C R P A d H o c R e p o r t"
- DO DISP^SCRPW23(SDTOP,.SDBOT)
- DO INTRO^SCRPW26
- +1 IF $$REST^SCRPW22()
- HANG 1
- SET SDREV=1
- GOTO REVIEW
- +2 if SDOUT
- QUIT
- IF '$ORDER(^SDD(409.91,0))
- WRITE !!
- KILL DIR
- SET DIR(0)="E"
- SET X=$$DIR^SCRPW23(.DIR,0)
- +3 QUIT
- FMT ;Get format parameters
- +1 SET SDS1="F"
- SET (SDOUT,SDNUL)=0
- SET SDBOT(1)="Report format selection"
- SET SDBOT(2)="Report format parameters determine the appearance of the report."
- +2 DO DISP^SCRPW23("R E P O R T F O R M A T",.SDBOT)
- +3 FOR SDTAG="F1","F2","F3","F4","F5","F6"
- DO @SDTAG
- if SDOUT
- QUIT
- +4 if $$VF^SCRPW29()
- GOTO FMT
- IF SDREV
- if $$VP^SCRPW29()
- GOTO PERS
- +5 QUIT
- PERS ;Prompt for perspective
- +1 KILL SDBOT
- SET SDS1="P"
- SET (SDOUT,SDNUL)=0
- SET SDBOT(1)="Report perspective selection"
- SET SDBOT(2)="The element selected for this parameter will determine how the statistics will"
- SET SDBOT(3)="be organized and sub-totaled."
- +2 DO DISP^SCRPW23("R E P O R T P E R S P E C T I V E",.SDBOT)
- +3 DO P1
- if $$VP^SCRPW29()
- GOTO PERS
- QUIT
- LIM ;Prompt for limitations
- +1 KILL SDBOT
- SET SDS1="L"
- SET (SDOUT,SDNUL)=0
- +2 SET SDBOT(1)="Report limitation selection"
- SET SDBOT(2)="Limiting factors determine which encounter records to count. Multiple limiting"
- SET SDBOT(3)="factors can be chosen and specified to only include (or exclude) specific data."
- +3 DO DISP^SCRPW23("R E P O R T L I M I T A T I O N S",.SDBOT)
- +4 FOR SDTAG="L1","L2"
- DO @SDTAG
- if SDOUT
- QUIT
- +5 if $$VL^SCRPW29()
- GOTO LIM
- QUIT
- ORD ;Prompt for print order
- +1 KILL SDBOT
- SET SDS1="O"
- SET (SDOUT,SDNUL)=0
- SET SDBOT(1)="Report print order selection"
- SET SDBOT(2)="This parameter determines the order in which the report will be printed."
- +2 DO DISP^SCRPW23("R E P O R T P R I N T O R D E R",.SDBOT)
- +3 KILL DIR
- DO DIRB1^SCRPW23("O",1,"ALPHABETIC")
- SET DIR("A")="Select report print order"
- SET DIR(0)="S^A:ALPHABETIC;E:ENCOUNTER TOTAL;V:VISIT TOTAL;U:UNIQUE TOTAL"
- SET DIR("?")="Specify the order to print elements of selected perspective."
- +4 SET SDX=$$DIR^SCRPW23(.DIR,0)
- if $LENGTH(SDX)
- SET SDPAR("O",1)=SDX
- if SDOUT
- QUIT
- +5 DO DESC^SCRPW22
- if SDOUT
- QUIT
- if $$VO^SCRPW29()
- GOTO ORD
- QUIT
- +6 ;
- XY(X) ;Maintain $X, $Y
- +1 ;Required input: X=screen handling variable to write
- +2 NEW DX,DY
- SET DX=$X
- SET DY=$Y
- WRITE X
- XECUTE SDXY
- QUIT ""
- +3 ;
- XPF ;Extra print fields
- +1 DO PF^SCRPW29
- QUIT
- +2 ;
- REVIEW ;Review selected parameters
- +1 DO REVSCR
- DO REV0
- QUIT
- +2 ;
- REVSCR KILL SDBOT
- SET SDTOP="S e l e c t e d R e p o r t P a r a m e t e r s"
- SET SDBOT(1)="Parameters selected for ACRP Ad Hoc Report"
- SET SDBOT(2)="These parameters will determine the appearance and data contained in the output."
- +1 DO DISP^SCRPW23(SDTOP,.SDBOT)
- QUIT
- +2 ;
- VERS ;Verify segments
- +1 WRITE !
- FOR SDX="VF","VP","VL","VO"
- SET SDX="$$"_SDX_"^SCRPW29(1)"
- IF @(SDX)
- +2 QUIT
- +3 ;
- REV0 NEW SDERR
- SET SDREV=1
- SET SDOUT=0
- DO PLIST^SCRPW22(0,15)
- SET SDOUT=0
- REV1 DO VERS
- if SDOUT
- WRITE !
- SET SDOUT=0
- WRITE !?32,$$XY(IORVON)," Report action ",$$XY(IORVOFF)
- +1 KILL DIR
- SET DIR("A")="Select report action"
- SET DIR(0)="S^C:CONTINUE;E:EDIT PARAMETERS;R:RE-DISPLAY PARAMETERS;P:PRINT PARAMETERS;Q:QUIT"
- SET DIR("B")="CONTINUE"
- SET SDACT=$PIECE($$DIR^SCRPW23(.DIR,0),U)
- +2 IF $DATA(DTOUT)!$DATA(DUOUT)!(SDACT="Q")
- SET SDOUT=1
- QUIT
- +3 IF SDACT="P"
- NEW ZTSAVE
- SET ZTSAVE("SDPAR(")=""
- WRITE !
- DO EN^XUTMDEVQ("PPAR^SCRPW27","ACRP Ad Hoc Report Parameters",.ZTSAVE)
- GOTO REV1
- +4 if SDACT="R"
- GOTO REVIEW
- +5 IF SDACT="C"
- Begin DoDot:1
- +6 SET SDOUT=0
- DO VERS
- +7 IF SDOUT
- WRITE !!,"Required information missing. Unable to continue with queuing!"
- HANG 3
- QUIT
- +8 SET SDOUT=$$VERICD^SCRPW29(.SDERR)
- +9 IF SDOUT
- if $GET(SDERR)]""
- WRITE !!,SDERR
- WRITE !!,"Unable to continue with queuing!"
- HANG 3
- QUIT
- End DoDot:1
- if 'SDOUT
- QUIT
- SET SDOUT=0
- SET SDERR=""
- GOTO REV1
- +10 FOR
- SET (SDOUT,SDNUL)=0
- WRITE !!?31,$$XY(IORVON)," Re-edit actions ",$$XY(IORVOFF)
- DO RDIR
- SET SDACT=$PIECE($$DIR^SCRPW23(.DIR,0),U)
- if SDOUT!SDNUL
- QUIT
- DO REV2
- DO REVSCR
- if SDOUT!SDNUL
- QUIT
- +11 SET (SDOUT,SDNUL)=0
- GOTO REV1
- +12 ;
- RDIR KILL DIR
- SET DIR("A")="Select section to re-edit"
- SET DIR(0)="SO^F:FORMAT;P:PERSPECTIVE;L:LIMITATIONS;O:ORDER;"_$$PFC^SCRPW29()_"A:ALL SECTIONS;E:EXIT FROM RE-EDIT"
- QUIT
- +1 ;
- REV2 IF SDACT="E"
- SET SDNUL=1
- QUIT
- +1 DO @($SELECT(SDACT="F":"FMT",SDACT="P":"PERS",SDACT="L":"LIM",SDACT="O":"ORD",SDACT="X":"XPF",1:"REV3"))
- QUIT
- +2 ;
- REV3 FOR SDACT="FMT","PERS","LIM","ORD","XPF"
- DO @SDACT
- if SDOUT
- QUIT
- +1 QUIT
- +2 ;
- F1 KILL DIR
- DO DIRB1^SCRPW23("F",1,"SUMMARY")
- SET DIR("A")="Select report format"
- SET DIR(0)="S^D:DETAILED;S:SUMMARY"
- SET DIR("?",1)="DETAILED format allows the listing of encounters, visits or uniques and ranked"
- +1 SET DIR("?",2)="lists of diagnoses and procedures for selected items in the selected"
- SET DIR("?",3)="perspective. SUMMARY format provides subtotals of encounters, visits and"
- +2 SET DIR("?",4)="uniques for all items in a selected perspective and allows subtotals to be"
- SET DIR("?")="compared to the same date range in the previous year."
- SET SDX=$$DIR^SCRPW23(.DIR,0)
- if $LENGTH(SDX)
- SET SDPAR("F",1)=SDX
- DO PFR^SCRPW29
- QUIT
- +3 ;
- F2 IF $PIECE(SDPAR("F",1),U)="S"
- WRITE !
- KILL DIR
- DO DIRB1^SCRPW23("F",2,"NO")
- SET DIR("A")="Compare data to same date range for the previous year"
- SET DIR(0)="Y"
- SET SDX=$$DIR^SCRPW23(.DIR,0)
- if $LENGTH(SDX)
- SET SDPAR("F",2)=SDX
- +1 QUIT
- +2 ;
- F3 if $PIECE(SDPAR("F",1),U)="S"
- QUIT
- KILL DIR
- DO DIRB1^SCRPW23("F",3)
- +1 SET DIR("A")="Select type of detail"
- SET DIR(0)="S^E:ENCOUNTER/VISIT/UNIQUE LIST;D:DIAGNOSIS/PROCEDURE RANKING;B:BOTH ACTIVITY & DX/PROC. LISTS"
- SET SDX=$$DIR^SCRPW23(.DIR,0)
- if $LENGTH(SDX)
- SET SDPAR("F",3)=SDX
- DO PFR^SCRPW29
- QUIT
- +2 ;
- F4 if $PIECE(SDPAR("F",1),U)="S"
- QUIT
- if "BE"'[$PIECE(SDPAR("F",3),U)
- QUIT
- +1 KILL DIR
- DO DIRB1^SCRPW23("F",4)
- SET DIR("A")="List activity by"
- SET DIR(0)="S^E:ENCOUNTER;V:VISIT;U:UNIQUE"
- SET SDX=$$DIR^SCRPW23(.DIR,0)
- if $LENGTH(SDX)
- SET SDPAR("F",4)=SDX
- DO PFR^SCRPW29
- QUIT
- +2 ;
- F5 if $PIECE(SDPAR("F",1),U)="S"
- QUIT
- if "BD"'[$PIECE(SDPAR("F",3),U)
- QUIT
- KILL DIR
- +1 WRITE !
- DO DIRB1^SCRPW23("F",5,50)
- SET DIR("A")="Limit Dx/procedure list to most frequent"
- SET DIR(0)="N^1:999:0"
- SET DIR("?")="Specify how many of the most frequent items to list."
- SET SDX=$$DIR^SCRPW23(.DIR,0)
- if $LENGTH(SDX)
- SET SDPAR("F",5)=SDX
- QUIT
- +2 ;
- F6 KILL DIR
- WRITE !
- DO DIRB1^SCRPW23("F",6,"FORMATTED TEXT")
- SET DIR("A")="Produce output as"
- SET DIR(0)="S^F:FORMATTED TEXT;D:DELIMITED VALUES FOR EXPORT TO SPREADSHEET"
- SET SDX=$$DIR^SCRPW23(.DIR,0)
- if $LENGTH(SDX)
- SET SDPAR("F",6)=SDX
- QUIT
- +1 ;
- P1 KILL DIR,SDPAR("X")
- DO DIRB1^SCRPW23("P",1)
- SET DIR("A")="Select report perspective"
- SET DIR("?")="Specify the element to be used for report subtotals."
- SET SDNUL=0
- SET SDS1="P"
- SET SDS2=1
- DO CAT^SCRPW22($SELECT(SDREV:"E",1:"A"))
- if SDOUT
- QUIT
- +1 QUIT
- +2 ;
- L1 NEW %DT,SDS1,I10DTI,I10DTE
- DO SUBT^SCRPW50("*** Date Range Selection ***")
- +1 SET Y=$$IMP^SCRPWICD(30)
- SET I10DTI=Y
- XECUTE ^DD("DD")
- SET I10DTE=Y
- FDT WRITE !
- SET %DT="AEPX"
- SET %DT("A")="Beginning date: "
- SET %DT(0)="-TODAY"
- DO DIRB1^SCRPW23("L",1)
- if $DATA(DIR("B"))
- SET %DT("B")=DIR("B")
- DO ^%DT
- IF X=U!($DATA(DTOUT))
- SET SDOUT=1
- QUIT
- +1 if Y<1
- GOTO FDT
- if Y>$GET(SDPAR("L",2))
- KILL SDPAR("L",2)
- SET SDS1=Y
- XECUTE ^DD("DD")
- SET SDPAR("L",1)=SDS1_U_Y
- LDT WRITE !
- SET %DT("A")=" Ending date: "
- DO DIRB1^SCRPW23("L",2)
- if $DATA(DIR("B"))
- SET %DT("B")=DIR("B")
- DO ^%DT
- IF X=U!($DATA(DTOUT))
- SET SDOUT=1
- QUIT
- +1 IF Y<$PIECE(SDPAR("L",1),U)
- WRITE !!,$CHAR(7),"Ending date must be after beginning date!"
- GOTO LDT
- +2 SET SDS1=Y
- XECUTE ^DD("DD")
- SET SDPAR("L",2)=SDS1_U_Y
- +3 IF ($PIECE(SDPAR("L",1),U,1)<I10DTI)
- IF ($PIECE(SDPAR("L",2),U,1)'<I10DTI)
- Begin DoDot:1
- +4 WRITE !!,$CHAR(7),"Beginning and Ending dates must both be prior to "_I10DTE_" (ICD-9) or both be on or after "_I10DTE_" (ICD-10)."
- End DoDot:1
- GOTO FDT
- +5 QUIT
- +6 ;
- L2 IF SDREV
- DO AED^SCRPW22("L")
- QUIT
- L2A SET SDS1="L"
- SET SDS2=$ORDER(SDPAR(SDS1,""),-1)
- SET SDNUL=0
- FOR
- if SDOUT!SDNUL
- QUIT
- SET SDS2=SDS2+1
- if '$DATA(SDPAR(SDS1,SDS2))
- DO L3
- +1 QUIT
- L3 SET SDX="Select "_$SELECT(SDS2=3:"additional",1:"another")_" output limiting factor: (optional)"
- WRITE !!?(80-$LENGTH(SDX)\2),$$XY(IORVON),SDX,$$XY(IORVOFF)
- DO LDIR
- DO CAT^SCRPW22("A")
- QUIT
- +1 ;
- LDIR KILL DIR
- SET DIR("A")="Select limiting factor"
- SET DIR("?")="Specify elements to be used to restrict the scope of data returned."
- QUIT