- IBJD ;ALB/CPM - DIAGNOSTIC MEASURES UTILITIES ; 16-DEC-96
- ;;2.0;INTEGRATED BILLING;**69,123**;21-MAR-94
- ;
- DS ; Print a (S)ummary or (D)etail Report?
- S DIR(0)="SA^S:SUMMARY;D:DETAILED;"
- S DIR("A")="Do you wish to print a (S)ummary or (D)etailed Report? "
- S DIR("?")="^D HDS^IBJD"
- W ! D ^DIR K DIR S IBRPT=Y
- Q
- ;
- SDIV() ; - Sort by division.
- ; Output: SDIV = 1 - Sort by Division / 0 - Do not sort by Division
- ; or "^" - User selected "^"
- ; VAUTD = 1 - All divisions selected / 0 - Specific divisions
- ; VAUTD(DIV) = Divsions selected
- ;
- N SDIV,DIR,J
- ;
- K DIR,VAUTD S DIR(0)="Y",DIR("B")="NO" W !
- S DIR("A")="Do you wish to sort this report by division"
- S DIR("T")=DTIME,DIR("?")="^D HDIV^IBJD"
- D ^DIR K DIR
- I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S SDIV="^" G QDIV
- S SDIV=+Y K DIROUT,DTOUT,DUOUT,DIRUT
- I SDIV D PSDR^IBODIV I Y<0 S SDIV="^"
- ;
- ; - Set VAUTD when ALL divisions have been selected
- I SDIV,VAUTD S J=0 F S J=$O(^DG(40.8,J)) Q:'J S VAUTD(J)=""
- ;
- QDIV Q SDIV
- ;
- MLTP(PRPT,OPT,ALL) ; Function for multiple value selection
- ; Input: PRPT - String to be prompted to the user, before listing options
- ; OPT - Array containing the possible entries (indexed by code)
- ; Obs: Code must be sequential starting with 1
- ; ALL - Flag indicating if the last option is ALL OF THE ABOVE
- ;
- ; Output: MLTP - User selection, i.e. "1,2,3," or "1," or 0 (nothing
- ; was selected)
- ;
- N A,DIR,DIRUT,DTOUT,DUOUT,DIROUT,I,IX,LST,MLTP
- ;
- PRPT S MLTP=0,ALL=+$G(ALL)
- S LST=$O(OPT(""),-1)
- S DIR(0)="LO^1:"_LST_"^K:+$P(X,""-"",2)>"_LST_" X"
- S DIR("A",1)=$G(PRPT),DIR("A",2)=""
- S A="",IX=3
- F S A=$O(OPT(A)) Q:A="" D
- . S DIR("A",IX)=" "_A_" - "_$G(OPT(A)),IX=IX+1
- S DIR("A",IX)="",DIR("A")="Select",DIR("B")=LST,DIR("T")=DTIME W !
- D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G QT
- S MLTP=Y K DIROUT,DTOUT,DUOUT,DIRUT
- ;
- I ALL,MLTP[LST S MLTP=LST_","
- ;
- S DIR(0)="Y",DIR("A",1)="You have selected",DIR("A",2)=""
- S A="",IX=3
- F I=1:1:($L(MLTP,",")-1) D
- . S DIR("A",IX)=" "_$P(MLTP,",",I)_" - "_$G(OPT($P(MLTP,",",I)))
- . S IX=IX+1
- S DIR("A",IX)=""
- S DIR("A")="Are you sure",DIR("B")="NO",DIR("T")=DTIME W !
- D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S MLTP=0 G QT
- K DIROUT,DTOUT,DUOUT,DIRUT I 'Y K DIR G PRPT
- ;
- I ALL,MLTP[LST D
- . S MLTP="" F I=(LST-1):-1:1 S MLTP=I_","_MLTP
- ;
- QT Q MLTP
- ;
- SNL() ; - Determine the sorting of the patient (By Name or Last 4 SSN)
- ; Output: SNL = "N" (Name)/"L" (Last 4 SSN) ^ "NAME" or "LAST 4"
- ;
- N DIR,DIRUT,DTOUT,DUOUT,DIROUT,SNL
- S SNL=""
- S DIR(0)="SA^N:NAME;L:LAST 4"
- S DIR("A")="Sort Patients by (N)AME or (L)AST 4 of the SSN: "
- S DIR("B")="NAME",DIR("T")=DTIME,DIR("?")="^D HNL^IBJD"
- W ! D ^DIR K DIR I Y=""!(X="^") Q "^"
- S SNL=Y
- ;
- Q SNL
- ;
- INTV(SORT) ; Selects the interval
- ; Output: First value ^ Last Value ^ "ALL"/"NULL"/""
- ;
- N ALNU,FRST,LAST,X
- ;
- S (ALNU,FRST,LAST)=""
- FRST W !!?3,"START WITH "_SORT_": FIRST// " R X:DTIME I '$T!(X["^") Q "^"
- I $E(X)="?" D HFST G FRST
- S FRST=X
- LAST W !?8,"GO TO "_SORT_": LAST// " R X:DTIME I '$T!(X["^") Q "^"
- I $E(X)="?" D HLST G LAST
- I X="" S LAST="zzzzz" S:FRST="" ALNU="ALL" G QINT
- I X="@",FRST="@" S LAST="@",ALNU="NULL" G QINT
- I FRST'="@",FRST]X D G LAST
- .W *7,!!?7,"The LAST value must follow the FIRST.",!
- S LAST=X
- ;
- QINT Q (FRST_"^"_LAST_"^"_ALNU)
- ;
- EXCEL() ; - Returns whether to catpture data for Excel report.
- ; Output: EXCEL = 1 - YES (capture data) / 0 - NO (DO NOT capture data)
- ;
- N EXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
- ;
- S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !
- S DIR("A")="Do you want to capture report data for an Excel document"
- S DIR("?")="^D HEXC^IBJD"
- D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q "^"
- K DIROUT,DTOUT,DUOUT,DIRUT
- S EXCEL=0 I Y S EXCEL=1
- ;
- Q EXCEL
- ;
- CLMACT(X,Y) ; - Check if AR has a corresponding claim or IB action.
- ; Input: X=Claim/AR pointer to file #399/#430
- ; Y=AR category pointer to file #430.2
- ; Output: Z=1-IB action, 2-Claim, 3-No IB action or claim
- ; ^ IB action IEN (if 1) or AR/claim IEN (if 2 or 3)
- ; OR null=Invalid IB action or claim
- N ACT,BILL,NODE,NODE1,Z S Z="" G:'$G(X)!('$G(Y)) CLACQ
- S BILL=$P($G(^PRCA(430,X,0)),U) G:BILL="" CLACQ
- ;
- ; - Check for most recent IB action.
- S ACT=+$O(^IB("ABIL",BILL,9999999),-1) G:'ACT CLAC1
- S NODE=$G(^IB(ACT,0)) G:NODE="" CLAC1
- I $P(NODE,U,5)'=3!($P(NODE,U,10)) G CLACQ ; Not billed/cancelled.
- I $P($G(^IBE(350.1,+$P(NODE,U,3),0)),U,3)=Y S Z=1_U_ACT G CLACQ
- ;
- CLAC1 ; - Check for IB claim.
- I '$D(^DGCR(399,X,0)) S Z=3_U_X G CLACQ ; No IB action/claim.
- S NODE=$G(^DGCR(399,X,0)) G:$P(NODE,U,13)=7 CLACQ ; Cancelled claim.
- S NODE1=$G(^DGCR(399.3,+$P(NODE,U,7),0)) G:NODE1="" CLACQ
- I '$P(NODE1,U,3),$P(NODE1,U,6)=Y S Z=2_U_X
- CLACQ Q Z
- ;
- ALSP(PRPT,FILE,ARR) ; Selection of (A)LL or (S)pecific values from a given file
- ; Input: PRPT - Piece 1: Label for the PROMPT to be asked for the
- ; selection (in the plural) - e.g. "Providers"
- ; Piece 2: Singular of piece 1 - e.g. "Provider"
- ; Exaple: "Specialties^Specialty"
- ; FILE - File global root (e.g., "^IBE(356.8," ) that the values
- ; will be selected from
- ; ARR - Name of the array that will contain the specific values
- ; (must be passed as a refernce value ".ARR")
- ; Output: ARR - "A" - ALL values OR "S" - Specific values OR "^"
- ; The values will be returned in the array indicated in
- ; ARR parameter
- ;
- N DIC,PRL,SNG,X
- K ARR S PRL=$P(PRPT,"^"),SNG=$P(PRPT,"^",2) S:SNG="" SNG=PRL
- ALSP1 W !!,"Run report for (A)LL or (S)PECIFIC "_PRL_": A// "
- R X:DTIME I '$T!(X["^") S ARR="^" G QALSP
- S X=$S(X="":"A",1:$E(X)) I "AaSs"'[X D HALSP G ALSP1
- W " ",$S("Ss"[X:"SPECIFIC",1:"ALL") I "Aa"[X K ARR S ARR="A" G QALSP
- S ARR="S"
- ALSP2 S DIC=FILE,DIC(0)="AEQMZ"
- S DIC("A")=" Select a"_$S($O(ARR(""))'="":"nother",1:"")_" "
- S DIC("A")=DIC("A")_SNG_": "
- D ^DIC K DIC I $D(DTOUT)!($D(DUOUT)) K ARR S ARR="^" G QALSP
- I Y'>0 G ALSP1:$O(ARR(""))="" G QALSP
- I $D(ARR(+Y)) D G ALSP2
- . W !!?3,"Already selected. Choose another "_SNG,*7,!
- S ARR(+Y)="" G ALSP2
- ;
- QALSP Q
- ;
- HDS ; Help for Summary/Detail prompt.
- W !,"Please enter 'S' for 'Summary' or 'D' for a Detailed Report."
- W !,"Note that if you select the Detailed report, the Summary will also print."
- Q
- ;
- HDIV ; - 'Sort by division...' prompt
- W !!," Enter: '<CR>' - To print the report without regard to division"
- W !!," 'Y' - To select those divisions for which a separate"
- W !," report should be created"
- W !," '^' - To quit this option"
- Q
- ;
- HNL ; - 'Sort Patients by (N)AME... ' prompt
- W !!," Enter: '<CR>' - To select and sort patients by name"
- W !!," 'L' - To select and sort patients by the last 4"
- W !," of the SSN"
- W !," '^' - To quit this option"
- Q
- ;
- HFST ; - 'START WITH PATIENT/DEBTOR...' prompt
- W !!," Enter a valid field value, or"
- W !!," '@' - To include null values"
- W !," '<CR>' - To start from the 'first' value for this field"
- W !," '^' - To quit this option"
- Q
- ;
- HLST ; - 'GO TO PATIENT/DEBTOR' prompt
- W !!," Enter a valid field value, or"
- W !!," '@' - To include only null values, if 'Start with'"
- W !," value is @"
- W !," '<CR>' - To go to the 'last' value for this field"
- W !," '^' - To quit this option",!
- Q
- ;
- HEXC ; - 'Do you want to capture data...' prompt
- W !!," Enter: 'Y' - To capture detail report data to transfer"
- W !," to an Excel document"
- W !," '<CR>' - To skip this option"
- W !," '^' - To quit this option"
- Q
- ;
- HALSP ; - 'Run report for (A)LL or (S)pecific...' prompt.
- W !!?6,"Enter: '<CR>' - To select all "_PRL
- W !?16,"'S' - To select one or more "_PRL
- W !?16,"'^' - To quit this option"
- Q
- ;
- EXMSG ; - Displays the message about capturing to an Excel file format
- ;
- W !!?5,"Before continuing, please set up your terminal to capture the"
- W !?5,"detail report data. On some terminals, this can be done by"
- W !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
- W !?5,"Incoming Data' to save to Desktop. This report may take a"
- W !?5,"while to run."
- W !!?5,"Note: To avoid undesired wrapping of the data saved to the"
- W !?5," file, please enter '0;256;999' at the 'DEVICE:' prompt.",!
- Q
- ;
- EXPAND(FILE,FIELD,VALUE) ; Resolve coded data.
- N Y,C S Y=VALUE
- I 'FILE!('FIELD)!(VALUE="") G EXPQ
- S Y=VALUE,C=$P(^DD(FILE,FIELD,0),"^",2) D Y^DIQ
- EXPQ Q Y
- ;
- DT(X,Y) ; - Return date.
- ; Input: X=Date in Fileman format
- ; Output: Z=Date in MMM DD,YYYY format or MMDDYY format if Y=1
- N Z S Z="" G:'$G(X) DTQ
- I $G(Y) S Z=$E(X,4,7)_$E(X,2,3) G DTQ
- N Y S Y=X X ^DD("DD") S Z=$P(Y,"@")
- DTQ Q Z
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJD 9293 printed Jan 18, 2025@03:23:45 Page 2
- IBJD ;ALB/CPM - DIAGNOSTIC MEASURES UTILITIES ; 16-DEC-96
- +1 ;;2.0;INTEGRATED BILLING;**69,123**;21-MAR-94
- +2 ;
- DS ; Print a (S)ummary or (D)etail Report?
- +1 SET DIR(0)="SA^S:SUMMARY;D:DETAILED;"
- +2 SET DIR("A")="Do you wish to print a (S)ummary or (D)etailed Report? "
- +3 SET DIR("?")="^D HDS^IBJD"
- +4 WRITE !
- DO ^DIR
- KILL DIR
- SET IBRPT=Y
- +5 QUIT
- +6 ;
- SDIV() ; - Sort by division.
- +1 ; Output: SDIV = 1 - Sort by Division / 0 - Do not sort by Division
- +2 ; or "^" - User selected "^"
- +3 ; VAUTD = 1 - All divisions selected / 0 - Specific divisions
- +4 ; VAUTD(DIV) = Divsions selected
- +5 ;
- +6 NEW SDIV,DIR,J
- +7 ;
- +8 KILL DIR,VAUTD
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- WRITE !
- +9 SET DIR("A")="Do you wish to sort this report by division"
- +10 SET DIR("T")=DTIME
- SET DIR("?")="^D HDIV^IBJD"
- +11 DO ^DIR
- KILL DIR
- +12 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- SET SDIV="^"
- GOTO QDIV
- +13 SET SDIV=+Y
- KILL DIROUT,DTOUT,DUOUT,DIRUT
- +14 IF SDIV
- DO PSDR^IBODIV
- IF Y<0
- SET SDIV="^"
- +15 ;
- +16 ; - Set VAUTD when ALL divisions have been selected
- +17 IF SDIV
- IF VAUTD
- SET J=0
- FOR
- SET J=$ORDER(^DG(40.8,J))
- if 'J
- QUIT
- SET VAUTD(J)=""
- +18 ;
- QDIV QUIT SDIV
- +1 ;
- MLTP(PRPT,OPT,ALL) ; Function for multiple value selection
- +1 ; Input: PRPT - String to be prompted to the user, before listing options
- +2 ; OPT - Array containing the possible entries (indexed by code)
- +3 ; Obs: Code must be sequential starting with 1
- +4 ; ALL - Flag indicating if the last option is ALL OF THE ABOVE
- +5 ;
- +6 ; Output: MLTP - User selection, i.e. "1,2,3," or "1," or 0 (nothing
- +7 ; was selected)
- +8 ;
- +9 NEW A,DIR,DIRUT,DTOUT,DUOUT,DIROUT,I,IX,LST,MLTP
- +10 ;
- PRPT SET MLTP=0
- SET ALL=+$GET(ALL)
- +1 SET LST=$ORDER(OPT(""),-1)
- +2 SET DIR(0)="LO^1:"_LST_"^K:+$P(X,""-"",2)>"_LST_" X"
- +3 SET DIR("A",1)=$GET(PRPT)
- SET DIR("A",2)=""
- +4 SET A=""
- SET IX=3
- +5 FOR
- SET A=$ORDER(OPT(A))
- if A=""
- QUIT
- Begin DoDot:1
- +6 SET DIR("A",IX)=" "_A_" - "_$GET(OPT(A))
- SET IX=IX+1
- End DoDot:1
- +7 SET DIR("A",IX)=""
- SET DIR("A")="Select"
- SET DIR("B")=LST
- SET DIR("T")=DTIME
- WRITE !
- +8 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO QT
- +9 SET MLTP=Y
- KILL DIROUT,DTOUT,DUOUT,DIRUT
- +10 ;
- +11 IF ALL
- IF MLTP[LST
- SET MLTP=LST_","
- +12 ;
- +13 SET DIR(0)="Y"
- SET DIR("A",1)="You have selected"
- SET DIR("A",2)=""
- +14 SET A=""
- SET IX=3
- +15 FOR I=1:1:($LENGTH(MLTP,",")-1)
- Begin DoDot:1
- +16 SET DIR("A",IX)=" "_$PIECE(MLTP,",",I)_" - "_$GET(OPT($PIECE(MLTP,",",I)))
- +17 SET IX=IX+1
- End DoDot:1
- +18 SET DIR("A",IX)=""
- +19 SET DIR("A")="Are you sure"
- SET DIR("B")="NO"
- SET DIR("T")=DTIME
- WRITE !
- +20 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- SET MLTP=0
- GOTO QT
- +21 KILL DIROUT,DTOUT,DUOUT,DIRUT
- IF 'Y
- KILL DIR
- GOTO PRPT
- +22 ;
- +23 IF ALL
- IF MLTP[LST
- Begin DoDot:1
- +24 SET MLTP=""
- FOR I=(LST-1):-1:1
- SET MLTP=I_","_MLTP
- End DoDot:1
- +25 ;
- QT QUIT MLTP
- +1 ;
- SNL() ; - Determine the sorting of the patient (By Name or Last 4 SSN)
- +1 ; Output: SNL = "N" (Name)/"L" (Last 4 SSN) ^ "NAME" or "LAST 4"
- +2 ;
- +3 NEW DIR,DIRUT,DTOUT,DUOUT,DIROUT,SNL
- +4 SET SNL=""
- +5 SET DIR(0)="SA^N:NAME;L:LAST 4"
- +6 SET DIR("A")="Sort Patients by (N)AME or (L)AST 4 of the SSN: "
- +7 SET DIR("B")="NAME"
- SET DIR("T")=DTIME
- SET DIR("?")="^D HNL^IBJD"
- +8 WRITE !
- DO ^DIR
- KILL DIR
- IF Y=""!(X="^")
- QUIT "^"
- +9 SET SNL=Y
- +10 ;
- +11 QUIT SNL
- +12 ;
- INTV(SORT) ; Selects the interval
- +1 ; Output: First value ^ Last Value ^ "ALL"/"NULL"/""
- +2 ;
- +3 NEW ALNU,FRST,LAST,X
- +4 ;
- +5 SET (ALNU,FRST,LAST)=""
- FRST WRITE !!?3,"START WITH "_SORT_": FIRST// "
- READ X:DTIME
- IF '$TEST!(X["^")
- QUIT "^"
- +1 IF $EXTRACT(X)="?"
- DO HFST
- GOTO FRST
- +2 SET FRST=X
- LAST WRITE !?8,"GO TO "_SORT_": LAST// "
- READ X:DTIME
- IF '$TEST!(X["^")
- QUIT "^"
- +1 IF $EXTRACT(X)="?"
- DO HLST
- GOTO LAST
- +2 IF X=""
- SET LAST="zzzzz"
- if FRST=""
- SET ALNU="ALL"
- GOTO QINT
- +3 IF X="@"
- IF FRST="@"
- SET LAST="@"
- SET ALNU="NULL"
- GOTO QINT
- +4 IF FRST'="@"
- IF FRST]X
- Begin DoDot:1
- +5 WRITE *7,!!?7,"The LAST value must follow the FIRST.",!
- End DoDot:1
- GOTO LAST
- +6 SET LAST=X
- +7 ;
- QINT QUIT (FRST_"^"_LAST_"^"_ALNU)
- +1 ;
- EXCEL() ; - Returns whether to catpture data for Excel report.
- +1 ; Output: EXCEL = 1 - YES (capture data) / 0 - NO (DO NOT capture data)
- +2 ;
- +3 NEW EXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
- +4 ;
- +5 SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("T")=DTIME
- WRITE !
- +6 SET DIR("A")="Do you want to capture report data for an Excel document"
- +7 SET DIR("?")="^D HEXC^IBJD"
- +8 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT "^"
- +9 KILL DIROUT,DTOUT,DUOUT,DIRUT
- +10 SET EXCEL=0
- IF Y
- SET EXCEL=1
- +11 ;
- +12 QUIT EXCEL
- +13 ;
- CLMACT(X,Y) ; - Check if AR has a corresponding claim or IB action.
- +1 ; Input: X=Claim/AR pointer to file #399/#430
- +2 ; Y=AR category pointer to file #430.2
- +3 ; Output: Z=1-IB action, 2-Claim, 3-No IB action or claim
- +4 ; ^ IB action IEN (if 1) or AR/claim IEN (if 2 or 3)
- +5 ; OR null=Invalid IB action or claim
- +6 NEW ACT,BILL,NODE,NODE1,Z
- SET Z=""
- if '$GET(X)!('$GET(Y))
- GOTO CLACQ
- +7 SET BILL=$PIECE($GET(^PRCA(430,X,0)),U)
- if BILL=""
- GOTO CLACQ
- +8 ;
- +9 ; - Check for most recent IB action.
- +10 SET ACT=+$ORDER(^IB("ABIL",BILL,9999999),-1)
- if 'ACT
- GOTO CLAC1
- +11 SET NODE=$GET(^IB(ACT,0))
- if NODE=""
- GOTO CLAC1
- +12 ; Not billed/cancelled.
- IF $PIECE(NODE,U,5)'=3!($PIECE(NODE,U,10))
- GOTO CLACQ
- +13 IF $PIECE($GET(^IBE(350.1,+$PIECE(NODE,U,3),0)),U,3)=Y
- SET Z=1_U_ACT
- GOTO CLACQ
- +14 ;
- CLAC1 ; - Check for IB claim.
- +1 ; No IB action/claim.
- IF '$DATA(^DGCR(399,X,0))
- SET Z=3_U_X
- GOTO CLACQ
- +2 ; Cancelled claim.
- SET NODE=$GET(^DGCR(399,X,0))
- if $PIECE(NODE,U,13)=7
- GOTO CLACQ
- +3 SET NODE1=$GET(^DGCR(399.3,+$PIECE(NODE,U,7),0))
- if NODE1=""
- GOTO CLACQ
- +4 IF '$PIECE(NODE1,U,3)
- IF $PIECE(NODE1,U,6)=Y
- SET Z=2_U_X
- CLACQ QUIT Z
- +1 ;
- ALSP(PRPT,FILE,ARR) ; Selection of (A)LL or (S)pecific values from a given file
- +1 ; Input: PRPT - Piece 1: Label for the PROMPT to be asked for the
- +2 ; selection (in the plural) - e.g. "Providers"
- +3 ; Piece 2: Singular of piece 1 - e.g. "Provider"
- +4 ; Exaple: "Specialties^Specialty"
- +5 ; FILE - File global root (e.g., "^IBE(356.8," ) that the values
- +6 ; will be selected from
- +7 ; ARR - Name of the array that will contain the specific values
- +8 ; (must be passed as a refernce value ".ARR")
- +9 ; Output: ARR - "A" - ALL values OR "S" - Specific values OR "^"
- +10 ; The values will be returned in the array indicated in
- +11 ; ARR parameter
- +12 ;
- +13 NEW DIC,PRL,SNG,X
- +14 KILL ARR
- SET PRL=$PIECE(PRPT,"^")
- SET SNG=$PIECE(PRPT,"^",2)
- if SNG=""
- SET SNG=PRL
- ALSP1 WRITE !!,"Run report for (A)LL or (S)PECIFIC "_PRL_": A// "
- +1 READ X:DTIME
- IF '$TEST!(X["^")
- SET ARR="^"
- GOTO QALSP
- +2 SET X=$SELECT(X="":"A",1:$EXTRACT(X))
- IF "AaSs"'[X
- DO HALSP
- GOTO ALSP1
- +3 WRITE " ",$SELECT("Ss"[X:"SPECIFIC",1:"ALL")
- IF "Aa"[X
- KILL ARR
- SET ARR="A"
- GOTO QALSP
- +4 SET ARR="S"
- ALSP2 SET DIC=FILE
- SET DIC(0)="AEQMZ"
- +1 SET DIC("A")=" Select a"_$SELECT($ORDER(ARR(""))'="":"nother",1:"")_" "
- +2 SET DIC("A")=DIC("A")_SNG_": "
- +3 DO ^DIC
- KILL DIC
- IF $DATA(DTOUT)!($DATA(DUOUT))
- KILL ARR
- SET ARR="^"
- GOTO QALSP
- +4 IF Y'>0
- if $ORDER(ARR(""))=""
- GOTO ALSP1
- GOTO QALSP
- +5 IF $DATA(ARR(+Y))
- Begin DoDot:1
- +6 WRITE !!?3,"Already selected. Choose another "_SNG,*7,!
- End DoDot:1
- GOTO ALSP2
- +7 SET ARR(+Y)=""
- GOTO ALSP2
- +8 ;
- QALSP QUIT
- +1 ;
- HDS ; Help for Summary/Detail prompt.
- +1 WRITE !,"Please enter 'S' for 'Summary' or 'D' for a Detailed Report."
- +2 WRITE !,"Note that if you select the Detailed report, the Summary will also print."
- +3 QUIT
- +4 ;
- HDIV ; - 'Sort by division...' prompt
- +1 WRITE !!," Enter: '<CR>' - To print the report without regard to division"
- +2 WRITE !!," 'Y' - To select those divisions for which a separate"
- +3 WRITE !," report should be created"
- +4 WRITE !," '^' - To quit this option"
- +5 QUIT
- +6 ;
- HNL ; - 'Sort Patients by (N)AME... ' prompt
- +1 WRITE !!," Enter: '<CR>' - To select and sort patients by name"
- +2 WRITE !!," 'L' - To select and sort patients by the last 4"
- +3 WRITE !," of the SSN"
- +4 WRITE !," '^' - To quit this option"
- +5 QUIT
- +6 ;
- HFST ; - 'START WITH PATIENT/DEBTOR...' prompt
- +1 WRITE !!," Enter a valid field value, or"
- +2 WRITE !!," '@' - To include null values"
- +3 WRITE !," '<CR>' - To start from the 'first' value for this field"
- +4 WRITE !," '^' - To quit this option"
- +5 QUIT
- +6 ;
- HLST ; - 'GO TO PATIENT/DEBTOR' prompt
- +1 WRITE !!," Enter a valid field value, or"
- +2 WRITE !!," '@' - To include only null values, if 'Start with'"
- +3 WRITE !," value is @"
- +4 WRITE !," '<CR>' - To go to the 'last' value for this field"
- +5 WRITE !," '^' - To quit this option",!
- +6 QUIT
- +7 ;
- HEXC ; - 'Do you want to capture data...' prompt
- +1 WRITE !!," Enter: 'Y' - To capture detail report data to transfer"
- +2 WRITE !," to an Excel document"
- +3 WRITE !," '<CR>' - To skip this option"
- +4 WRITE !," '^' - To quit this option"
- +5 QUIT
- +6 ;
- HALSP ; - 'Run report for (A)LL or (S)pecific...' prompt.
- +1 WRITE !!?6,"Enter: '<CR>' - To select all "_PRL
- +2 WRITE !?16,"'S' - To select one or more "_PRL
- +3 WRITE !?16,"'^' - To quit this option"
- +4 QUIT
- +5 ;
- EXMSG ; - Displays the message about capturing to an Excel file format
- +1 ;
- +2 WRITE !!?5,"Before continuing, please set up your terminal to capture the"
- +3 WRITE !?5,"detail report data. On some terminals, this can be done by"
- +4 WRITE !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
- +5 WRITE !?5,"Incoming Data' to save to Desktop. This report may take a"
- +6 WRITE !?5,"while to run."
- +7 WRITE !!?5,"Note: To avoid undesired wrapping of the data saved to the"
- +8 WRITE !?5," file, please enter '0;256;999' at the 'DEVICE:' prompt.",!
- +9 QUIT
- +10 ;
- EXPAND(FILE,FIELD,VALUE) ; Resolve coded data.
- +1 NEW Y,C
- SET Y=VALUE
- +2 IF 'FILE!('FIELD)!(VALUE="")
- GOTO EXPQ
- +3 SET Y=VALUE
- SET C=$PIECE(^DD(FILE,FIELD,0),"^",2)
- DO Y^DIQ
- EXPQ QUIT Y
- +1 ;
- DT(X,Y) ; - Return date.
- +1 ; Input: X=Date in Fileman format
- +2 ; Output: Z=Date in MMM DD,YYYY format or MMDDYY format if Y=1
- +3 NEW Z
- SET Z=""
- if '$GET(X)
- GOTO DTQ
- +4 IF $GET(Y)
- SET Z=$EXTRACT(X,4,7)_$EXTRACT(X,2,3)
- GOTO DTQ
- +5 NEW Y
- SET Y=X
- XECUTE ^DD("DD")
- SET Z=$PIECE(Y,"@")
- DTQ QUIT Z