IBCEFG8 ;ALB/TMP - OUTPUT FORMATTER GENERIC FORM TEST PROCESSING ;21-MAR-96
;;2.0;INTEGRATED BILLING;**52,88,51,348**; 21-MAR-94;Build 5
;
Q
;
TEST ;Select form from screen and entry from file to test
N IBF2,IBTYP,IBFORM,IBQUE,IB2,IBPAR,IBCEXDA,IBFILE,IBXERR,DIC,POP,Z,ZTSK,PARAMX,IBIFN,IBXIEN,Z0
;Select form
D FULL^VALM1
D SELX^IBCEFG3 S IBFORM=$G(IBCEXDA)
G:IBFORM="" TESTQ
S IB2=$G(^IBE(353,IBFORM,2)),IBPAR=+$P(IB2,U,5)
;
; IB*2*348 - esg - no testing with old claim forms
I IBPAR=12!(IBPAR=13) D G TESTQ
. W !!?3,"This local form is associated with an obsolete printed claim form."
. W !?3,"Testing is not available for this form."
. Q
;
S IBTYP=$P(IB2,U,2),IBFILE=+IB2
;Select Entry #
S DIC=IBFILE,DIC(0)="AEMQ" D ^DIC
G:Y<0 TESTQ S (IBXIEN,IBIFN)=+Y
;
S PARAMX("TEST")=1
I IBTYP="P" D DEV^IBCEFG7(IBFORM,1) G:$G(POP) TESTQ
I IBTYP="T" D QUE G:$G(IBQUE)="" TESTQ
;
K ^TMP("IBXDATA",$J)
;
; Execute PRE-PROCESSOR
I $G(^IBE(353,IBFORM,"FPRE"))'="" X ^("FPRE") ;Form pre-processor
I $G(^IBE(353,IBFORM,"FPRE"))="",$G(^IBE(353,IBPAR,"FPRE"))'="" X ^("FPRE") ;Parent form pre-processor
G:$G(IBXERR)'="" FQ
;
; Extract record
I +$G(^IBE(353,IBFORM,2))=399 D
.S PARAMX(1)="BILL-SEARCH",Z0=$G(^DGCR(399,IBIFN,0))
.S Z=$P(Z0,U,21) S:Z="" Z="P" S PARAMX(2)=$P($G(^DGCR(399,IBIFN,"I"_($F("PST",Z)-1))),U),PARAMX(3)=$S($P(Z0,U,5)<3:"I",1:"O")
S Z=$$EXTRACT^IBCEFG(IBFORM,IBIFN,1,.PARAMX)
;
G:'$D(^TMP("IBXDATA",$J)) FQ
;
; If an output routine exists, use it, otherwise use the generic ones
I $G(^IBE(353,IBFORM,"OUT"))'="" X ^("OUT") G FQ
;
I IBTYP="P" D PRINT^IBCEFG7(IBFORM) D:'$D(ZTQUEUED) ^%ZISC G FQ
I IBTYP="T" D:$G(IBQUE)'="" TRANSMIT^IBCEFG7(IBFORM,IBQUE) G FQ
I IBTYP="S" D SCRN^IBCEFG70(IBFORM,IBIFN)
;
FQ ; Execute POST-PROCESSOR, if any
I $G(^IBE(353,IBFORM,"FPOST"))'="" X ^("FPOST") ;Form post-processor
I $G(^IBE(353,IBFORM,"FPOST"))="",$G(^IBE(353,IBPAR,"FPOST"))'="" X ^("FPOST") ;Parent form post-processor
TESTQ K ^TMP("IBXDATA",$J)
D PAUSE^VALM1
S VALMBCK="R"
Q
;
QUE ;Select QUEUE to receive transmission
S %=1 W !,"Send transmission to your mailbox" D YN^DICN
I (%+1#3) S IBQUE=DUZ Q
S DIR(0)="F",DIR("A")="Enter a mail queue name: ",DIR(0)="A",DIR("?")="This is the mailman queue where the formatted test record should be sent"
D ^DIR K DIR S IBQUE=$S('$D(DIRUT):Y,1:"")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEFG8 2420 printed Dec 13, 2024@02:10:38 Page 2
IBCEFG8 ;ALB/TMP - OUTPUT FORMATTER GENERIC FORM TEST PROCESSING ;21-MAR-96
+1 ;;2.0;INTEGRATED BILLING;**52,88,51,348**; 21-MAR-94;Build 5
+2 ;
+3 QUIT
+4 ;
TEST ;Select form from screen and entry from file to test
+1 NEW IBF2,IBTYP,IBFORM,IBQUE,IB2,IBPAR,IBCEXDA,IBFILE,IBXERR,DIC,POP,Z,ZTSK,PARAMX,IBIFN,IBXIEN,Z0
+2 ;Select form
+3 DO FULL^VALM1
+4 DO SELX^IBCEFG3
SET IBFORM=$GET(IBCEXDA)
+5 if IBFORM=""
GOTO TESTQ
+6 SET IB2=$GET(^IBE(353,IBFORM,2))
SET IBPAR=+$PIECE(IB2,U,5)
+7 ;
+8 ; IB*2*348 - esg - no testing with old claim forms
+9 IF IBPAR=12!(IBPAR=13)
Begin DoDot:1
+10 WRITE !!?3,"This local form is associated with an obsolete printed claim form."
+11 WRITE !?3,"Testing is not available for this form."
+12 QUIT
End DoDot:1
GOTO TESTQ
+13 ;
+14 SET IBTYP=$PIECE(IB2,U,2)
SET IBFILE=+IB2
+15 ;Select Entry #
+16 SET DIC=IBFILE
SET DIC(0)="AEMQ"
DO ^DIC
+17 if Y<0
GOTO TESTQ
SET (IBXIEN,IBIFN)=+Y
+18 ;
+19 SET PARAMX("TEST")=1
+20 IF IBTYP="P"
DO DEV^IBCEFG7(IBFORM,1)
if $GET(POP)
GOTO TESTQ
+21 IF IBTYP="T"
DO QUE
if $GET(IBQUE)=""
GOTO TESTQ
+22 ;
+23 KILL ^TMP("IBXDATA",$JOB)
+24 ;
+25 ; Execute PRE-PROCESSOR
+26 ;Form pre-processor
IF $GET(^IBE(353,IBFORM,"FPRE"))'=""
XECUTE ^("FPRE")
+27 ;Parent form pre-processor
IF $GET(^IBE(353,IBFORM,"FPRE"))=""
IF $GET(^IBE(353,IBPAR,"FPRE"))'=""
XECUTE ^("FPRE")
+28 if $GET(IBXERR)'=""
GOTO FQ
+29 ;
+30 ; Extract record
+31 IF +$GET(^IBE(353,IBFORM,2))=399
Begin DoDot:1
+32 SET PARAMX(1)="BILL-SEARCH"
SET Z0=$GET(^DGCR(399,IBIFN,0))
+33 SET Z=$PIECE(Z0,U,21)
if Z=""
SET Z="P"
SET PARAMX(2)=$PIECE($GET(^DGCR(399,IBIFN,"I"_($FIND("PST",Z)-1))),U)
SET PARAMX(3)=$SELECT($PIECE(Z0,U,5)<3:"I",1:"O")
End DoDot:1
+34 SET Z=$$EXTRACT^IBCEFG(IBFORM,IBIFN,1,.PARAMX)
+35 ;
+36 if '$DATA(^TMP("IBXDATA",$JOB))
GOTO FQ
+37 ;
+38 ; If an output routine exists, use it, otherwise use the generic ones
+39 IF $GET(^IBE(353,IBFORM,"OUT"))'=""
XECUTE ^("OUT")
GOTO FQ
+40 ;
+41 IF IBTYP="P"
DO PRINT^IBCEFG7(IBFORM)
if '$DATA(ZTQUEUED)
DO ^%ZISC
GOTO FQ
+42 IF IBTYP="T"
if $GET(IBQUE)'=""
DO TRANSMIT^IBCEFG7(IBFORM,IBQUE)
GOTO FQ
+43 IF IBTYP="S"
DO SCRN^IBCEFG70(IBFORM,IBIFN)
+44 ;
FQ ; Execute POST-PROCESSOR, if any
+1 ;Form post-processor
IF $GET(^IBE(353,IBFORM,"FPOST"))'=""
XECUTE ^("FPOST")
+2 ;Parent form post-processor
IF $GET(^IBE(353,IBFORM,"FPOST"))=""
IF $GET(^IBE(353,IBPAR,"FPOST"))'=""
XECUTE ^("FPOST")
TESTQ KILL ^TMP("IBXDATA",$JOB)
+1 DO PAUSE^VALM1
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
QUE ;Select QUEUE to receive transmission
+1 SET %=1
WRITE !,"Send transmission to your mailbox"
DO YN^DICN
+2 IF (%+1#3)
SET IBQUE=DUZ
QUIT
+3 SET DIR(0)="F"
SET DIR("A")="Enter a mail queue name: "
SET DIR(0)="A"
SET DIR("?")="This is the mailman queue where the formatted test record should be sent"
+4 DO ^DIR
KILL DIR
SET IBQUE=$SELECT('$DATA(DIRUT):Y,1:"")
+5 QUIT
+6 ;
