IBACCWLUTIL3 ;EDE/TPF - ACC (Automated Community Care) Encounters utility APIs (Cont.) ; 12-SEP-2023
;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
;
GREATERTHAN(FILE,FIELDNUM,FIELDNAME) ;EP - > GREATER THAN
;
I $G(FILE)=""!(FIELD)=""!(FIELDNAME)="" Q "Invalid Parameters!"
;
N LOGIC,RETURNCODE,DIR,DUOUT,DIROUT,DTOUT,GETFIELDCODE,VALUE,X,Y
;
S GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_$S(FIELDNAME="Amount Paid":"PAID AMOUNT",1:FIELDNAME)_""",""E"")" ;TPF;IB*2*770v22;EBILL-5003
;
W !!,"For field "_$G(FIELDNAME)_", values greater than the value you enter will be displayed."
;
N DIR
S DIR("A")="Enter a "_$G(FIELDNAME)
I FIELDNAME="DAYS ON GROUP WORKLIST" D
.S DIR(0)="NO^0:999999" ;TPF;IB*2*770v27;EBILL-5351
E S DIR(0)="NO^0:999999:2" ;TPF;IB*2*770v25;EBILL-5125
S DIR("?")="Values greater than the value you enter will be displayed. No commas"
D ^DIR
I $D(DUOUT)!$D(DTOUT) S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q RETURNCODE
;TPF;IB*2*770v26;EBILL-5208
S X=+X ;GET RID OF LEADING ZEROES
;S $P(X,".",2)=$S($L($P(X,".",2))=2:$P(X,".",2),$L($P(X,".",2))=1:$P(X,".",2)_"0",1:$P(X,".",2)_"00")
I FIELDNAME'="DAYS ON GROUP WORKLIST" S $P(X,".",2)=$S($L($P(X,".",2))=2:$P(X,".",2),$L($P(X,".",2))=1:$P(X,".",2)_"0",1:$P(X,".",2)_"00") ;TPF;IB*2*770v27;EBILL-5351
S VALUE=X
S RETURNCODE="I "_GETFIELDCODE_">"""_VALUE_""""
;
S LOGIC="For field "_$G(FIELDNAME)_", values greater than "_$G(VALUE)_" will be displayed."
;
Q RETURNCODE_"|"_LOGIC
;
GREATTHANEQUALTO(FILE,FIELDNUM,FIELDNAME) ;EP - >=
;
I $G(FILE)=""!(FIELD)=""!(FIELDNAME)="" Q "Invalid Parameters!"
;
N LOGIC,RETURNCODE,DIR,DUOUT,DIROUT,DTOUT,GETFIELDCODE,VALUE,X,Y
;
S GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_$S(FIELDNAME="Amount Paid":"PAID AMOUNT",1:FIELDNAME)_""",""E"")" ;TPF;IB*2*770v22;EBILL-5003
;
W !!,"For field "_$G(FIELDNAME)_", values greater than or equal to the value"
W !,"you enter will be displayed. No commas."
;
N DIR
I FIELDNAME="DAYS ON GROUP WORKLIST" D
.S DIR(0)="NO^0:999999" ;TPF;IB*2*770v27;EBILL-5351
E S DIR(0)="NO^0:999999:2" ;TPF;IB*2*770v25;EBILL-5125
S DIR("A")="Enter a "_$G(FIELDNAME)
S DIR("?")="Values greater than or equal to the value you enter will be displayed. No commas."
D ^DIR
I $D(DUOUT)!$D(DTOUT) S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q RETURNCODE
;TPF;IB*2*770v26;EBILL-5208
S X=+X ;GET RID OF LEADING ZEROES
I FIELDNAME'="DAYS ON GROUP WORKLIST" S $P(X,".",2)=$S($L($P(X,".",2))=2:$P(X,".",2),$L($P(X,".",2))=1:$P(X,".",2)_"0",1:$P(X,".",2)_"00") ;TPF;IB*2*770v27;EBILL-5351
S VALUE=X
S RETURNCODE="I "_GETFIELDCODE_">="""_VALUE_""""
;
S LOGIC="For field "_$G(FIELDNAME)_", values greater than or equal to "_$G(VALUE)_" will be displayed."
;
Q RETURNCODE_"|"_LOGIC
;
EQUALTO(FILE,FIELDNUM,FIELDNAME) ;EP - =
;
I $G(FILE)=""!(FIELD)=""!(FIELDNAME)="" Q "Invalid Parameters!"
;
N LOGIC,RETURNCODE,DIR,DUOUT,DIROUT,DTOUT,GETFIELDCODE,VALUE,X,Y
;
S GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_$S(FIELDNAME="Amount Paid":"PAID AMOUNT",1:FIELDNAME)_""",""E"")" ;TPF;IB*2*770v22;EBILL-5003
;
W !!,"For field "_$G(FIELDNAME)_", values equal to the value you enter will be displayed."
;
N DIR
I FIELDNAME="DAYS ON GROUP WORKLIST" D
.S DIR(0)="NO^0:999999" ;TPF;IB*2*770v27;EBILL-5351
E S DIR(0)="NO^0:999999:2" ;TPF;IB*2*770v25;EBILL-5125
S DIR("A")="Enter a "_$G(FIELDNAME)
S DIR("?")="Values equal to the value you enter will be displayed. No commas"
D ^DIR
I $D(DUOUT)!$D(DTOUT) S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q RETURNCODE
;TPF;IB*2*770v26;EBILL-5208
S X=+X ;GET RID OF LEADING ZEROES
I FIELDNAME'="DAYS ON GROUP WORKLIST" S $P(X,".",2)=$S($L($P(X,".",2))=2:$P(X,".",2),$L($P(X,".",2))=1:$P(X,".",2)_"0",1:$P(X,".",2)_"00") ;TPF;IB*2*770v27;EBILL-5351
S VALUE=X
S RETURNCODE="I "_GETFIELDCODE_"="""_VALUE_""""
;
S LOGIC="For field "_$G(FIELDNAME)_", values equal to "_$G(VALUE)_" will be displayed."
;
Q RETURNCODE_"|"_LOGIC
;
LESSTHAN(FILE,FIELDNUM,FIELDNAME) ;EP - < LESS THAN
;
I $G(FILE)=""!(FIELD)=""!(FIELDNAME)="" Q "Invalid Parameters!"
;
N DIR,LOGIC,RETURNCODE,DUOUT,DIROUT,DTOUT,GETFIELDCODE,VALUE,X,Y
;
S GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_$S(FIELDNAME="Amount Paid":"PAID AMOUNT",1:FIELDNAME)_""",""E"")" ;TPF;IB*2*770v22;EBILL-5003
;
W !!,"For field "_$G(FIELDNAME)_", values less than the value you enter will be displayed."
;
I FIELDNAME="DAYS ON GROUP WORKLIST" D
.S DIR(0)="NO^0:999999" ;TPF;IB*2*770v27;EBILL-5351
E S DIR(0)="NO^0:999999:2" ;TPF;IB*2*770v25;EBILL-5125
S DIR("A")="Enter a "_$G(FIELDNAME)
S DIR("?")="Values less than the value you enter will be displayed. No commas."
D ^DIR
I $D(DUOUT)!$D(DTOUT) S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q RETURNCODE
;TPF;IB*2*770v26;EBILL-5208
S X=+X ;GET RID OF LEADING ZEROES
;S $P(X,".",2)=$S($L($P(X,".",2))=2:$P(X,".",2),$L($P(X,".",2))=1:$P(X,".",2)_"0",1:$P(X,".",2)_"00")
I FIELDNAME'="DAYS ON GROUP WORKLIST" S $P(X,".",2)=$S($L($P(X,".",2))=2:$P(X,".",2),$L($P(X,".",2))=1:$P(X,".",2)_"0",1:$P(X,".",2)_"00") ;TPF;IB*2*770v27;EBILL-5351
S VALUE=X
S RETURNCODE="I "_GETFIELDCODE_"<"""_VALUE_""""
;
S LOGIC="For field "_$G(FIELDNAME)_", values less than "_$G(VALUE)_" will be displayed."
;
Q RETURNCODE_"|"_LOGIC
;
LESSTHANEQUALTO(FILE,FIELDNUM,FIELDNAME) ;EP - <=
;
I $G(FILE)=""!(FIELD)=""!(FIELDNAME)="" Q "Invalid Parameters!"
;
N LOGIC,RETURNCODE,DIR,DUOUT,DIROUT,DTOUT,GETFIELDCODE,VALUE,X,Y
;
S GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_$S(FIELDNAME="Amount Paid":"PAID AMOUNT",1:FIELDNAME)_""",""E"")" ;TPF;IB*2*770v22;EBILL-5003
;
W !!,"For field "_$G(FIELDNAME)_", values less than or equal to the value you enter will be displayed."
;
N DIR
I FIELDNAME="DAYS ON GROUP WORKLIST" D
.S DIR(0)="NO^0:999999" ;TPF;IB*2*770v27;EBILL-5351
E S DIR(0)="NO^0:999999:2" ;TPF;IB*2*770v25;EBILL-5125
S DIR("A")="Enter a "_$G(FIELDNAME)
S DIR("?")="Values less than or equal to the value you enter will be displayed. No commas."
D ^DIR
I $D(DUOUT)!$D(DTOUT) S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q RETURNCODE
;TPF;IB*2*770v26;EBILL-5208
S X=+X ;GET RID OF LEADING ZEROES
I FIELDNAME'="DAYS ON GROUP WORKLIST" S $P(X,".",2)=$S($L($P(X,".",2))=2:$P(X,".",2),$L($P(X,".",2))=1:$P(X,".",2)_"0",1:$P(X,".",2)_"00") ;TPF;IB*2*770v27;EBILL-5351
S VALUE=X
S RETURNCODE="I "_GETFIELDCODE_"<="""_VALUE_""""
;
S LOGIC="For field "_$G(FIELDNAME)_", values less than or equal to "_$G(VALUE)_" will be displayed."
;
Q RETURNCODE_"|"_LOGIC
;
NUMRANGE(FILE,FIELDNUM,FIELDNAME) ;EP - NUMERIC RANGE
;
N DIR
I $G(FILE)=""!(FIELD)=""!(FIELDNAME)="" Q "Invalid Parameters!"
;
N LOGIC,RETURNCODE,DIR,DUOUT,DIROUT,DTOUT,GETFIELDCODE,FROMVALUE,TOVALUE,X,Y
;
S GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_$S(FIELDNAME="Amount Paid":"PAID AMOUNT",1:FIELDNAME)_""",""E"")" ;TPF;IB*2*770v22;EBILL-5003
;
W !!,"For field "_$G(FIELDNAME)_", values that fall between the low and high"
W !,"values you enter will be displayed."
;
REDONR ;REDO RANGE FROM/TO ASK
I FIELDNAME="DAYS ON GROUP WORKLIST" D
.S DIR(0)="NO^0:999999" ;TPF;IB*2*770v27;EBILL-5351
E S DIR(0)="NO^0:999999:2" ;TPF;IB*2*770v25;EBILL-5125
S DIR("A")="Enter a low "_$G(FIELDNAME)_" amount."
S DIR("?")="Enter the low dollar amount. No commas."
D ^DIR
I $D(DUOUT)!$D(DTOUT) S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q RETURNCODE
;TPF;IB*2*770v26;EBILL-5208
S X=+X ;GET RID OF LEADING ZEROES
I FIELDNAME'="DAYS ON GROUP WORKLIST" S $P(X,".",2)=$S($L($P(X,".",2))=2:$P(X,".",2),$L($P(X,".",2))=1:$P(X,".",2)_"0",1:$P(X,".",2)_"00") ;TPF;IB*2*770v27;EBILL-5351
S FROMVALUE=X
;
I FIELDNAME="DAYS ON GROUP WORKLIST" D
.S DIR(0)="NO^0:999999" ;TPF;IB*2*770v27;EBILL-5351
E S DIR(0)="NO^0:999999:2" ;TPF;IB*2*770v25;EBILL-5125
S DIR("B")=FROMVALUE
S DIR("A")="Enter a high "_$G(FIELDNAME)_" amount"
S DIR("?")="Enter the high dollar amount. No commas."
D ^DIR
I $D(DUOUT)!$D(DTOUT) S VALMQUIT=1 ;TPF;IB*2*770v27;EBILL-5297
I $D(DUOUT)!$D(DTOUT)!(X="") S RETURNCODE="" Q RETURNCODE
;TPF;IB*2*770v26;EBILL-5208
S X=+X ;GET RID OF LEADING ZEROES
I FIELDNAME'="DAYS ON GROUP WORKLIST" S $P(X,".",2)=$S($L($P(X,".",2))=2:$P(X,".",2),$L($P(X,".",2))=1:$P(X,".",2)_"0",1:$P(X,".",2)_"00") ;TPF;IB*2*770v27;EBILL-5351
S TOVALUE=X
;
I TOVALUE<FROMVALUE W !!,"Please enter a valid range" G REDONR
;
I FROMVALUE=TOVALUE D Q RETURNCODE_"|"_LOGIC
.S LOGIC="For field "_$G(FIELDNAME)_", values that equal "_$G(FROMVALUE)_" will be displayed."
.S RETURNCODE="I "_GETFIELDCODE_"="""_FROMVALUE_""""
;
S LOGIC="For field "_$G(FIELDNAME)_", values that fall between "_$G(FROMVALUE)_" and "_$G(TOVALUE)_" will be displayed." ;TPF;IB*770v25;EBILL-5125
W !!,LOGIC ;TPF;IB*770v25;EBILL-5125
;
S RETURNCODE="I "_GETFIELDCODE_">="""_FROMVALUE_""",("_GETFIELDCODE_"<="""_TOVALUE_""")" ;TPF;IB*2*770v26;EBILL-5208
;
Q RETURNCODE_"|"_LOGIC
;
DOM(MNYR) ;DAYS IN A MONTH
;
N DAYS,MN,YR
S MN=+$E(MNYR,4,5)
I "^4^6^9^11^"[("^"_MN_"^") S DAYS=30 Q DAYS
I MN=2 D Q DAYS
.S DAYS=28
.S YR=$E(MNYR,1,3)+1700
.S:YR#4=0 DAYS=29
S DAYS=31
Q DAYS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLUTIL3 9704 printed May 25, 2026@12:10:16 Page 2
IBACCWLUTIL3 ;EDE/TPF - ACC (Automated Community Care) Encounters utility APIs (Cont.) ; 12-SEP-2023
+1 ;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ;
GREATERTHAN(FILE,FIELDNUM,FIELDNAME) ;EP - > GREATER THAN
+1 ;
+2 IF $GET(FILE)=""!(FIELD)=""!(FIELDNAME)=""
QUIT "Invalid Parameters!"
+3 ;
+4 NEW LOGIC,RETURNCODE,DIR,DUOUT,DIROUT,DTOUT,GETFIELDCODE,VALUE,X,Y
+5 ;
+6 ;TPF;IB*2*770v22;EBILL-5003
SET GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_$SELECT(FIELDNAME="Amount Paid":"PAID AMOUNT",1:FIELDNAME)_""",""E"")"
+7 ;
+8 WRITE !!,"For field "_$GET(FIELDNAME)_", values greater than the value you enter will be displayed."
+9 ;
+10 NEW DIR
+11 SET DIR("A")="Enter a "_$GET(FIELDNAME)
+12 IF FIELDNAME="DAYS ON GROUP WORKLIST"
Begin DoDot:1
+13 ;TPF;IB*2*770v27;EBILL-5351
SET DIR(0)="NO^0:999999"
End DoDot:1
+14 ;TPF;IB*2*770v25;EBILL-5125
IF '$TEST
SET DIR(0)="NO^0:999999:2"
+15 SET DIR("?")="Values greater than the value you enter will be displayed. No commas"
+16 DO ^DIR
+17 ;TPF;IB*2*770v27;EBILL-5297
IF $DATA(DUOUT)!$DATA(DTOUT)
SET VALMQUIT=1
+18 IF $DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT RETURNCODE
+19 ;TPF;IB*2*770v26;EBILL-5208
+20 ;GET RID OF LEADING ZEROES
SET X=+X
+21 ;S $P(X,".",2)=$S($L($P(X,".",2))=2:$P(X,".",2),$L($P(X,".",2))=1:$P(X,".",2)_"0",1:$P(X,".",2)_"00")
+22 ;TPF;IB*2*770v27;EBILL-5351
IF FIELDNAME'="DAYS ON GROUP WORKLIST"
SET $PIECE(X,".",2)=$SELECT($LENGTH($PIECE(X,".",2))=2:$PIECE(X,".",2),$LENGTH($PIECE(X,".",2))=1:$PIECE(X,".",2)_"0",1:$PIECE(X,".",2)_"00")
+23 SET VALUE=X
+24 SET RETURNCODE="I "_GETFIELDCODE_">"""_VALUE_""""
+25 ;
+26 SET LOGIC="For field "_$GET(FIELDNAME)_", values greater than "_$GET(VALUE)_" will be displayed."
+27 ;
+28 QUIT RETURNCODE_"|"_LOGIC
+29 ;
GREATTHANEQUALTO(FILE,FIELDNUM,FIELDNAME) ;EP - >=
+1 ;
+2 IF $GET(FILE)=""!(FIELD)=""!(FIELDNAME)=""
QUIT "Invalid Parameters!"
+3 ;
+4 NEW LOGIC,RETURNCODE,DIR,DUOUT,DIROUT,DTOUT,GETFIELDCODE,VALUE,X,Y
+5 ;
+6 ;TPF;IB*2*770v22;EBILL-5003
SET GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_$SELECT(FIELDNAME="Amount Paid":"PAID AMOUNT",1:FIELDNAME)_""",""E"")"
+7 ;
+8 WRITE !!,"For field "_$GET(FIELDNAME)_", values greater than or equal to the value"
+9 WRITE !,"you enter will be displayed. No commas."
+10 ;
+11 NEW DIR
+12 IF FIELDNAME="DAYS ON GROUP WORKLIST"
Begin DoDot:1
+13 ;TPF;IB*2*770v27;EBILL-5351
SET DIR(0)="NO^0:999999"
End DoDot:1
+14 ;TPF;IB*2*770v25;EBILL-5125
IF '$TEST
SET DIR(0)="NO^0:999999:2"
+15 SET DIR("A")="Enter a "_$GET(FIELDNAME)
+16 SET DIR("?")="Values greater than or equal to the value you enter will be displayed. No commas."
+17 DO ^DIR
+18 ;TPF;IB*2*770v27;EBILL-5297
IF $DATA(DUOUT)!$DATA(DTOUT)
SET VALMQUIT=1
+19 IF $DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT RETURNCODE
+20 ;TPF;IB*2*770v26;EBILL-5208
+21 ;GET RID OF LEADING ZEROES
SET X=+X
+22 ;TPF;IB*2*770v27;EBILL-5351
IF FIELDNAME'="DAYS ON GROUP WORKLIST"
SET $PIECE(X,".",2)=$SELECT($LENGTH($PIECE(X,".",2))=2:$PIECE(X,".",2),$LENGTH($PIECE(X,".",2))=1:$PIECE(X,".",2)_"0",1:$PIECE(X,".",2)_"00")
+23 SET VALUE=X
+24 SET RETURNCODE="I "_GETFIELDCODE_">="""_VALUE_""""
+25 ;
+26 SET LOGIC="For field "_$GET(FIELDNAME)_", values greater than or equal to "_$GET(VALUE)_" will be displayed."
+27 ;
+28 QUIT RETURNCODE_"|"_LOGIC
+29 ;
EQUALTO(FILE,FIELDNUM,FIELDNAME) ;EP - =
+1 ;
+2 IF $GET(FILE)=""!(FIELD)=""!(FIELDNAME)=""
QUIT "Invalid Parameters!"
+3 ;
+4 NEW LOGIC,RETURNCODE,DIR,DUOUT,DIROUT,DTOUT,GETFIELDCODE,VALUE,X,Y
+5 ;
+6 ;TPF;IB*2*770v22;EBILL-5003
SET GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_$SELECT(FIELDNAME="Amount Paid":"PAID AMOUNT",1:FIELDNAME)_""",""E"")"
+7 ;
+8 WRITE !!,"For field "_$GET(FIELDNAME)_", values equal to the value you enter will be displayed."
+9 ;
+10 NEW DIR
+11 IF FIELDNAME="DAYS ON GROUP WORKLIST"
Begin DoDot:1
+12 ;TPF;IB*2*770v27;EBILL-5351
SET DIR(0)="NO^0:999999"
End DoDot:1
+13 ;TPF;IB*2*770v25;EBILL-5125
IF '$TEST
SET DIR(0)="NO^0:999999:2"
+14 SET DIR("A")="Enter a "_$GET(FIELDNAME)
+15 SET DIR("?")="Values equal to the value you enter will be displayed. No commas"
+16 DO ^DIR
+17 ;TPF;IB*2*770v27;EBILL-5297
IF $DATA(DUOUT)!$DATA(DTOUT)
SET VALMQUIT=1
+18 IF $DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT RETURNCODE
+19 ;TPF;IB*2*770v26;EBILL-5208
+20 ;GET RID OF LEADING ZEROES
SET X=+X
+21 ;TPF;IB*2*770v27;EBILL-5351
IF FIELDNAME'="DAYS ON GROUP WORKLIST"
SET $PIECE(X,".",2)=$SELECT($LENGTH($PIECE(X,".",2))=2:$PIECE(X,".",2),$LENGTH($PIECE(X,".",2))=1:$PIECE(X,".",2)_"0",1:$PIECE(X,".",2)_"00")
+22 SET VALUE=X
+23 SET RETURNCODE="I "_GETFIELDCODE_"="""_VALUE_""""
+24 ;
+25 SET LOGIC="For field "_$GET(FIELDNAME)_", values equal to "_$GET(VALUE)_" will be displayed."
+26 ;
+27 QUIT RETURNCODE_"|"_LOGIC
+28 ;
LESSTHAN(FILE,FIELDNUM,FIELDNAME) ;EP - < LESS THAN
+1 ;
+2 IF $GET(FILE)=""!(FIELD)=""!(FIELDNAME)=""
QUIT "Invalid Parameters!"
+3 ;
+4 NEW DIR,LOGIC,RETURNCODE,DUOUT,DIROUT,DTOUT,GETFIELDCODE,VALUE,X,Y
+5 ;
+6 ;TPF;IB*2*770v22;EBILL-5003
SET GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_$SELECT(FIELDNAME="Amount Paid":"PAID AMOUNT",1:FIELDNAME)_""",""E"")"
+7 ;
+8 WRITE !!,"For field "_$GET(FIELDNAME)_", values less than the value you enter will be displayed."
+9 ;
+10 IF FIELDNAME="DAYS ON GROUP WORKLIST"
Begin DoDot:1
+11 ;TPF;IB*2*770v27;EBILL-5351
SET DIR(0)="NO^0:999999"
End DoDot:1
+12 ;TPF;IB*2*770v25;EBILL-5125
IF '$TEST
SET DIR(0)="NO^0:999999:2"
+13 SET DIR("A")="Enter a "_$GET(FIELDNAME)
+14 SET DIR("?")="Values less than the value you enter will be displayed. No commas."
+15 DO ^DIR
+16 ;TPF;IB*2*770v27;EBILL-5297
IF $DATA(DUOUT)!$DATA(DTOUT)
SET VALMQUIT=1
+17 IF $DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT RETURNCODE
+18 ;TPF;IB*2*770v26;EBILL-5208
+19 ;GET RID OF LEADING ZEROES
SET X=+X
+20 ;S $P(X,".",2)=$S($L($P(X,".",2))=2:$P(X,".",2),$L($P(X,".",2))=1:$P(X,".",2)_"0",1:$P(X,".",2)_"00")
+21 ;TPF;IB*2*770v27;EBILL-5351
IF FIELDNAME'="DAYS ON GROUP WORKLIST"
SET $PIECE(X,".",2)=$SELECT($LENGTH($PIECE(X,".",2))=2:$PIECE(X,".",2),$LENGTH($PIECE(X,".",2))=1:$PIECE(X,".",2)_"0",1:$PIECE(X,".",2)_"00")
+22 SET VALUE=X
+23 SET RETURNCODE="I "_GETFIELDCODE_"<"""_VALUE_""""
+24 ;
+25 SET LOGIC="For field "_$GET(FIELDNAME)_", values less than "_$GET(VALUE)_" will be displayed."
+26 ;
+27 QUIT RETURNCODE_"|"_LOGIC
+28 ;
LESSTHANEQUALTO(FILE,FIELDNUM,FIELDNAME) ;EP - <=
+1 ;
+2 IF $GET(FILE)=""!(FIELD)=""!(FIELDNAME)=""
QUIT "Invalid Parameters!"
+3 ;
+4 NEW LOGIC,RETURNCODE,DIR,DUOUT,DIROUT,DTOUT,GETFIELDCODE,VALUE,X,Y
+5 ;
+6 ;TPF;IB*2*770v22;EBILL-5003
SET GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_$SELECT(FIELDNAME="Amount Paid":"PAID AMOUNT",1:FIELDNAME)_""",""E"")"
+7 ;
+8 WRITE !!,"For field "_$GET(FIELDNAME)_", values less than or equal to the value you enter will be displayed."
+9 ;
+10 NEW DIR
+11 IF FIELDNAME="DAYS ON GROUP WORKLIST"
Begin DoDot:1
+12 ;TPF;IB*2*770v27;EBILL-5351
SET DIR(0)="NO^0:999999"
End DoDot:1
+13 ;TPF;IB*2*770v25;EBILL-5125
IF '$TEST
SET DIR(0)="NO^0:999999:2"
+14 SET DIR("A")="Enter a "_$GET(FIELDNAME)
+15 SET DIR("?")="Values less than or equal to the value you enter will be displayed. No commas."
+16 DO ^DIR
+17 ;TPF;IB*2*770v27;EBILL-5297
IF $DATA(DUOUT)!$DATA(DTOUT)
SET VALMQUIT=1
+18 IF $DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT RETURNCODE
+19 ;TPF;IB*2*770v26;EBILL-5208
+20 ;GET RID OF LEADING ZEROES
SET X=+X
+21 ;TPF;IB*2*770v27;EBILL-5351
IF FIELDNAME'="DAYS ON GROUP WORKLIST"
SET $PIECE(X,".",2)=$SELECT($LENGTH($PIECE(X,".",2))=2:$PIECE(X,".",2),$LENGTH($PIECE(X,".",2))=1:$PIECE(X,".",2)_"0",1:$PIECE(X,".",2)_"00")
+22 SET VALUE=X
+23 SET RETURNCODE="I "_GETFIELDCODE_"<="""_VALUE_""""
+24 ;
+25 SET LOGIC="For field "_$GET(FIELDNAME)_", values less than or equal to "_$GET(VALUE)_" will be displayed."
+26 ;
+27 QUIT RETURNCODE_"|"_LOGIC
+28 ;
NUMRANGE(FILE,FIELDNUM,FIELDNAME) ;EP - NUMERIC RANGE
+1 ;
+2 NEW DIR
+3 IF $GET(FILE)=""!(FIELD)=""!(FIELDNAME)=""
QUIT "Invalid Parameters!"
+4 ;
+5 NEW LOGIC,RETURNCODE,DIR,DUOUT,DIROUT,DTOUT,GETFIELDCODE,FROMVALUE,TOVALUE,X,Y
+6 ;
+7 ;TPF;IB*2*770v22;EBILL-5003
SET GETFIELDCODE="$$GET1^DIQ("_FILE_",Y_"","","""_$SELECT(FIELDNAME="Amount Paid":"PAID AMOUNT",1:FIELDNAME)_""",""E"")"
+8 ;
+9 WRITE !!,"For field "_$GET(FIELDNAME)_", values that fall between the low and high"
+10 WRITE !,"values you enter will be displayed."
+11 ;
REDONR ;REDO RANGE FROM/TO ASK
+1 IF FIELDNAME="DAYS ON GROUP WORKLIST"
Begin DoDot:1
+2 ;TPF;IB*2*770v27;EBILL-5351
SET DIR(0)="NO^0:999999"
End DoDot:1
+3 ;TPF;IB*2*770v25;EBILL-5125
IF '$TEST
SET DIR(0)="NO^0:999999:2"
+4 SET DIR("A")="Enter a low "_$GET(FIELDNAME)_" amount."
+5 SET DIR("?")="Enter the low dollar amount. No commas."
+6 DO ^DIR
+7 ;TPF;IB*2*770v27;EBILL-5297
IF $DATA(DUOUT)!$DATA(DTOUT)
SET VALMQUIT=1
+8 IF $DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT RETURNCODE
+9 ;TPF;IB*2*770v26;EBILL-5208
+10 ;GET RID OF LEADING ZEROES
SET X=+X
+11 ;TPF;IB*2*770v27;EBILL-5351
IF FIELDNAME'="DAYS ON GROUP WORKLIST"
SET $PIECE(X,".",2)=$SELECT($LENGTH($PIECE(X,".",2))=2:$PIECE(X,".",2),$LENGTH($PIECE(X,".",2))=1:$PIECE(X,".",2)_"0",1:$PIECE(X,".",2)_"00")
+12 SET FROMVALUE=X
+13 ;
+14 IF FIELDNAME="DAYS ON GROUP WORKLIST"
Begin DoDot:1
+15 ;TPF;IB*2*770v27;EBILL-5351
SET DIR(0)="NO^0:999999"
End DoDot:1
+16 ;TPF;IB*2*770v25;EBILL-5125
IF '$TEST
SET DIR(0)="NO^0:999999:2"
+17 SET DIR("B")=FROMVALUE
+18 SET DIR("A")="Enter a high "_$GET(FIELDNAME)_" amount"
+19 SET DIR("?")="Enter the high dollar amount. No commas."
+20 DO ^DIR
+21 ;TPF;IB*2*770v27;EBILL-5297
IF $DATA(DUOUT)!$DATA(DTOUT)
SET VALMQUIT=1
+22 IF $DATA(DUOUT)!$DATA(DTOUT)!(X="")
SET RETURNCODE=""
QUIT RETURNCODE
+23 ;TPF;IB*2*770v26;EBILL-5208
+24 ;GET RID OF LEADING ZEROES
SET X=+X
+25 ;TPF;IB*2*770v27;EBILL-5351
IF FIELDNAME'="DAYS ON GROUP WORKLIST"
SET $PIECE(X,".",2)=$SELECT($LENGTH($PIECE(X,".",2))=2:$PIECE(X,".",2),$LENGTH($PIECE(X,".",2))=1:$PIECE(X,".",2)_"0",1:$PIECE(X,".",2)_"00")
+26 SET TOVALUE=X
+27 ;
+28 IF TOVALUE<FROMVALUE
WRITE !!,"Please enter a valid range"
GOTO REDONR
+29 ;
+30 IF FROMVALUE=TOVALUE
Begin DoDot:1
+31 SET LOGIC="For field "_$GET(FIELDNAME)_", values that equal "_$GET(FROMVALUE)_" will be displayed."
+32 SET RETURNCODE="I "_GETFIELDCODE_"="""_FROMVALUE_""""
End DoDot:1
QUIT RETURNCODE_"|"_LOGIC
+33 ;
+34 ;TPF;IB*770v25;EBILL-5125
SET LOGIC="For field "_$GET(FIELDNAME)_", values that fall between "_$GET(FROMVALUE)_" and "_$GET(TOVALUE)_" will be displayed."
+35 ;TPF;IB*770v25;EBILL-5125
WRITE !!,LOGIC
+36 ;
+37 ;TPF;IB*2*770v26;EBILL-5208
SET RETURNCODE="I "_GETFIELDCODE_">="""_FROMVALUE_""",("_GETFIELDCODE_"<="""_TOVALUE_""")"
+38 ;
+39 QUIT RETURNCODE_"|"_LOGIC
+40 ;
DOM(MNYR) ;DAYS IN A MONTH
+1 ;
+2 NEW DAYS,MN,YR
+3 SET MN=+$EXTRACT(MNYR,4,5)
+4 IF "^4^6^9^11^"[("^"_MN_"^")
SET DAYS=30
QUIT DAYS
+5 IF MN=2
Begin DoDot:1
+6 SET DAYS=28
+7 SET YR=$EXTRACT(MNYR,1,3)+1700
+8 if YR#4=0
SET DAYS=29
End DoDot:1
QUIT DAYS
+9 SET DAYS=31
+10 QUIT DAYS
