- 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 Feb 18, 2025@23:37:02 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 ;