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
