RCCPCPS1 ;WISC/RFJ - build description for patient statement ;08 Aug 2001
;;4.5;Accounts Receivable;**34,48,104,170,176,192,265,362,360,392**;Mar 20, 1995;Build 10
;;Per VHA Directive 6402, this routine should not be modified.
;
; Reference to FILE #350 in ICR #4541
Q
;
;
TRANDESC(RCTRANDA,RCWIDTH) ; build the description array for a transaction
;
; initialize
N DESCRIPT,RCBILLDA,RCCATEG,RCCATTXT,RCDATA0,RCDATA1,RCDATA3,RCLINE,TRANTYPE,X
I '$G(RCWIDTH) S RCWIDTH=50 ; Default max. width is 50 characters
K RCDESC
S RCLINE=1,RCDESC(1)=""
;
S RCBILLDA=+$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA Q
S RCDATA0=^PRCA(430,RCBILLDA,0)
S RCCATEG=+$P(RCDATA0,"^",2),RCCATTXT=$P($G(^PRCA(430.2,RCCATEG,0)),"^")
S RCDATA1=^PRCA(433,RCTRANDA,1)
S TRANTYPE=$P(RCDATA1,"^",2)
;
; build the first line description
; if transaction type is an increase or decrease, set description
I TRANTYPE=1!(TRANTYPE=35) D
. ; if c means test, set description to category for c means test
. I RCCATEG=18 S DESCRIPT=$S($P(RCDATA0,"^",16):$P(^PRCA(430.2,$P(RCDATA0,"^",16),0),"^"),1:RCCATTXT) Q
. ; otherwise, set to category name
. ;PRCA*4.5*362
. I RCCATEG>47,RCCATEG<86 D Q
. . I RCCATTXT["RX" S DESCRIPT="COMMUNITY CARE RX" Q
. . I RCCATTXT["INPT" S DESCRIPT="COMMUNITY CARE INPT" Q
. . I RCCATTXT["OPT" S DESCRIPT="COMMUNITY CARE OUTPATIENT" Q
. . I RCCATTXT["URGENT" S DESCRIPT="COMMUNITY CARE URGENT CARE" Q
. . I RCCATTXT["RESPITE" S DESCRIPT="COMMUNITY CARE RESPITE CARE" Q
. . I RCCATTXT["NURSING" S DESCRIPT="COMMUNITY CARE NURSING HOME"
. ;end PRCA*4.5*362
. ;
. S DESCRIPT=RCCATTXT
;
; if the bill category is a rx-copay and it is an increase adjustment
; then set the description to copay
I RCCATEG=22!(RCCATEG=23),TRANTYPE=1 S DESCRIPT="COPAY"
;
; if the bill category is adult day health care, remove health
I RCCATEG=33 S DESCRIPT="ADULT DAY CARE"
;
; if the bill category is respite or geriatric eval,
; take the 2nd piece removing institutional
I RCCATEG=35!(RCCATEG=36)!(RCCATEG=37)!(RCCATEG=38) S DESCRIPT=$P(RCCATTXT,"-")_$S(RCCATEG=35!(RCCATEG=37):" IN",1:" OUT")_"PATIENT"
;
; if it is a comment transaction
I TRANTYPE=45 S DESCRIPT="COMMENT: "_$P($G(^PRCA(433,RCTRANDA,5)),"^",2)
;
; prepayment bill (1=increase, 35=decrease, otherwise refund)
I RCCATEG=26 S DESCRIPT=$S(TRANTYPE=1:"OVERPAYMENT CREDIT",TRANTYPE=35:"OVERPAYMENT CREDIT DECREASE",1:"OVERPAYMENT REFUND")
;
; if the first line description not set (like payments), set it
; to the type of transaction
I $G(DESCRIPT)="" S DESCRIPT=$P($G(^PRCA(430.3,+$P(RCDATA1,"^",2),0)),"^")
;
; if the transaction date is different from the process date,
; show it with the description
I $P(RCDATA1,"^"),$P($P(RCDATA1,"^"),".")'=$P($P(RCDATA1,"^",9),".") S DESCRIPT=DESCRIPT_" ("_$$DATE($P($P(RCDATA1,"^"),"."))_")"
;
; set the first description line
D SETDESC(DESCRIPT)
;
; if it is a payment transaction, show amount paid interest, admin, other
I TRANTYPE=2!(TRANTYPE=34) D
. S RCDATA3=$G(^PRCA(433,RCTRANDA,3))
. ; if not interest, admin, or other, quit
. I '$P(RCDATA3,"^",2),'$P(RCDATA3,"^",3),'$P(RCDATA3,"^",4),'$P(RCDATA3,"^",5) Q
. ;
. S DESCRIPT=" (Int:"_$J(+$P(RCDATA3,"^",2),1,2)_" Adm:"_$J(+$P(RCDATA3,"^",3),1,2)
. ; calculate other
. S X=$P(RCDATA1,"^",5)-$P(RCDATA3,"^")-$P(RCDATA3,"^",2)-$P(RCDATA3,"^",3)
. S DESCRIPT=DESCRIPT_$S(X:" Other:"_$J(X,1,2)_")",1:")")
. D SETDESC(DESCRIPT)
;
; if it is a admin cost or interest charge, total the amounts
I TRANTYPE=13!(TRANTYPE=12) D Q
. S X=$G(^PRCA(433,RCTRANDA,2)) I X="" Q
. S RCTOTAL("INT")=$G(RCTOTAL("INT"))+$P(X,"^",7)
. S RCTOTAL("ADM")=$G(RCTOTAL("ADM"))+$P(X,"^",8)
. S RCTOTAL("OTH")=$G(RCTOTAL("OTH"))+($P(RCDATA1,"^",5)-$P(X,"^",7)-$P(X,"^",8))
;
; if not an increase adjustment, quit
I TRANTYPE'=1 Q
;
; increase to c means test, ltc or rx-copay, get data from ib
I RCCATEG=18!(RCCATEG=22)!(RCCATEG=23)!(RCCATEG=31)!((RCCATEG>32)&(RCCATEG<40)) D Q ; PRCA*4.5*392
. S X="IBRFN1" X ^%ZOSF("TEST") I '$T Q
. K ^TMP("IBRFN1",$J)
. D STMT^IBRFN1(RCTRANDA)
. D IBDATA
;
; PRCA*4.5*362
; Community Care Transaction Description Adjustments
I RCCATEG>47,RCCATEG<86 D
. S X="IBRFN1" X ^%ZOSF("TEST") I '$T Q
. K ^TMP("IBRFN1",$J)
. D STMT^IBRFN1(RCTRANDA)
. D IBDATA
;END PRCA*4.5*362
Q
;
;
; Returns RCDESC(1..n) array of Bill Description
BILLDESC(RCBILLDA,RCWIDTH) ;
; initialize
N DESCRIPT,RCCATEG,RCCATTXT,RCDATA0,RCLINE,X
I '$G(RCWIDTH) S RCWIDTH=50 ; Default max. width is 50 characters
K RCDESC
S RCLINE=1,RCDESC(1)=""
;
S RCDATA0=^PRCA(430,RCBILLDA,0)
S RCCATEG=+$P(RCDATA0,"^",2),RCCATTXT=$P($G(^PRCA(430.2,RCCATEG,0)),"^")
;
; if category=c means test, set the description and quit
I RCCATEG=18 S DESCRIPT=$S($P(RCDATA0,"^",16):$P(^PRCA(430.2,$P(RCDATA0,"^",16),0),"^"),1:RCCATTXT) D SETDESC(DESCRIPT) Q
;
; set the category description
D SETDESC(RCCATTXT)
;
; if category not champva subsitence and not tricare patient, quit
I RCCATEG'=27,RCCATEG'=31 Q
;
; build description for champva subsistence and tricare patient bills
; get data from ib
S X="IBRFN1" X ^%ZOSF("TEST") I '$T Q
K ^TMP("IBRFN1",$J)
D STMTB^IBRFN1($P(RCDATA0,"^"))
D IBDATA
Q
;
;
IBDATA ; get data from IB for description
N IBACNM,IBDATA,IBJ,IBIEN
;
; show IB data
S IBJ=0 F S IBJ=$O(^TMP("IBRFN1",$J,IBJ)) Q:'IBJ S IBDATA=^TMP("IBRFN1",$J,IBJ) D
. S IBIEN=$O(^IB("B",$P(IBDATA,U),0)),IBACNM=$$GET1^DIQ(350,IBIEN_",",.03) ; PRCA*4.5*392
. I IBACNM["TRICARE RX" D:$P(IBDATA,U,2) SETDESC("FD:"_$$DATE($P(IBDATA,U,2))) Q ; PRCA*4.5*392
. ;
. ; if no drug or bill date returned from IB, then it is outpatient
. ;PRCA*4.5*362 - finish completing line 1 of the Transaction for Community Care copays
. I RCDESC(1)["COMMUNITY CARE RESPITE" D ;determine if inpatient or outpatient
. . I $P(IBDATA,"^",5) D SETDESC("INPATIENT") Q
. . D SETDESC("OUTPATIENT")
. ;
. I RCDESC(1)["COMMUNITY CARE NURSING" D ;determining if Nursing Home or Adult Day Care
. . I $P(IBDATA,"^",5) D SETDESC("INPATIENT") Q
. . S RCDESC(1)="" S DESCRIPT="COMMUNITY CARE ADULT DAY CARE" D SETDESC(DESCRIPT)
. ;
. I RCDESC(1)["COMMUNITY CARE RX" D Q ;Use Bill from date as Fill Date
. . D:$P(IBDATA,"^",3) SETDESC("FD:"_$$DATE($P(IBDATA,"^",3)))
. ;END PRCA*4.5*362
. ;
. ;Start PRCA*4.5*360 - Split CC PER DIEM and CC INPT into different displays
. ;
. I RCDESC(1)["COMMUNITY CARE INPT" D
. . I IBACNM["PER DIEM" D SETDESC("PER DIEM")
. ;END PRCA*4.5*360
. ;
. I $P(IBDATA,"^",3)="" D:$P(IBDATA,"^",2) SETDESC("VISIT DATE: "_$$DATE($P(IBDATA,"^",2))) Q
. ;
. ; if no drug quantity returned from ib, then it is inpatient
. I '$P(IBDATA,"^",6) D Q
. . I $P(IBDATA,"^",2) D SETDESC(" ADMISSION DATE: "_$$DATE($P(IBDATA,"^",2)))
. . I $P(IBDATA,"^",3) D SETDESC(" BEGINNING DATE OF BILLING CYCLE: "_$$DATE($P(IBDATA,"^",3)))
. . I $P(IBDATA,"^",4) D SETDESC(" ENDING DATE OF BILLING CYCLE: "_$$DATE($P(IBDATA,"^",4)))
. . I $P(IBDATA,"^",5) D SETDESC(" DISCHARGE DATE: "_$$DATE($P(IBDATA,"^",5)))
. ;
. ; pharmacy
. D:$P(IBDATA,"^",2) SETDESC("RX:"_$P(IBDATA,"^",2))
. D:$P(IBDATA,"^",7) SETDESC("FD:"_$$DATE($P(IBDATA,"^",7)))
. ;
. ; if not patient statement detail, quit
. I $$DET^RCFN01($P(RCDATA0,"^",9))'=2 Q
. ;
. ; return pharmacy detail
. I $P(IBDATA,"^",3)'="" D SETDESC(" DRUG:"_$TR($P(IBDATA,"^",3),"|~"))
. I $P(IBDATA,"^",4) D SETDESC(" DAYS:"_$P(IBDATA,"^",4))
. I $P(IBDATA,"^",6) D SETDESC(" QTY:"_$P(IBDATA,"^",6))
. I $P(IBDATA,"^",5)'="" D SETDESC(" PHY:"_$P(IBDATA,"^",5))
. I $P(IBDATA,"^",8) D SETDESC(" CHG:$"_$J($P(IBDATA,"^",8),0,2))
;
K ^TMP("IBRFN1",$J)
Q
;
;
; Add line to the description, not longer than RCWIDTH
; Input: RCLINE,RCWIDTH
; Output: RCDESC
SETDESC(DESCRIPT) N LENGTH
; calculate the length of the description
S LENGTH=$L(RCDESC(RCLINE))+$L(DESCRIPT)
I RCDESC(RCLINE)'="" S LENGTH=LENGTH+1
;
; the description line cannot go over RCWIDTH characters
I LENGTH<RCWIDTH S RCDESC(RCLINE)=RCDESC(RCLINE)_$S(RCDESC(RCLINE)="":"",1:" ")_DESCRIPT Q
;
; Description line to add is over RCWIDTH
; The given string will be splitted _only_ if the limit is more than 44 characters.
I $L(DESCRIPT)>RCWIDTH D Q
. I RCDESC(RCLINE)'="" S RCLINE=RCLINE+1
. S RCDESC(RCLINE)=$E(DESCRIPT,1,RCWIDTH)
. S RCLINE=RCLINE+1
. S RCDESC(RCLINE)=$E(DESCRIPT,RCWIDTH+1,2*RCWIDTH)
;
; over RCWIDTH characters, start new line
I RCDESC(RCLINE)'="" S RCLINE=RCLINE+1
S RCDESC(RCLINE)=DESCRIPT
Q
;
DATE(FMDT) ; format date mm/dd/yyyy
I 'FMDT Q ""
N X,Y,%DT S %DT="TX",X=FMDT D ^%DT Q:Y<0 ""
Q $E(FMDT,4,5)_"/"_$E(FMDT,6,7)_"/"_(1700+$E(FMDT,1,3))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCCPCPS1 9105 printed Dec 13, 2024@01:43:13 Page 2
RCCPCPS1 ;WISC/RFJ - build description for patient statement ;08 Aug 2001
+1 ;;4.5;Accounts Receivable;**34,48,104,170,176,192,265,362,360,392**;Mar 20, 1995;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to FILE #350 in ICR #4541
+5 QUIT
+6 ;
+7 ;
TRANDESC(RCTRANDA,RCWIDTH) ; build the description array for a transaction
+1 ;
+2 ; initialize
+3 NEW DESCRIPT,RCBILLDA,RCCATEG,RCCATTXT,RCDATA0,RCDATA1,RCDATA3,RCLINE,TRANTYPE,X
+4 ; Default max. width is 50 characters
IF '$GET(RCWIDTH)
SET RCWIDTH=50
+5 KILL RCDESC
+6 SET RCLINE=1
SET RCDESC(1)=""
+7 ;
+8 SET RCBILLDA=+$PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",2)
IF 'RCBILLDA
QUIT
+9 SET RCDATA0=^PRCA(430,RCBILLDA,0)
+10 SET RCCATEG=+$PIECE(RCDATA0,"^",2)
SET RCCATTXT=$PIECE($GET(^PRCA(430.2,RCCATEG,0)),"^")
+11 SET RCDATA1=^PRCA(433,RCTRANDA,1)
+12 SET TRANTYPE=$PIECE(RCDATA1,"^",2)
+13 ;
+14 ; build the first line description
+15 ; if transaction type is an increase or decrease, set description
+16 IF TRANTYPE=1!(TRANTYPE=35)
Begin DoDot:1
+17 ; if c means test, set description to category for c means test
+18 IF RCCATEG=18
SET DESCRIPT=$SELECT($PIECE(RCDATA0,"^",16):$PIECE(^PRCA(430.2,$PIECE(RCDATA0,"^",16),0),"^"),1:RCCATTXT)
QUIT
+19 ; otherwise, set to category name
+20 ;PRCA*4.5*362
+21 IF RCCATEG>47
IF RCCATEG<86
Begin DoDot:2
+22 IF RCCATTXT["RX"
SET DESCRIPT="COMMUNITY CARE RX"
QUIT
+23 IF RCCATTXT["INPT"
SET DESCRIPT="COMMUNITY CARE INPT"
QUIT
+24 IF RCCATTXT["OPT"
SET DESCRIPT="COMMUNITY CARE OUTPATIENT"
QUIT
+25 IF RCCATTXT["URGENT"
SET DESCRIPT="COMMUNITY CARE URGENT CARE"
QUIT
+26 IF RCCATTXT["RESPITE"
SET DESCRIPT="COMMUNITY CARE RESPITE CARE"
QUIT
+27 IF RCCATTXT["NURSING"
SET DESCRIPT="COMMUNITY CARE NURSING HOME"
End DoDot:2
QUIT
+28 ;end PRCA*4.5*362
+29 ;
+30 SET DESCRIPT=RCCATTXT
End DoDot:1
+31 ;
+32 ; if the bill category is a rx-copay and it is an increase adjustment
+33 ; then set the description to copay
+34 IF RCCATEG=22!(RCCATEG=23)
IF TRANTYPE=1
SET DESCRIPT="COPAY"
+35 ;
+36 ; if the bill category is adult day health care, remove health
+37 IF RCCATEG=33
SET DESCRIPT="ADULT DAY CARE"
+38 ;
+39 ; if the bill category is respite or geriatric eval,
+40 ; take the 2nd piece removing institutional
+41 IF RCCATEG=35!(RCCATEG=36)!(RCCATEG=37)!(RCCATEG=38)
SET DESCRIPT=$PIECE(RCCATTXT,"-")_$SELECT(RCCATEG=35!(RCCATEG=37):" IN",1:" OUT")_"PATIENT"
+42 ;
+43 ; if it is a comment transaction
+44 IF TRANTYPE=45
SET DESCRIPT="COMMENT: "_$PIECE($GET(^PRCA(433,RCTRANDA,5)),"^",2)
+45 ;
+46 ; prepayment bill (1=increase, 35=decrease, otherwise refund)
+47 IF RCCATEG=26
SET DESCRIPT=$SELECT(TRANTYPE=1:"OVERPAYMENT CREDIT",TRANTYPE=35:"OVERPAYMENT CREDIT DECREASE",1:"OVERPAYMENT REFUND")
+48 ;
+49 ; if the first line description not set (like payments), set it
+50 ; to the type of transaction
+51 IF $GET(DESCRIPT)=""
SET DESCRIPT=$PIECE($GET(^PRCA(430.3,+$PIECE(RCDATA1,"^",2),0)),"^")
+52 ;
+53 ; if the transaction date is different from the process date,
+54 ; show it with the description
+55 IF $PIECE(RCDATA1,"^")
IF $PIECE($PIECE(RCDATA1,"^"),".")'=$PIECE($PIECE(RCDATA1,"^",9),".")
SET DESCRIPT=DESCRIPT_" ("_$$DATE($PIECE($PIECE(RCDATA1,"^"),"."))_")"
+56 ;
+57 ; set the first description line
+58 DO SETDESC(DESCRIPT)
+59 ;
+60 ; if it is a payment transaction, show amount paid interest, admin, other
+61 IF TRANTYPE=2!(TRANTYPE=34)
Begin DoDot:1
+62 SET RCDATA3=$GET(^PRCA(433,RCTRANDA,3))
+63 ; if not interest, admin, or other, quit
+64 IF '$PIECE(RCDATA3,"^",2)
IF '$PIECE(RCDATA3,"^",3)
IF '$PIECE(RCDATA3,"^",4)
IF '$PIECE(RCDATA3,"^",5)
QUIT
+65 ;
+66 SET DESCRIPT=" (Int:"_$JUSTIFY(+$PIECE(RCDATA3,"^",2),1,2)_" Adm:"_$JUSTIFY(+$PIECE(RCDATA3,"^",3),1,2)
+67 ; calculate other
+68 SET X=$PIECE(RCDATA1,"^",5)-$PIECE(RCDATA3,"^")-$PIECE(RCDATA3,"^",2)-$PIECE(RCDATA3,"^",3)
+69 SET DESCRIPT=DESCRIPT_$SELECT(X:" Other:"_$JUSTIFY(X,1,2)_")",1:")")
+70 DO SETDESC(DESCRIPT)
End DoDot:1
+71 ;
+72 ; if it is a admin cost or interest charge, total the amounts
+73 IF TRANTYPE=13!(TRANTYPE=12)
Begin DoDot:1
+74 SET X=$GET(^PRCA(433,RCTRANDA,2))
IF X=""
QUIT
+75 SET RCTOTAL("INT")=$GET(RCTOTAL("INT"))+$PIECE(X,"^",7)
+76 SET RCTOTAL("ADM")=$GET(RCTOTAL("ADM"))+$PIECE(X,"^",8)
+77 SET RCTOTAL("OTH")=$GET(RCTOTAL("OTH"))+($PIECE(RCDATA1,"^",5)-$PIECE(X,"^",7)-$PIECE(X,"^",8))
End DoDot:1
QUIT
+78 ;
+79 ; if not an increase adjustment, quit
+80 IF TRANTYPE'=1
QUIT
+81 ;
+82 ; increase to c means test, ltc or rx-copay, get data from ib
+83 ; PRCA*4.5*392
IF RCCATEG=18!(RCCATEG=22)!(RCCATEG=23)!(RCCATEG=31)!((RCCATEG>32)&(RCCATEG<40))
Begin DoDot:1
+84 SET X="IBRFN1"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+85 KILL ^TMP("IBRFN1",$JOB)
+86 DO STMT^IBRFN1(RCTRANDA)
+87 DO IBDATA
End DoDot:1
QUIT
+88 ;
+89 ; PRCA*4.5*362
+90 ; Community Care Transaction Description Adjustments
+91 IF RCCATEG>47
IF RCCATEG<86
Begin DoDot:1
+92 SET X="IBRFN1"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+93 KILL ^TMP("IBRFN1",$JOB)
+94 DO STMT^IBRFN1(RCTRANDA)
+95 DO IBDATA
End DoDot:1
+96 ;END PRCA*4.5*362
+97 QUIT
+98 ;
+99 ;
+100 ; Returns RCDESC(1..n) array of Bill Description
BILLDESC(RCBILLDA,RCWIDTH) ;
+1 ; initialize
+2 NEW DESCRIPT,RCCATEG,RCCATTXT,RCDATA0,RCLINE,X
+3 ; Default max. width is 50 characters
IF '$GET(RCWIDTH)
SET RCWIDTH=50
+4 KILL RCDESC
+5 SET RCLINE=1
SET RCDESC(1)=""
+6 ;
+7 SET RCDATA0=^PRCA(430,RCBILLDA,0)
+8 SET RCCATEG=+$PIECE(RCDATA0,"^",2)
SET RCCATTXT=$PIECE($GET(^PRCA(430.2,RCCATEG,0)),"^")
+9 ;
+10 ; if category=c means test, set the description and quit
+11 IF RCCATEG=18
SET DESCRIPT=$SELECT($PIECE(RCDATA0,"^",16):$PIECE(^PRCA(430.2,$PIECE(RCDATA0,"^",16),0),"^"),1:RCCATTXT)
DO SETDESC(DESCRIPT)
QUIT
+12 ;
+13 ; set the category description
+14 DO SETDESC(RCCATTXT)
+15 ;
+16 ; if category not champva subsitence and not tricare patient, quit
+17 IF RCCATEG'=27
IF RCCATEG'=31
QUIT
+18 ;
+19 ; build description for champva subsistence and tricare patient bills
+20 ; get data from ib
+21 SET X="IBRFN1"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+22 KILL ^TMP("IBRFN1",$JOB)
+23 DO STMTB^IBRFN1($PIECE(RCDATA0,"^"))
+24 DO IBDATA
+25 QUIT
+26 ;
+27 ;
IBDATA ; get data from IB for description
+1 NEW IBACNM,IBDATA,IBJ,IBIEN
+2 ;
+3 ; show IB data
+4 SET IBJ=0
FOR
SET IBJ=$ORDER(^TMP("IBRFN1",$JOB,IBJ))
if 'IBJ
QUIT
SET IBDATA=^TMP("IBRFN1",$JOB,IBJ)
Begin DoDot:1
+5 ; PRCA*4.5*392
SET IBIEN=$ORDER(^IB("B",$PIECE(IBDATA,U),0))
SET IBACNM=$$GET1^DIQ(350,IBIEN_",",.03)
+6 ; PRCA*4.5*392
IF IBACNM["TRICARE RX"
if $PIECE(IBDATA,U,2)
DO SETDESC("FD:"_$$DATE($PIECE(IBDATA,U,2)))
QUIT
+7 ;
+8 ; if no drug or bill date returned from IB, then it is outpatient
+9 ;PRCA*4.5*362 - finish completing line 1 of the Transaction for Community Care copays
+10 ;determine if inpatient or outpatient
IF RCDESC(1)["COMMUNITY CARE RESPITE"
Begin DoDot:2
+11 IF $PIECE(IBDATA,"^",5)
DO SETDESC("INPATIENT")
QUIT
+12 DO SETDESC("OUTPATIENT")
End DoDot:2
+13 ;
+14 ;determining if Nursing Home or Adult Day Care
IF RCDESC(1)["COMMUNITY CARE NURSING"
Begin DoDot:2
+15 IF $PIECE(IBDATA,"^",5)
DO SETDESC("INPATIENT")
QUIT
+16 SET RCDESC(1)=""
SET DESCRIPT="COMMUNITY CARE ADULT DAY CARE"
DO SETDESC(DESCRIPT)
End DoDot:2
+17 ;
+18 ;Use Bill from date as Fill Date
IF RCDESC(1)["COMMUNITY CARE RX"
Begin DoDot:2
+19 if $PIECE(IBDATA,"^",3)
DO SETDESC("FD:"_$$DATE($PIECE(IBDATA,"^",3)))
End DoDot:2
QUIT
+20 ;END PRCA*4.5*362
+21 ;
+22 ;Start PRCA*4.5*360 - Split CC PER DIEM and CC INPT into different displays
+23 ;
+24 IF RCDESC(1)["COMMUNITY CARE INPT"
Begin DoDot:2
+25 IF IBACNM["PER DIEM"
DO SETDESC("PER DIEM")
End DoDot:2
+26 ;END PRCA*4.5*360
+27 ;
+28 IF $PIECE(IBDATA,"^",3)=""
if $PIECE(IBDATA,"^",2)
DO SETDESC("VISIT DATE: "_$$DATE($PIECE(IBDATA,"^",2)))
QUIT
+29 ;
+30 ; if no drug quantity returned from ib, then it is inpatient
+31 IF '$PIECE(IBDATA,"^",6)
Begin DoDot:2
+32 IF $PIECE(IBDATA,"^",2)
DO SETDESC(" ADMISSION DATE: "_$$DATE($PIECE(IBDATA,"^",2)))
+33 IF $PIECE(IBDATA,"^",3)
DO SETDESC(" BEGINNING DATE OF BILLING CYCLE: "_$$DATE($PIECE(IBDATA,"^",3)))
+34 IF $PIECE(IBDATA,"^",4)
DO SETDESC(" ENDING DATE OF BILLING CYCLE: "_$$DATE($PIECE(IBDATA,"^",4)))
+35 IF $PIECE(IBDATA,"^",5)
DO SETDESC(" DISCHARGE DATE: "_$$DATE($PIECE(IBDATA,"^",5)))
End DoDot:2
QUIT
+36 ;
+37 ; pharmacy
+38 if $PIECE(IBDATA,"^",2)
DO SETDESC("RX:"_$PIECE(IBDATA,"^",2))
+39 if $PIECE(IBDATA,"^",7)
DO SETDESC("FD:"_$$DATE($PIECE(IBDATA,"^",7)))
+40 ;
+41 ; if not patient statement detail, quit
+42 IF $$DET^RCFN01($PIECE(RCDATA0,"^",9))'=2
QUIT
+43 ;
+44 ; return pharmacy detail
+45 IF $PIECE(IBDATA,"^",3)'=""
DO SETDESC(" DRUG:"_$TRANSLATE($PIECE(IBDATA,"^",3),"|~"))
+46 IF $PIECE(IBDATA,"^",4)
DO SETDESC(" DAYS:"_$PIECE(IBDATA,"^",4))
+47 IF $PIECE(IBDATA,"^",6)
DO SETDESC(" QTY:"_$PIECE(IBDATA,"^",6))
+48 IF $PIECE(IBDATA,"^",5)'=""
DO SETDESC(" PHY:"_$PIECE(IBDATA,"^",5))
+49 IF $PIECE(IBDATA,"^",8)
DO SETDESC(" CHG:$"_$JUSTIFY($PIECE(IBDATA,"^",8),0,2))
End DoDot:1
+50 ;
+51 KILL ^TMP("IBRFN1",$JOB)
+52 QUIT
+53 ;
+54 ;
+55 ; Add line to the description, not longer than RCWIDTH
+56 ; Input: RCLINE,RCWIDTH
+57 ; Output: RCDESC
SETDESC(DESCRIPT) NEW LENGTH
+1 ; calculate the length of the description
+2 SET LENGTH=$LENGTH(RCDESC(RCLINE))+$LENGTH(DESCRIPT)
+3 IF RCDESC(RCLINE)'=""
SET LENGTH=LENGTH+1
+4 ;
+5 ; the description line cannot go over RCWIDTH characters
+6 IF LENGTH<RCWIDTH
SET RCDESC(RCLINE)=RCDESC(RCLINE)_$SELECT(RCDESC(RCLINE)="":"",1:" ")_DESCRIPT
QUIT
+7 ;
+8 ; Description line to add is over RCWIDTH
+9 ; The given string will be splitted _only_ if the limit is more than 44 characters.
+10 IF $LENGTH(DESCRIPT)>RCWIDTH
Begin DoDot:1
+11 IF RCDESC(RCLINE)'=""
SET RCLINE=RCLINE+1
+12 SET RCDESC(RCLINE)=$EXTRACT(DESCRIPT,1,RCWIDTH)
+13 SET RCLINE=RCLINE+1
+14 SET RCDESC(RCLINE)=$EXTRACT(DESCRIPT,RCWIDTH+1,2*RCWIDTH)
End DoDot:1
QUIT
+15 ;
+16 ; over RCWIDTH characters, start new line
+17 IF RCDESC(RCLINE)'=""
SET RCLINE=RCLINE+1
+18 SET RCDESC(RCLINE)=DESCRIPT
+19 QUIT
+20 ;
DATE(FMDT) ; format date mm/dd/yyyy
+1 IF 'FMDT
QUIT ""
+2 NEW X,Y,%DT
SET %DT="TX"
SET X=FMDT
DO ^%DT
if Y<0
QUIT ""
+3 QUIT $EXTRACT(FMDT,4,5)_"/"_$EXTRACT(FMDT,6,7)_"/"_(1700+$EXTRACT(FMDT,1,3))
