RCDPEARL ;ALB/hrubovcak - Misc. Report utilities for ListMan, etc. ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**298,321,332**;15 April 2014;Build 40
;Per VA Directive 6402, this routine should not be modified.
;
; IA 594 - ACCOUNTS RECEIVABLE CATEGORY file (#430.2)
; IA 1992 - BILL/CLAIMS file (#399)
; IA 3822 - RATE TYPE file (#399.3)
; IA 4051 - EXPLANATION OF BENEFITS file (#361.1)
;
Q
;
ASK(STOP) ; Ask to continue
; STOP passed by ref., returned as 1 if timeout or user enters '^'
Q:'($E(IOST,1,2)="C-") ; must have user
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR("A")="Press enter to continue, '^' to exit: "
S DIR(0)="EA" D ^DIR
I ($D(DTOUT))!($D(DUOUT))!(Y="^") S STOP=1
Q
;
ASKLM(DEFAULT) ; Extrinsic function, ask for ListMan display using ^DIR
; Input: DEFAULT - 1 - Default 'YES', 0 - Default 'NO'
; Optional defaults to 0
; Returns: 0 - No, 1 - YES, -1 on timeout or '^'
N DIR,RSLT,X,Y
S:'$D(DEFAULT) DEFAULT=0 ; PRCA*4.5*332
S RSLT=0
S DIR(0)="YA",DIR("A")="Display in List Manager format? (Y/N): "
S DIR("B")=$S(DEFAULT:"YES",1:"NO") ; PRCA*4.5*332
D ^DIR S RSLT=$S($D(DUOUT)!$D(DTOUT):-1,1:Y)
Q RSLT
;
CLMCHMPV(RCLMIEN) ; boolean function, returns true if CHAMPVA claim, else false
; RCLMIEN - file entry, format: 'file #;ien' (see PTR4302 comments)
Q $$EVALCLM(RCLMIEN,"CHAMPVA")
;
CLMTRICR(RCLMIEN) ; boolean function, returns true if TRICARE claim, else false
; RCLMIEN - file entry, format: 'file #;ien' (see PTR4302 comments)
Q $$EVALCLM(RCLMIEN,"TRICARE")
;
ENDORPRT() ; extrinsic variable, formatted for 80 column display
N A S A="***** END OF REPORT *****" Q $J(" ",80-$L(A)\2)_A
;
EVALCLM(RCLMIEN,TRGTXT) ; boolean function, case insensitive
; returns 1 if claim has target text, else false (error messages evaluate as false)
; RCLMIEN (required) - file entry, format: 'file #;ien' (see PTR4302 comments)
; TRGTXT (required) - target text
Q:($G(RCLMIEN)="")!($G(TRGTXT)="") "^invalid" ; both required
N RSLT,F,R,T
S T=$$UP(TRGTXT),RSLT=0 ; text to uppercase, default to false
S F=$G(RCLMIEN) Q:'($P(F,";")>1)!'($P(F,";",2)>0) RSLT ; file must be > 1 and entry > zero
S R=$$PTR4302(RCLMIEN) Q:'R RSLT ; no text to check
;
S F=$$UP($P(R,";",2,99)) ; text of entry from ACCOUNTS RECEIVABLE CATEGORY (#430.2)
S RSLT=F[T ; boolean result
Q RSLT
;
INCHMPVA() ; function, include CHAMPVA question
; returns zero = No, 1 = yes, -1 on timeout or '^'
N DIR,DTOUT,DUOUT,RSLT,X,Y S RSLT=0
S DIR(0)="YA",DIR("A")="Include CHAMPVA? (Y/N): ",DIR("B")="YES"
S DIR("?")="Enter 'NO' to exclude entries related to CHAMPVA from the report."
D ^DIR S RSLT=$S($D(DUOUT)!$D(DTOUT):-1,1:Y)
Q RSLT
;
INTRICAR() ; function, include TRICARE question
; returns zero = No, 1 = yes, -1 on timeout or '^'
N DIR,DTOUT,DUOUT,RSLT,X,Y S RSLT=0
S DIR(0)="YA",DIR("A")="Include TRICARE? (Y/N): ",DIR("B")="YES"
S DIR("?")="Enter 'NO' to exclude entries related to TRICARE from the report."
D ^DIR S RSLT=$S($D(DUOUT)!$D(DTOUT):-1,1:Y)
Q RSLT
; Begin PRCA*4.5*321
;
EXCHMPVA() ; function, exclude CHAMPVA question - EP RCDPEM4
; returns zero = No, 1 = yes, -1 on timeout or '^'
N DIR,DTOUT,DUOUT,RSLT,X,Y S RSLT=0
S DIR(0)="YA",DIR("A")="Exclude CHAMPVA? (Y/N): ",DIR("B")="NO"
S DIR("?")="Enter 'Y' to exclude entries related to CHAMPVA from the report."
D ^DIR S RSLT=$S($D(DUOUT)!$D(DTOUT):-1,1:Y)
Q RSLT
;
EXTRICAR() ; function, exclude TRICARE question - EP RCDPEM4
; returns zero = No, 1 = yes, -1 on timeout or '^'
N DIR,DTOUT,DUOUT,RSLT,X,Y S RSLT=0
S DIR(0)="YA",DIR("A")="Exclude TRICARE? (Y/N): ",DIR("B")="NO"
S DIR("?")="Enter 'Y' to exclude entries related to TRICARE from the report."
D ^DIR S RSLT=$S($D(DUOUT)!$D(DTOUT):-1,1:Y)
Q RSLT
; End PRCA*4.5*321
;
HDRLST(RCSTOP,RCHDR) ; write the header in RCHDR
; RCSTOP, RCHDR passed by ref.
Q:RCSTOP ; nothing to do
;
I $E(IOST,1,2)="C-",'RCDISPTY,RCPGNUM D ASK(.RCSTOP)
Q:RCSTOP ; no header needed
I 'RCDISPTY W @IOF
X RCHDR("XECUTE") ; increment page count, insert into header
N J F J=1:1:RCHDR(0) W !,RCHDR(J)
Q
;
LMEN(LMTMP) ; Invoke ListMan for RCDPE MISC REPORTS list template
; Input: LMTMP - Name of a different listman template to use
; Optional, defaults to ""
N XX
S XX=$S($G(LMTMP)'="":LMTMP,1:"RCDPE MISC REPORTS") ; PRCA*4.5*332
D EN^VALM(XX) ; PRCA*4.5*332
Q
;
LMHDR ; ListMan header
N J S J=0
F J=1:1 Q:'$D(RCLMHDR(J)) S VALMHDR(J)=RCLMHDR(J)
S:$G(RCLMHDR("TITLE"))'="" VALM("TITLE")=RCLMHDR("TITLE")
Q
;
LMINIT ; set up ListMan array, invoked from inside List Template
;
N C,J,Y S (J,C)=0
F S J=$O(@RCLMND@(J)) Q:'J S Y=$G(@RCLMND@(J)),C=C+1 D SET^VALM10(C,Y)
S VALMCNT=C
Q
;
LMHLP ; ListMan help
S X="?" D DISP^XQORM1 W !!
Q
;
LMEXIT ; performed on exiting ListMan screen
K @RCLMND ; delete ListMan data
D FULL^VALM1 ; reset terminal display
Q
;
LMEXPND ; expand code for ListMan
Q
;
LMRPT(RCLMHDR,RCLMND,LMTMP) ; Generate ListMan display
; Input: RCLMHDR - Header text, passed by ref. (required)
; RCLMND - Storage node for ListMan data (required)
; LMTMP - Name of a listman template to use
; Optional, defaults to ""
Q:'$D(RCLMHDR) Q:($G(RCLMND)="") ; both required
S:'$D(LMTMP) LMTMP="" ; PRCA*4.5*332
D LMEN(LMTMP) ; PRCA*4.5*332
Q
;
NOW() Q $$FMTE^XLFDT($$NOW^XLFDT,2) ; extrinsic variable, now as MM/DD/YY@HH:MM:SS
;
PAD(TXT,LNGTH) ; function, pad TXT with spaces to LNGTH
Q $$LJ^XLFSTR(TXT,LNGTH)
;
PTR4302(FLNTRY) ; function, returns entry from 430.2 or error message
; FLNTRY - file entry (required), format: 'file #;ien'
; on success returns 'ien^name' else '^error message'
; file number and ien can be from:
; ^PRCA(430.2,0) = ACCOUNTS RECEIVABLE CATEGORY^430.2I
; ^DGCR(399.3,0) = RATE TYPE^399.3I^
; ^DGCR(399,0) = BILL/CLAIMS^399I
; ^IBM(361.1,0) = EXPLANATION OF BENEFITS^361.1PI^
; ^RCY(344.4,0) = ELECTRONIC REMITTANCE ADVICE^344.4I
; ^RCY(344,0) = AR BATCH PAYMENT^344I
;
N F,PF,RCFLNUM,RCIEN,RSLT,X,Y
; PF - parent file
; RCFLNUM - file number
; RCIEN - internal entry number
; RSLT - result
;
S RSLT=U,F=$G(FLNTRY),RCFLNUM=+$P(F,";"),RCIEN=+$P(F,";",2)
Q:'(RCFLNUM>1) U_"invalid file #"
Q:'(RCIEN>0) U_"invalid IEN"
;
; default result
S RSLT="^file "_RCFLNUM_" no entry #"_RCIEN
;
; ACCOUNTS RECEIVABLE CATEGORY file #430.2
I RCFLNUM=430.2 D Q RSLT
.S X=$G(^PRCA(430.2,RCIEN,0)),Y=$P(X,U) S:Y]"" RSLT=RCIEN_";"_Y
;
; RATE TYPE file #399.3, (#.06) ACCOUNTS RECEIVABLE CATEGORY [6P:430.2]
I RCFLNUM=399.3 D Q RSLT
.S X=$G(^DGCR(399.3,RCIEN,0)),Y=+$P(X,U,6) Q:'(Y>0)
.S RSLT=$$PTR4302("430.2;"_Y)
;
; BILL/CLAIMS file #399, (#.07) RATE TYPE [7P:399.3]
I RCFLNUM=399 D Q RSLT
.S X=$G(^DGCR(399,RCIEN,0)) Q:X=""
.S PF=399.3,RSLT="^no pointer to "_PF,Y=+$P(X,U,7) Q:'(Y>0)
.S RSLT=$$PTR4302(PF_";"_Y)
;
; EXPLANATION OF BENEFITS file #361.1, (#.01) BILL [1P:399]
I RCFLNUM=361.1 D Q RSLT
.S X=$G(^IBM(361.1,RCIEN,0)) Q:X=""
.S PF=399,RSLT="^no pointer to "_PF,Y=+$P(X,U) Q:'(Y>0)
.S RSLT=$$PTR4302(PF_";"_Y)
;
; ELECTRONIC REMITTANCE ADVICE file #344.4
; ERA DETAIL sub-file #344.41, (#.02) EOB DETAIL [2P:361.1]
I RCFLNUM=344.4 D Q RSLT
.S X=$G(^RCY(344.4,RCIEN,0)) Q:X="" ; top level entry not found
.S RSLT="^sub-file 344.41 no entries"
.; take first entry that gives result from file #430.2
.N J,C S (J,C)=0 F S J=$O(^RCY(344.4,RCIEN,1,J)) Q:'J!RSLT S X=$G(^(J,0)) D
..S PF=361.1,RSLT="^no pointer to "_PF
..S Y=+$P(X,U,2) Q:'(Y>0) S C=C+1
..S RSLT="^sub-file 344.41 total checked "_C,F=$$PTR4302(PF_";"_Y) S:F RSLT=F
;
; AR BATCH PAYMENT file #344, (#.18) ERA REFERENCE [18P:344.4]
I RCFLNUM=344 D Q RSLT
.S X=$G(^RCY(344,RCIEN,0)) Q:X=""
.S PF=344.4,Y=+$P(X,U,18),RSLT="^no pointer to "_PF Q:'(Y>0)
.S RSLT=$$PTR4302(PF_";"_Y)
;
; finished all checks, valid file number not found
S RSLT=U_"invalid file #"_RCFLNUM
;
Q RSLT
;
SL(T,RCLNCNT,RC2GLBL) ; Set text into global or write line
; T = text to output
; RCLNCNT = line counter, passed by ref. (optional)
; RC2GLBL = if non-null indicates output to global, no writes
I $G(RC2GLBL)="" W !,T Q
S RCLNCNT=RCLNCNT+1,^TMP($J,RC2GLBL,RCLNCNT)=T
Q
;
UP(A) ; Returns UPPERCASE
Q $$UP^XLFSTR(A)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEARL 8564 printed Apr 09, 2024@20:51:13 Page 2
RCDPEARL ;ALB/hrubovcak - Misc. Report utilities for ListMan, etc. ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**298,321,332**;15 April 2014;Build 40
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; IA 594 - ACCOUNTS RECEIVABLE CATEGORY file (#430.2)
+5 ; IA 1992 - BILL/CLAIMS file (#399)
+6 ; IA 3822 - RATE TYPE file (#399.3)
+7 ; IA 4051 - EXPLANATION OF BENEFITS file (#361.1)
+8 ;
+9 QUIT
+10 ;
ASK(STOP) ; Ask to continue
+1 ; STOP passed by ref., returned as 1 if timeout or user enters '^'
+2 ; must have user
if '($EXTRACT(IOST,1,2)="C-")
QUIT
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+4 SET DIR("A")="Press enter to continue, '^' to exit: "
+5 SET DIR(0)="EA"
DO ^DIR
+6 IF ($DATA(DTOUT))!($DATA(DUOUT))!(Y="^")
SET STOP=1
+7 QUIT
+8 ;
ASKLM(DEFAULT) ; Extrinsic function, ask for ListMan display using ^DIR
+1 ; Input: DEFAULT - 1 - Default 'YES', 0 - Default 'NO'
+2 ; Optional defaults to 0
+3 ; Returns: 0 - No, 1 - YES, -1 on timeout or '^'
+4 NEW DIR,RSLT,X,Y
+5 ; PRCA*4.5*332
if '$DATA(DEFAULT)
SET DEFAULT=0
+6 SET RSLT=0
+7 SET DIR(0)="YA"
SET DIR("A")="Display in List Manager format? (Y/N): "
+8 ; PRCA*4.5*332
SET DIR("B")=$SELECT(DEFAULT:"YES",1:"NO")
+9 DO ^DIR
SET RSLT=$SELECT($DATA(DUOUT)!$DATA(DTOUT):-1,1:Y)
+10 QUIT RSLT
+11 ;
CLMCHMPV(RCLMIEN) ; boolean function, returns true if CHAMPVA claim, else false
+1 ; RCLMIEN - file entry, format: 'file #;ien' (see PTR4302 comments)
+2 QUIT $$EVALCLM(RCLMIEN,"CHAMPVA")
+3 ;
CLMTRICR(RCLMIEN) ; boolean function, returns true if TRICARE claim, else false
+1 ; RCLMIEN - file entry, format: 'file #;ien' (see PTR4302 comments)
+2 QUIT $$EVALCLM(RCLMIEN,"TRICARE")
+3 ;
ENDORPRT() ; extrinsic variable, formatted for 80 column display
+1 NEW A
SET A="***** END OF REPORT *****"
QUIT $JUSTIFY(" ",80-$LENGTH(A)\2)_A
+2 ;
EVALCLM(RCLMIEN,TRGTXT) ; boolean function, case insensitive
+1 ; returns 1 if claim has target text, else false (error messages evaluate as false)
+2 ; RCLMIEN (required) - file entry, format: 'file #;ien' (see PTR4302 comments)
+3 ; TRGTXT (required) - target text
+4 ; both required
if ($GET(RCLMIEN)="")!($GET(TRGTXT)="")
QUIT "^invalid"
+5 NEW RSLT,F,R,T
+6 ; text to uppercase, default to false
SET T=$$UP(TRGTXT)
SET RSLT=0
+7 ; file must be > 1 and entry > zero
SET F=$GET(RCLMIEN)
if '($PIECE(F,";")>1)!'($PIECE(F,";",2)>0)
QUIT RSLT
+8 ; no text to check
SET R=$$PTR4302(RCLMIEN)
if 'R
QUIT RSLT
+9 ;
+10 ; text of entry from ACCOUNTS RECEIVABLE CATEGORY (#430.2)
SET F=$$UP($PIECE(R,";",2,99))
+11 ; boolean result
SET RSLT=F[T
+12 QUIT RSLT
+13 ;
INCHMPVA() ; function, include CHAMPVA question
+1 ; returns zero = No, 1 = yes, -1 on timeout or '^'
+2 NEW DIR,DTOUT,DUOUT,RSLT,X,Y
SET RSLT=0
+3 SET DIR(0)="YA"
SET DIR("A")="Include CHAMPVA? (Y/N): "
SET DIR("B")="YES"
+4 SET DIR("?")="Enter 'NO' to exclude entries related to CHAMPVA from the report."
+5 DO ^DIR
SET RSLT=$SELECT($DATA(DUOUT)!$DATA(DTOUT):-1,1:Y)
+6 QUIT RSLT
+7 ;
INTRICAR() ; function, include TRICARE question
+1 ; returns zero = No, 1 = yes, -1 on timeout or '^'
+2 NEW DIR,DTOUT,DUOUT,RSLT,X,Y
SET RSLT=0
+3 SET DIR(0)="YA"
SET DIR("A")="Include TRICARE? (Y/N): "
SET DIR("B")="YES"
+4 SET DIR("?")="Enter 'NO' to exclude entries related to TRICARE from the report."
+5 DO ^DIR
SET RSLT=$SELECT($DATA(DUOUT)!$DATA(DTOUT):-1,1:Y)
+6 QUIT RSLT
+7 ; Begin PRCA*4.5*321
+8 ;
EXCHMPVA() ; function, exclude CHAMPVA question - EP RCDPEM4
+1 ; returns zero = No, 1 = yes, -1 on timeout or '^'
+2 NEW DIR,DTOUT,DUOUT,RSLT,X,Y
SET RSLT=0
+3 SET DIR(0)="YA"
SET DIR("A")="Exclude CHAMPVA? (Y/N): "
SET DIR("B")="NO"
+4 SET DIR("?")="Enter 'Y' to exclude entries related to CHAMPVA from the report."
+5 DO ^DIR
SET RSLT=$SELECT($DATA(DUOUT)!$DATA(DTOUT):-1,1:Y)
+6 QUIT RSLT
+7 ;
EXTRICAR() ; function, exclude TRICARE question - EP RCDPEM4
+1 ; returns zero = No, 1 = yes, -1 on timeout or '^'
+2 NEW DIR,DTOUT,DUOUT,RSLT,X,Y
SET RSLT=0
+3 SET DIR(0)="YA"
SET DIR("A")="Exclude TRICARE? (Y/N): "
SET DIR("B")="NO"
+4 SET DIR("?")="Enter 'Y' to exclude entries related to TRICARE from the report."
+5 DO ^DIR
SET RSLT=$SELECT($DATA(DUOUT)!$DATA(DTOUT):-1,1:Y)
+6 QUIT RSLT
+7 ; End PRCA*4.5*321
+8 ;
HDRLST(RCSTOP,RCHDR) ; write the header in RCHDR
+1 ; RCSTOP, RCHDR passed by ref.
+2 ; nothing to do
if RCSTOP
QUIT
+3 ;
+4 IF $EXTRACT(IOST,1,2)="C-"
IF 'RCDISPTY
IF RCPGNUM
DO ASK(.RCSTOP)
+5 ; no header needed
if RCSTOP
QUIT
+6 IF 'RCDISPTY
WRITE @IOF
+7 ; increment page count, insert into header
XECUTE RCHDR("XECUTE")
+8 NEW J
FOR J=1:1:RCHDR(0)
WRITE !,RCHDR(J)
+9 QUIT
+10 ;
LMEN(LMTMP) ; Invoke ListMan for RCDPE MISC REPORTS list template
+1 ; Input: LMTMP - Name of a different listman template to use
+2 ; Optional, defaults to ""
+3 NEW XX
+4 ; PRCA*4.5*332
SET XX=$SELECT($GET(LMTMP)'="":LMTMP,1:"RCDPE MISC REPORTS")
+5 ; PRCA*4.5*332
DO EN^VALM(XX)
+6 QUIT
+7 ;
LMHDR ; ListMan header
+1 NEW J
SET J=0
+2 FOR J=1:1
if '$DATA(RCLMHDR(J))
QUIT
SET VALMHDR(J)=RCLMHDR(J)
+3 if $GET(RCLMHDR("TITLE"))'=""
SET VALM("TITLE")=RCLMHDR("TITLE")
+4 QUIT
+5 ;
LMINIT ; set up ListMan array, invoked from inside List Template
+1 ;
+2 NEW C,J,Y
SET (J,C)=0
+3 FOR
SET J=$ORDER(@RCLMND@(J))
if 'J
QUIT
SET Y=$GET(@RCLMND@(J))
SET C=C+1
DO SET^VALM10(C,Y)
+4 SET VALMCNT=C
+5 QUIT
+6 ;
LMHLP ; ListMan help
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
LMEXIT ; performed on exiting ListMan screen
+1 ; delete ListMan data
KILL @RCLMND
+2 ; reset terminal display
DO FULL^VALM1
+3 QUIT
+4 ;
LMEXPND ; expand code for ListMan
+1 QUIT
+2 ;
LMRPT(RCLMHDR,RCLMND,LMTMP) ; Generate ListMan display
+1 ; Input: RCLMHDR - Header text, passed by ref. (required)
+2 ; RCLMND - Storage node for ListMan data (required)
+3 ; LMTMP - Name of a listman template to use
+4 ; Optional, defaults to ""
+5 ; both required
if '$DATA(RCLMHDR)
QUIT
if ($GET(RCLMND)="")
QUIT
+6 ; PRCA*4.5*332
if '$DATA(LMTMP)
SET LMTMP=""
+7 ; PRCA*4.5*332
DO LMEN(LMTMP)
+8 QUIT
+9 ;
NOW() ; extrinsic variable, now as MM/DD/YY@HH:MM:SS
QUIT $$FMTE^XLFDT($$NOW^XLFDT,2)
+1 ;
PAD(TXT,LNGTH) ; function, pad TXT with spaces to LNGTH
+1 QUIT $$LJ^XLFSTR(TXT,LNGTH)
+2 ;
PTR4302(FLNTRY) ; function, returns entry from 430.2 or error message
+1 ; FLNTRY - file entry (required), format: 'file #;ien'
+2 ; on success returns 'ien^name' else '^error message'
+3 ; file number and ien can be from:
+4 ; ^PRCA(430.2,0) = ACCOUNTS RECEIVABLE CATEGORY^430.2I
+5 ; ^DGCR(399.3,0) = RATE TYPE^399.3I^
+6 ; ^DGCR(399,0) = BILL/CLAIMS^399I
+7 ; ^IBM(361.1,0) = EXPLANATION OF BENEFITS^361.1PI^
+8 ; ^RCY(344.4,0) = ELECTRONIC REMITTANCE ADVICE^344.4I
+9 ; ^RCY(344,0) = AR BATCH PAYMENT^344I
+10 ;
+11 NEW F,PF,RCFLNUM,RCIEN,RSLT,X,Y
+12 ; PF - parent file
+13 ; RCFLNUM - file number
+14 ; RCIEN - internal entry number
+15 ; RSLT - result
+16 ;
+17 SET RSLT=U
SET F=$GET(FLNTRY)
SET RCFLNUM=+$PIECE(F,";")
SET RCIEN=+$PIECE(F,";",2)
+18 if '(RCFLNUM>1)
QUIT U_"invalid file #"
+19 if '(RCIEN>0)
QUIT U_"invalid IEN"
+20 ;
+21 ; default result
+22 SET RSLT="^file "_RCFLNUM_" no entry #"_RCIEN
+23 ;
+24 ; ACCOUNTS RECEIVABLE CATEGORY file #430.2
+25 IF RCFLNUM=430.2
Begin DoDot:1
+26 SET X=$GET(^PRCA(430.2,RCIEN,0))
SET Y=$PIECE(X,U)
if Y]""
SET RSLT=RCIEN_";"_Y
End DoDot:1
QUIT RSLT
+27 ;
+28 ; RATE TYPE file #399.3, (#.06) ACCOUNTS RECEIVABLE CATEGORY [6P:430.2]
+29 IF RCFLNUM=399.3
Begin DoDot:1
+30 SET X=$GET(^DGCR(399.3,RCIEN,0))
SET Y=+$PIECE(X,U,6)
if '(Y>0)
QUIT
+31 SET RSLT=$$PTR4302("430.2;"_Y)
End DoDot:1
QUIT RSLT
+32 ;
+33 ; BILL/CLAIMS file #399, (#.07) RATE TYPE [7P:399.3]
+34 IF RCFLNUM=399
Begin DoDot:1
+35 SET X=$GET(^DGCR(399,RCIEN,0))
if X=""
QUIT
+36 SET PF=399.3
SET RSLT="^no pointer to "_PF
SET Y=+$PIECE(X,U,7)
if '(Y>0)
QUIT
+37 SET RSLT=$$PTR4302(PF_";"_Y)
End DoDot:1
QUIT RSLT
+38 ;
+39 ; EXPLANATION OF BENEFITS file #361.1, (#.01) BILL [1P:399]
+40 IF RCFLNUM=361.1
Begin DoDot:1
+41 SET X=$GET(^IBM(361.1,RCIEN,0))
if X=""
QUIT
+42 SET PF=399
SET RSLT="^no pointer to "_PF
SET Y=+$PIECE(X,U)
if '(Y>0)
QUIT
+43 SET RSLT=$$PTR4302(PF_";"_Y)
End DoDot:1
QUIT RSLT
+44 ;
+45 ; ELECTRONIC REMITTANCE ADVICE file #344.4
+46 ; ERA DETAIL sub-file #344.41, (#.02) EOB DETAIL [2P:361.1]
+47 IF RCFLNUM=344.4
Begin DoDot:1
+48 ; top level entry not found
SET X=$GET(^RCY(344.4,RCIEN,0))
if X=""
QUIT
+49 SET RSLT="^sub-file 344.41 no entries"
+50 ; take first entry that gives result from file #430.2
+51 NEW J,C
SET (J,C)=0
FOR
SET J=$ORDER(^RCY(344.4,RCIEN,1,J))
if 'J!RSLT
QUIT
SET X=$GET(^(J,0))
Begin DoDot:2
+52 SET PF=361.1
SET RSLT="^no pointer to "_PF
+53 SET Y=+$PIECE(X,U,2)
if '(Y>0)
QUIT
SET C=C+1
+54 SET RSLT="^sub-file 344.41 total checked "_C
SET F=$$PTR4302(PF_";"_Y)
if F
SET RSLT=F
End DoDot:2
End DoDot:1
QUIT RSLT
+55 ;
+56 ; AR BATCH PAYMENT file #344, (#.18) ERA REFERENCE [18P:344.4]
+57 IF RCFLNUM=344
Begin DoDot:1
+58 SET X=$GET(^RCY(344,RCIEN,0))
if X=""
QUIT
+59 SET PF=344.4
SET Y=+$PIECE(X,U,18)
SET RSLT="^no pointer to "_PF
if '(Y>0)
QUIT
+60 SET RSLT=$$PTR4302(PF_";"_Y)
End DoDot:1
QUIT RSLT
+61 ;
+62 ; finished all checks, valid file number not found
+63 SET RSLT=U_"invalid file #"_RCFLNUM
+64 ;
+65 QUIT RSLT
+66 ;
SL(T,RCLNCNT,RC2GLBL) ; Set text into global or write line
+1 ; T = text to output
+2 ; RCLNCNT = line counter, passed by ref. (optional)
+3 ; RC2GLBL = if non-null indicates output to global, no writes
+4 IF $GET(RC2GLBL)=""
WRITE !,T
QUIT
+5 SET RCLNCNT=RCLNCNT+1
SET ^TMP($JOB,RC2GLBL,RCLNCNT)=T
+6 QUIT
+7 ;
UP(A) ; Returns UPPERCASE
+1 QUIT $$UP^XLFSTR(A)
