IBCNBLP1 ;ALB/ARH-Ins Buffer: LM buffer process build ;1 Jun 97
;;2.0;INTEGRATED BILLING;**82,133,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
;
PATLST(IBCNT,DFN,CMPDATA) ; collect and display all the patients insurance policies
; if the buffer field data (CMPDATA) matches the displayed insurance entry's data, then that data is displayed in bold
N IBINS,IBY,IBX,IB0,IBG0,IBI0,IBLINE,IBPLDA,IBBOLD,IBFND,IBDA S IBFND=0,IBCNT=+$G(IBCNT)
;
D ALL^IBCNS1(DFN,"IBINS")
;
S IBY=$J("",26)_"Patient's Existing Insurance" D SET(IBY,1,"","R")
S IBY=" Insurance Company Group # Subscriber Id Holder Effective Expires" D SET(IBY,1,"","U")
;
S IBPLDA=0 F S IBPLDA=$O(IBINS(IBPLDA)) Q:'IBPLDA D
. S IB0=IBINS(IBPLDA,0),IBG0=$G(^IBA(355.3,+$P(IB0,U,18),0)),IBI0=$G(^DIC(36,+IB0,0)),IBCNT=IBCNT+1,IBFND=1
. S IBY=IBCNT S IBLINE=$$SETSTR(IBY,"",1,3)
. S IBY=$S(+$P(IBI0,U,5):"~",+$P(IBG0,U,11):"~",'$P(IBG0,U,2):"-",1:"") S IBLINE=$$SETSTR(IBY,IBLINE,4,1)
. S IBY=$P(IBI0,U,1) S IBLINE=$$SETSTR(IBY,IBLINE,5,18,$P(CMPDATA,U,1))
. S IBY=$P(IB0,U,3) S IBLINE=$$SETSTR(IBY,IBLINE,25,13,$P(CMPDATA,U,2))
. S IBY=$P(IB0,U,2) S IBLINE=$$SETSTR(IBY,IBLINE,40,13,$P(CMPDATA,U,3))
. S IBY=$P(IB0,U,16),IBY=$$EXPAND^IBTRE(355.33,60.06,IBY) S IBLINE=$$SETSTR(IBY,IBLINE,55,6)
. S IBY=$$DATE($P(IB0,U,8)) S IBLINE=$$SETSTR(IBY,IBLINE,63,8)
. S IBY=$$DATE($P(IB0,U,4)) S IBLINE=$$SETSTR(IBY,IBLINE,73,8)
. S IBDA=+IB0_U_+$P(IB0,U,18)_U_IBPLDA_U_+DFN
. D SET(IBLINE,IBCNT,IBDA)
;
I 'IBFND D SET("",1),SET(" No Insurance Policies on file for this patient.",1),SET("",1)
Q
;
GRPLST(IBCNT,IBINSDA,DFN,CMPDATA) ; display insurance group/plans for a specific company
; if the buffer field data (CMPDATA) matches the displayed insurance entry's data, then that data is displayed in bold
; if the buffer entry's patient is already a member of the group/plan then the record's number is displayed in bold
N IBX,IBY,IBGRPDA,IBPOLDA,IB0,IBI0,IBLINE,IBBOLD,IBFND,IBDA S IBFND=0,IBCNT=+$G(IBCNT),IBI0=$G(^DIC(36,IBINSDA,0))
;
S IBX="Existing Plans for "_$P(IBI0,U,1)_" ("_$P($G(^DIC(36,IBINSDA,.11)),U,1)_")"
S IBY=$J("",40-($L(IBX)\2))_IBX D SET(IBY,1,"","R")
S IBY=" Group Name Group # Type of Plan" D SET(IBY,1,"","U")
;
S IBGRPDA=0 F S IBGRPDA=$O(^IBA(355.3,"B",IBINSDA,IBGRPDA)) Q:'IBGRPDA D
. S IB0=$G(^IBA(355.3,IBGRPDA,0)) I +$G(DFN),$P(IB0,U,2)=0,$P(IB0,U,10)'=DFN Q
. S IBCNT=IBCNT+1,IBFND=1,IBPOLDA=$$PTGRP^IBCNBU1(DFN,IBINSDA,IBGRPDA)
. S IBY=IBCNT S IBLINE=$$SETSTR(IBY,"",1,4,$S(+IBPOLDA:IBY,1:""))
. S IBY=$S(+$P(IBI0,U,5):"~",+$P(IB0,U,11):"~",'$P(IB0,U,2):"-",1:"") S IBLINE=$$SETSTR(IBY,IBLINE,5,1)
. S IBY=$$GET1^DIQ(355.3,IBGRPDA,2.01) S:IBY=""&('$P(IB0,U,2)) IBY="<individual policy>" S IBLINE=$$SETSTR(IBY,IBLINE,6,20,$P(CMPDATA,U,1))
. S IBY=$$GET1^DIQ(355.3,IBGRPDA,2.02) S IBLINE=$$SETSTR(IBY,IBLINE,30,17,$P(CMPDATA,U,2))
. S IBY=$P(IB0,U,9) I +IBY S IBY=$P($G(^IBE(355.1,+IBY,0)),U,1) S IBLINE=$$SETSTR(IBY,IBLINE,50,30,$P(CMPDATA,U,3))
. S IBDA=+IB0_U_+IBGRPDA_U_+IBPOLDA_U_DFN
. D SET(IBLINE,IBCNT,IBDA)
;
I 'IBFND D SET("",1),SET(" No Insurance Group/Plans on file for this Insurance Company.",1),SET("",1)
Q
;
SRCHLST(IBCNT,DFN,INSNM,GRPNM,GRPNUM) ; display any insurance group/plan that matchs either group name or group number
; if the buffer field data (CMPDATA) matches the displayed insurance entry's data, then that data is displayed in bold
; if the buffer entry's patient is already a member of the group/plan then the record's number is displayed in bold
;
N IBX,IBY,IBCX,IBFDATA,IBGRPDA,IBPOLDA,IB0,IBI0,IBLINE,IBBOLD,IBFND,IBDA,IBFD,IBLNS
S IBFND=0,IBCNT=+$G(IBCNT),IBLNS=$S(+IBCNT:IBCNT,1:1) K ^TMP($J,"IBCNBLPG")
;
S IBY=$J(" ",80) D SET(IBY,IBLNS)
S IBX="Any Group/Plan that may match Group Name or Group Number",IBY=$J("",40-($L(IBX)\2))_IBX D SET(IBY,IBLNS,"","R")
S IBY=" Insurance Company Group Name Group Number" D SET(IBY,IBLNS,"","U")
;
F IBCX="D","E" S IBFDATA=$S(IBCX="D":$G(GRPNM),1:$G(GRPNUM)) I IBFDATA'="" D
. S IBFD=$$PREV(IBFDATA) F S IBFD=$O(^IBA(355.3,IBCX,IBFD)) Q:IBFD=""!(IBFD'[IBFDATA) D
.. S IBGRPDA=0 F S IBGRPDA=$O(^IBA(355.3,IBCX,IBFD,IBGRPDA)) Q:IBGRPDA="" D
... Q:$D(^TMP($J,"IBCNBLPG",IBGRPDA)) S ^TMP($J,"IBCNBLPG",IBGRPDA)=""
... S IB0=$G(^IBA(355.3,IBGRPDA,0)) I +$G(DFN),$P(IB0,U,2)=0,$P(IB0,U,10)'=DFN Q
... S IBCNT=IBCNT+1,IBFND=1,IBPOLDA=+$$PTGRP^IBCNBU1(DFN,+IB0,IBGRPDA),IBI0=$G(^DIC(36,+IB0,0))
... S IBY=IBCNT S IBLINE=$$SETSTR(IBY,"",1,4,$S(IBPOLDA:IBY,1:""))
... S IBY=$S(+$P(IBI0,U,5):"~",+$P(IB0,U,11):"~",'$P(IB0,U,2):"-",1:"") S IBLINE=$$SETSTR(IBY,IBLINE,5,1)
... S IBY=$P(IBI0,U,1) S IBLINE=$$SETSTR(IBY,IBLINE,6,18,$G(INSNM))
... S IBY=$P($G(^DIC(36,+IB0,.11)),U,1) S IBLINE=$$SETSTR(IBY,IBLINE,26,13)
... ;IB*2.0*516/BAA - Use HIPAA compliant fields
... ;S IBY=$P(IB0,U,3) S:IBY=""&('$P(IB0,U,2)) IBY="<individual policy>" S IBLINE=$$SETSTR(IBY,IBLINE,41,20,$G(GRPNM))
... ;S IBY=$P(IB0,U,4) S IBLINE=$$SETSTR(IBY,IBLINE,63,17,$G(GRPNUM))
... S IBY=$$GET1^DIQ(355.3,IBGRPDA,2.01) S:IBY=""&('$P(IB0,U,2)) IBY="<individual policy>" S IBLINE=$$SETSTR(IBY,IBLINE,41,20,$G(GRPNM)) ;516 - baa
... S IBY=$$GET1^DIQ(355.3,IBGRPDA,2.02) S IBLINE=$$SETSTR(IBY,IBLINE,63,17,$G(GRPNUM)) ; 516 - baa
... S IBDA=+IB0_U_IBGRPDA_U_+IBPOLDA_U_DFN
... D SET(IBLINE,IBCNT,IBDA)
;
I 'IBFND D SET("",IBCNT),SET(" No Group/Plans found that Match the buffer entry's Group Name or Group Number.",IBCNT),SET("",IBCNT)
K ^TMP($J,"IBCNBLPG")
Q
;
SETSTR(DATA,LINE,COL,LNG,CMPDATA) ; save data in formated line, if data matchs compare data save string position for bolding
S LINE=$$SETSTR^VALM1(DATA,LINE,COL,LNG)
I $D(CMPDATA),DATA=CMPDATA S IBBOLD=$G(IBBOLD)_COL_";"_LNG_"^"
I $D(CMPDATA),DATA'=CMPDATA,$E(DATA,1,$L(CMPDATA))[CMPDATA S IBBOLD=$G(IBBOLD)_COL_";"_$L(CMPDATA)_"^"
Q LINE
;
SET(LINE,CNT,IBDA,SPEC) ;
S VALMCNT=VALMCNT+1 N IBX,IBI
S ^TMP("IBCNBLP",$J,VALMCNT,0)=LINE
I +$G(CNT) S ^TMP("IBCNBLP",$J,"IDX",VALMCNT,+CNT)=""
I +$G(CNT),+$G(IBDA) S ^TMP("IBCNBLPX",$J,+CNT)=VALMCNT_U_IBDA
I $G(SPEC)="U" D CNTRL^VALM10(VALMCNT,1,80,IOUON,IOUOFF)
I $G(SPEC)="B" D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
I $G(SPEC)="R" D CNTRL^VALM10(VALMCNT,1,80,IORVON,IORVOFF)
I $D(IBBOLD) F IBI=1:1 S IBX=$P(IBBOLD,U,IBI) Q:IBX="" D
. D CNTRL^VALM10(VALMCNT,$P(IBX,";",1),$P(IBX,";",2),IOINHI,IOINORM)
K IBBOLD
Q
;
DATE(X) ;
N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
Q Y
;
PREV(STRING) ; return previous ascii value of the string for collating
N IBL,IBX S IBL=$L(STRING),IBX=$E(STRING,1,IBL-1)_$C($A($E(STRING,IBL))-1)_"~"
Q IBX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNBLP1 6823 printed Dec 13, 2024@02:14:07 Page 2
IBCNBLP1 ;ALB/ARH-Ins Buffer: LM buffer process build ;1 Jun 97
+1 ;;2.0;INTEGRATED BILLING;**82,133,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
PATLST(IBCNT,DFN,CMPDATA) ; collect and display all the patients insurance policies
+1 ; if the buffer field data (CMPDATA) matches the displayed insurance entry's data, then that data is displayed in bold
+2 NEW IBINS,IBY,IBX,IB0,IBG0,IBI0,IBLINE,IBPLDA,IBBOLD,IBFND,IBDA
SET IBFND=0
SET IBCNT=+$GET(IBCNT)
+3 ;
+4 DO ALL^IBCNS1(DFN,"IBINS")
+5 ;
+6 SET IBY=$JUSTIFY("",26)_"Patient's Existing Insurance"
DO SET(IBY,1,"","R")
+7 SET IBY=" Insurance Company Group # Subscriber Id Holder Effective Expires"
DO SET(IBY,1,"","U")
+8 ;
+9 SET IBPLDA=0
FOR
SET IBPLDA=$ORDER(IBINS(IBPLDA))
if 'IBPLDA
QUIT
Begin DoDot:1
+10 SET IB0=IBINS(IBPLDA,0)
SET IBG0=$GET(^IBA(355.3,+$PIECE(IB0,U,18),0))
SET IBI0=$GET(^DIC(36,+IB0,0))
SET IBCNT=IBCNT+1
SET IBFND=1
+11 SET IBY=IBCNT
SET IBLINE=$$SETSTR(IBY,"",1,3)
+12 SET IBY=$SELECT(+$PIECE(IBI0,U,5):"~",+$PIECE(IBG0,U,11):"~",'$PIECE(IBG0,U,2):"-",1:"")
SET IBLINE=$$SETSTR(IBY,IBLINE,4,1)
+13 SET IBY=$PIECE(IBI0,U,1)
SET IBLINE=$$SETSTR(IBY,IBLINE,5,18,$PIECE(CMPDATA,U,1))
+14 SET IBY=$PIECE(IB0,U,3)
SET IBLINE=$$SETSTR(IBY,IBLINE,25,13,$PIECE(CMPDATA,U,2))
+15 SET IBY=$PIECE(IB0,U,2)
SET IBLINE=$$SETSTR(IBY,IBLINE,40,13,$PIECE(CMPDATA,U,3))
+16 SET IBY=$PIECE(IB0,U,16)
SET IBY=$$EXPAND^IBTRE(355.33,60.06,IBY)
SET IBLINE=$$SETSTR(IBY,IBLINE,55,6)
+17 SET IBY=$$DATE($PIECE(IB0,U,8))
SET IBLINE=$$SETSTR(IBY,IBLINE,63,8)
+18 SET IBY=$$DATE($PIECE(IB0,U,4))
SET IBLINE=$$SETSTR(IBY,IBLINE,73,8)
+19 SET IBDA=+IB0_U_+$PIECE(IB0,U,18)_U_IBPLDA_U_+DFN
+20 DO SET(IBLINE,IBCNT,IBDA)
End DoDot:1
+21 ;
+22 IF 'IBFND
DO SET("",1)
DO SET(" No Insurance Policies on file for this patient.",1)
DO SET("",1)
+23 QUIT
+24 ;
GRPLST(IBCNT,IBINSDA,DFN,CMPDATA) ; display insurance group/plans for a specific company
+1 ; if the buffer field data (CMPDATA) matches the displayed insurance entry's data, then that data is displayed in bold
+2 ; if the buffer entry's patient is already a member of the group/plan then the record's number is displayed in bold
+3 NEW IBX,IBY,IBGRPDA,IBPOLDA,IB0,IBI0,IBLINE,IBBOLD,IBFND,IBDA
SET IBFND=0
SET IBCNT=+$GET(IBCNT)
SET IBI0=$GET(^DIC(36,IBINSDA,0))
+4 ;
+5 SET IBX="Existing Plans for "_$PIECE(IBI0,U,1)_" ("_$PIECE($GET(^DIC(36,IBINSDA,.11)),U,1)_")"
+6 SET IBY=$JUSTIFY("",40-($LENGTH(IBX)\2))_IBX
DO SET(IBY,1,"","R")
+7 SET IBY=" Group Name Group # Type of Plan"
DO SET(IBY,1,"","U")
+8 ;
+9 SET IBGRPDA=0
FOR
SET IBGRPDA=$ORDER(^IBA(355.3,"B",IBINSDA,IBGRPDA))
if 'IBGRPDA
QUIT
Begin DoDot:1
+10 SET IB0=$GET(^IBA(355.3,IBGRPDA,0))
IF +$GET(DFN)
IF $PIECE(IB0,U,2)=0
IF $PIECE(IB0,U,10)'=DFN
QUIT
+11 SET IBCNT=IBCNT+1
SET IBFND=1
SET IBPOLDA=$$PTGRP^IBCNBU1(DFN,IBINSDA,IBGRPDA)
+12 SET IBY=IBCNT
SET IBLINE=$$SETSTR(IBY,"",1,4,$SELECT(+IBPOLDA:IBY,1:""))
+13 SET IBY=$SELECT(+$PIECE(IBI0,U,5):"~",+$PIECE(IB0,U,11):"~",'$PIECE(IB0,U,2):"-",1:"")
SET IBLINE=$$SETSTR(IBY,IBLINE,5,1)
+14 SET IBY=$$GET1^DIQ(355.3,IBGRPDA,2.01)
if IBY=""&('$PIECE(IB0,U,2))
SET IBY="<individual policy>"
SET IBLINE=$$SETSTR(IBY,IBLINE,6,20,$PIECE(CMPDATA,U,1))
+15 SET IBY=$$GET1^DIQ(355.3,IBGRPDA,2.02)
SET IBLINE=$$SETSTR(IBY,IBLINE,30,17,$PIECE(CMPDATA,U,2))
+16 SET IBY=$PIECE(IB0,U,9)
IF +IBY
SET IBY=$PIECE($GET(^IBE(355.1,+IBY,0)),U,1)
SET IBLINE=$$SETSTR(IBY,IBLINE,50,30,$PIECE(CMPDATA,U,3))
+17 SET IBDA=+IB0_U_+IBGRPDA_U_+IBPOLDA_U_DFN
+18 DO SET(IBLINE,IBCNT,IBDA)
End DoDot:1
+19 ;
+20 IF 'IBFND
DO SET("",1)
DO SET(" No Insurance Group/Plans on file for this Insurance Company.",1)
DO SET("",1)
+21 QUIT
+22 ;
SRCHLST(IBCNT,DFN,INSNM,GRPNM,GRPNUM) ; display any insurance group/plan that matchs either group name or group number
+1 ; if the buffer field data (CMPDATA) matches the displayed insurance entry's data, then that data is displayed in bold
+2 ; if the buffer entry's patient is already a member of the group/plan then the record's number is displayed in bold
+3 ;
+4 NEW IBX,IBY,IBCX,IBFDATA,IBGRPDA,IBPOLDA,IB0,IBI0,IBLINE,IBBOLD,IBFND,IBDA,IBFD,IBLNS
+5 SET IBFND=0
SET IBCNT=+$GET(IBCNT)
SET IBLNS=$SELECT(+IBCNT:IBCNT,1:1)
KILL ^TMP($JOB,"IBCNBLPG")
+6 ;
+7 SET IBY=$JUSTIFY(" ",80)
DO SET(IBY,IBLNS)
+8 SET IBX="Any Group/Plan that may match Group Name or Group Number"
SET IBY=$JUSTIFY("",40-($LENGTH(IBX)\2))_IBX
DO SET(IBY,IBLNS,"","R")
+9 SET IBY=" Insurance Company Group Name Group Number"
DO SET(IBY,IBLNS,"","U")
+10 ;
+11 FOR IBCX="D","E"
SET IBFDATA=$SELECT(IBCX="D":$GET(GRPNM),1:$GET(GRPNUM))
IF IBFDATA'=""
Begin DoDot:1
+12 SET IBFD=$$PREV(IBFDATA)
FOR
SET IBFD=$ORDER(^IBA(355.3,IBCX,IBFD))
if IBFD=""!(IBFD'[IBFDATA)
QUIT
Begin DoDot:2
+13 SET IBGRPDA=0
FOR
SET IBGRPDA=$ORDER(^IBA(355.3,IBCX,IBFD,IBGRPDA))
if IBGRPDA=""
QUIT
Begin DoDot:3
+14 if $DATA(^TMP($JOB,"IBCNBLPG",IBGRPDA))
QUIT
SET ^TMP($JOB,"IBCNBLPG",IBGRPDA)=""
+15 SET IB0=$GET(^IBA(355.3,IBGRPDA,0))
IF +$GET(DFN)
IF $PIECE(IB0,U,2)=0
IF $PIECE(IB0,U,10)'=DFN
QUIT
+16 SET IBCNT=IBCNT+1
SET IBFND=1
SET IBPOLDA=+$$PTGRP^IBCNBU1(DFN,+IB0,IBGRPDA)
SET IBI0=$GET(^DIC(36,+IB0,0))
+17 SET IBY=IBCNT
SET IBLINE=$$SETSTR(IBY,"",1,4,$SELECT(IBPOLDA:IBY,1:""))
+18 SET IBY=$SELECT(+$PIECE(IBI0,U,5):"~",+$PIECE(IB0,U,11):"~",'$PIECE(IB0,U,2):"-",1:"")
SET IBLINE=$$SETSTR(IBY,IBLINE,5,1)
+19 SET IBY=$PIECE(IBI0,U,1)
SET IBLINE=$$SETSTR(IBY,IBLINE,6,18,$GET(INSNM))
+20 SET IBY=$PIECE($GET(^DIC(36,+IB0,.11)),U,1)
SET IBLINE=$$SETSTR(IBY,IBLINE,26,13)
+21 ;IB*2.0*516/BAA - Use HIPAA compliant fields
+22 ;S IBY=$P(IB0,U,3) S:IBY=""&('$P(IB0,U,2)) IBY="<individual policy>" S IBLINE=$$SETSTR(IBY,IBLINE,41,20,$G(GRPNM))
+23 ;S IBY=$P(IB0,U,4) S IBLINE=$$SETSTR(IBY,IBLINE,63,17,$G(GRPNUM))
+24 ;516 - baa
SET IBY=$$GET1^DIQ(355.3,IBGRPDA,2.01)
if IBY=""&('$PIECE(IB0,U,2))
SET IBY="<individual policy>"
SET IBLINE=$$SETSTR(IBY,IBLINE,41,20,$GET(GRPNM))
+25 ; 516 - baa
SET IBY=$$GET1^DIQ(355.3,IBGRPDA,2.02)
SET IBLINE=$$SETSTR(IBY,IBLINE,63,17,$GET(GRPNUM))
+26 SET IBDA=+IB0_U_IBGRPDA_U_+IBPOLDA_U_DFN
+27 DO SET(IBLINE,IBCNT,IBDA)
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;
+29 IF 'IBFND
DO SET("",IBCNT)
DO SET(" No Group/Plans found that Match the buffer entry's Group Name or Group Number.",IBCNT)
DO SET("",IBCNT)
+30 KILL ^TMP($JOB,"IBCNBLPG")
+31 QUIT
+32 ;
SETSTR(DATA,LINE,COL,LNG,CMPDATA) ; save data in formated line, if data matchs compare data save string position for bolding
+1 SET LINE=$$SETSTR^VALM1(DATA,LINE,COL,LNG)
+2 IF $DATA(CMPDATA)
IF DATA=CMPDATA
SET IBBOLD=$GET(IBBOLD)_COL_";"_LNG_"^"
+3 IF $DATA(CMPDATA)
IF DATA'=CMPDATA
IF $EXTRACT(DATA,1,$LENGTH(CMPDATA))[CMPDATA
SET IBBOLD=$GET(IBBOLD)_COL_";"_$LENGTH(CMPDATA)_"^"
+4 QUIT LINE
+5 ;
SET(LINE,CNT,IBDA,SPEC) ;
+1 SET VALMCNT=VALMCNT+1
NEW IBX,IBI
+2 SET ^TMP("IBCNBLP",$JOB,VALMCNT,0)=LINE
+3 IF +$GET(CNT)
SET ^TMP("IBCNBLP",$JOB,"IDX",VALMCNT,+CNT)=""
+4 IF +$GET(CNT)
IF +$GET(IBDA)
SET ^TMP("IBCNBLPX",$JOB,+CNT)=VALMCNT_U_IBDA
+5 IF $GET(SPEC)="U"
DO CNTRL^VALM10(VALMCNT,1,80,IOUON,IOUOFF)
+6 IF $GET(SPEC)="B"
DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
+7 IF $GET(SPEC)="R"
DO CNTRL^VALM10(VALMCNT,1,80,IORVON,IORVOFF)
+8 IF $DATA(IBBOLD)
FOR IBI=1:1
SET IBX=$PIECE(IBBOLD,U,IBI)
if IBX=""
QUIT
Begin DoDot:1
+9 DO CNTRL^VALM10(VALMCNT,$PIECE(IBX,";",1),$PIECE(IBX,";",2),IOINHI,IOINORM)
End DoDot:1
+10 KILL IBBOLD
+11 QUIT
+12 ;
DATE(X) ;
+1 NEW Y
SET Y=""
IF X?7N.E
SET Y=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+2 QUIT Y
+3 ;
PREV(STRING) ; return previous ascii value of the string for collating
+1 NEW IBL,IBX
SET IBL=$LENGTH(STRING)
SET IBX=$EXTRACT(STRING,1,IBL-1)_$CHAR($ASCII($EXTRACT(STRING,IBL))-1)_"~"
+2 QUIT IBX
