IBCEFG3 ; ALB/TMP - OUTPUT FORMATTER MAINT - SCREEN BLD UTILITIES ; 22-JAN-96
;;2.0; INTEGRATED BILLING ;**52,88**; 21-MAR-94
;
EN ; Main entry point LOCAL FORM maintenance
D DT^DICRW
K XQORS,VALMEVL,IBFASTXT
D EN^VALM("IBCE LOCAL FORMS LIST")
K IBFASTXT
Q
;
INIT ; -- set up inital variables local form list
S U="^",VALMCNT=0,VALMBG=1
K ^TMP("IBCEFORM",$J),^TMP("IBCEFORMDX",$J)
D BLD
Q
;
BLD ; -- build list of local forms
K ^TMP("IBCEFORM",$J),^TMP("IBCEFORMDX",$J)
N IBCFORM,IBCNT,X,IB2
S (IBCNT,VALMCNT)=0
;
; -- find all local forms
S IBCFORM=0 F S IBCFORM=$O(^IBE(353,IBCFORM)) Q:'IBCFORM S IB2=$G(^(IBCFORM,2)) I $P(IB2,U,4)=0 D
.; -- add to list
.S IBCNT=IBCNT+1,X="" W "."
.S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
.I $D(^IBE(353,IBCFORM,0)) S X=$$SETFLD^VALM1($P(^(0),"^"),X,"FNAME")
.S X=$$SETFLD^VALM1($J(IBCFORM,6),X,"FENTRY")
.S X=$$SETFLD^VALM1($J($P(IB2,U,2),3),X,"TYPE")
.S X=$$SETFLD^VALM1($P(IB2,U,6),X,"DESCR")
.D SET(X)
I '$D(^TMP("IBCEFORM",$J)) S VALMCNT=2,IBCNT=2,^TMP("IBCEFORM",$J,1,0)=" ",^TMP("IBCEFORM",$J,2,0)=" No Local Forms Currently On File",^TMP("IBCEFORM",$J,"IDX",1,1)="",^TMP("IBCEFORM",$J,"IDX",2,2)=""
Q
;
FNL ; -- Clean up local form list
K ^TMP("IBCEFORMDX",$J)
D CLEAN^VALM10
K IBFASTXT
Q
;
SET(X) ; -- set arrays for local form list
S VALMCNT=VALMCNT+1,^TMP("IBCEFORM",$J,VALMCNT,0)=X
S ^TMP("IBCEFORM",$J,"IDX",VALMCNT,IBCNT)=""
S ^TMP("IBCEFORMDX",$J,IBCNT)=VALMCNT_"^"_IBCFORM
Q
;
BLDX ; -- build display of expanded local form
N IB2,IBPAR,Z,Z0
Q:'$G(IBCEXDA) ;Form ien in file 353
S VALMBG=1,IB2=$G(^IBE(353,IBCEXDA,2)),IBPAR=+$P(IB2,U,5)
K ^TMP("IBCEX",$J)
D SET^VALM10(1,"Form Number: "_IBCEXDA),SET^VALM10(2,"Base File : "_$P($G(^DIC(+IB2,0)),U))
D SET^VALM10(3,"Format Type: "_$$EXPAND^IBTRE(353,2.02,$P(IB2,U,2)))
D SET^VALM10(4," ")
D SET^VALM10(5,"Description: "_$P(IB2,U,6))
S VALMCNT=5
I $P(IB2,U,2)="P" D SET^VALM10(VALMCNT+1,"Form Length: "_$P(IB2,U,3)) S VALMCNT=VALMCNT+1
I $P(IB2,U,2)="T" S Z=$S(IBPAR:$P($G(^IBE(353,IBPAR,2)),U,7),1:$P(IB2,U,7)) S:Z="" Z="^" D SET^VALM10(VALMCNT+1," Delimiter: "_Z) S VALMCNT=VALMCNT+1
I IBPAR D SET^VALM10(VALMCNT+1," ") D SET^VALM10(VALMCNT+2,"Associated With National Form: "_$P($G(^IBE(353,IBPAR,0)),U)) S VALMCNT=VALMCNT+2
S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT," ")
I $P(IB2,U,2)'="S" D
. K Z
. S VALMCNT=VALMCNT+1,Z0=$G(^IBE(353,IBPAR,"PRE")),Z=$G(^IBE(353,IBCEXDA,"PRE"))
. I $L(Z)>57 D SPLITZ(.Z)
. D SET^VALM10(VALMCNT,"Entry Pre-processor : "_$S(Z'="":Z,Z0="":"",1:Z0_" (defined for associated 'parent' form)"))
. I $D(Z(0)) D
.. N CT
.. F CT=0:1:$O(Z(""),-1) S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,Z(CT))
.. K Z
. S VALMCNT=VALMCNT+1,Z0=$G(^IBE(353,IBPAR,"POST")),Z=$G(^IBE(353,IBCEXDA,"POST"))
. I $L(Z)>57 D SPLITZ(.Z)
. D SET^VALM10(VALMCNT,"Entry Post-processor: "_$S(Z'="":Z,Z0="":"",1:Z0_" (defined for associated 'parent' form)"))
. I $D(Z(0)) D
.. N CT
.. F CT=0:1:$O(Z(""),-1) S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,Z(CT))
.. K Z
S VALMCNT=VALMCNT+1,Z0=$G(^IBE(353,IBPAR,"FPRE")),Z=$G(^IBE(353,IBCEXDA,"FPRE"))
I $L(Z)>57 D SPLITZ(.Z)
D SET^VALM10(VALMCNT,"Form Pre-processor : "_$S(Z'="":Z,Z0="":"",1:Z0_" (defined for associated 'parent' form)"))
I $D(Z(0)) D
. N CT
. F CT=0:1:$O(Z(""),-1) S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,Z(CT))
. K Z
S VALMCNT=VALMCNT+1,Z0=$G(^IBE(353,IBPAR,"FPOST")),Z=$G(^IBE(353,IBCEXDA,"FPOST"))
I $L(Z)>57 D SPLITZ(.Z)
D SET^VALM10(VALMCNT,"Form Post-processor : "_$S(Z'="":Z,Z0="":"",1:Z0_" (defined for associated 'parent' form)"))
I $D(Z(0)) D
. N CT
. F CT=0:1:$O(Z(""),-1) S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,Z(CT))
. K Z
I $P(IB2,U,2)'="S" D
. S VALMCNT=VALMCNT+1,Z0=$G(^IBE(353,IBPAR,"OUT")),Z=$G(^IBE(353,IBCEXDA,"OUT"))
. I $L(Z)>57 D SPLITZ(.Z)
. D SET^VALM10(VALMCNT,"Output Logic : "_$S(Z'="":Z,Z0="":"(Use formatter default)",1:Z0_" (defined for associated 'parent' form)"))
. I $D(Z(0)) D
.. N CT
.. F CT=0:1:$O(Z(""),-1) S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,Z(CT))
.. K Z
. S VALMCNT=VALMCNT+1,Z0=$G(^IBE(353,IBPAR,"EXT")),Z=$G(^IBE(353,IBCEXDA,"EXT"))
. I $L(Z)>57 D SPLITZ(.Z)
. D SET^VALM10(VALMCNT,"Extract Logic : "_$S(Z'="":Z,Z0="":"",1:Z0_" (defined for associated 'parent' form)"))
. I $D(Z(0)) D
.. N CT
.. F CT=0:1:$O(Z(""),-1) S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,Z(CT))
.. K Z
Q
;
SELX ; -- Select the form to process
D EN^VALM2($G(XQORNOD(0)),"S")
S IBCEXDA=$P($G(^TMP("IBCEFORMDX",$J,+$O(VALMY("")))),U,2)
Q
;
FNLX ; Clean up after form view/edit action
K IBCEXDA
D CLEAN^VALM10
S VALMBCK="R"
Q
;
HDRX ; -- Hdr for form view/edit action
S VALMHDR(1)=" "
S VALMHDR(2)="LOCAL FORM: "_$P($G(^IBE(353,+$G(IBCEXDA),0)),U)
Q
;
SPLITZ(Z) ;Splits code into chunks the display can handle
N A,CT,Q,ST
S A=Z,CT=0,ST=57
S Z=$E(A,1,ST)
F CT=0:1 S Q=$E(A,ST+1,ST+57) Q:Q="" S Z(CT)=$J("",22)_Q,ST=ST+57
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEFG3 5063 printed Apr 09, 2024@21:06:10 Page 2
IBCEFG3 ; ALB/TMP - OUTPUT FORMATTER MAINT - SCREEN BLD UTILITIES ; 22-JAN-96
+1 ;;2.0; INTEGRATED BILLING ;**52,88**; 21-MAR-94
+2 ;
EN ; Main entry point LOCAL FORM maintenance
+1 DO DT^DICRW
+2 KILL XQORS,VALMEVL,IBFASTXT
+3 DO EN^VALM("IBCE LOCAL FORMS LIST")
+4 KILL IBFASTXT
+5 QUIT
+6 ;
INIT ; -- set up inital variables local form list
+1 SET U="^"
SET VALMCNT=0
SET VALMBG=1
+2 KILL ^TMP("IBCEFORM",$JOB),^TMP("IBCEFORMDX",$JOB)
+3 DO BLD
+4 QUIT
+5 ;
BLD ; -- build list of local forms
+1 KILL ^TMP("IBCEFORM",$JOB),^TMP("IBCEFORMDX",$JOB)
+2 NEW IBCFORM,IBCNT,X,IB2
+3 SET (IBCNT,VALMCNT)=0
+4 ;
+5 ; -- find all local forms
+6 SET IBCFORM=0
FOR
SET IBCFORM=$ORDER(^IBE(353,IBCFORM))
if 'IBCFORM
QUIT
SET IB2=$GET(^(IBCFORM,2))
IF $PIECE(IB2,U,4)=0
Begin DoDot:1
+7 ; -- add to list
+8 SET IBCNT=IBCNT+1
SET X=""
WRITE "."
+9 SET X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
+10 IF $DATA(^IBE(353,IBCFORM,0))
SET X=$$SETFLD^VALM1($PIECE(^(0),"^"),X,"FNAME")
+11 SET X=$$SETFLD^VALM1($JUSTIFY(IBCFORM,6),X,"FENTRY")
+12 SET X=$$SETFLD^VALM1($JUSTIFY($PIECE(IB2,U,2),3),X,"TYPE")
+13 SET X=$$SETFLD^VALM1($PIECE(IB2,U,6),X,"DESCR")
+14 DO SET(X)
End DoDot:1
+15 IF '$DATA(^TMP("IBCEFORM",$JOB))
SET VALMCNT=2
SET IBCNT=2
SET ^TMP("IBCEFORM",$JOB,1,0)=" "
SET ^TMP("IBCEFORM",$JOB,2,0)=" No Local Forms Currently On File"
SET ^TMP("IBCEFORM",$JOB,"IDX",1,1)=""
SET ^TMP("IBCEFORM",$JOB,"IDX",2,2)=""
+16 QUIT
+17 ;
FNL ; -- Clean up local form list
+1 KILL ^TMP("IBCEFORMDX",$JOB)
+2 DO CLEAN^VALM10
+3 KILL IBFASTXT
+4 QUIT
+5 ;
SET(X) ; -- set arrays for local form list
+1 SET VALMCNT=VALMCNT+1
SET ^TMP("IBCEFORM",$JOB,VALMCNT,0)=X
+2 SET ^TMP("IBCEFORM",$JOB,"IDX",VALMCNT,IBCNT)=""
+3 SET ^TMP("IBCEFORMDX",$JOB,IBCNT)=VALMCNT_"^"_IBCFORM
+4 QUIT
+5 ;
BLDX ; -- build display of expanded local form
+1 NEW IB2,IBPAR,Z,Z0
+2 ;Form ien in file 353
if '$GET(IBCEXDA)
QUIT
+3 SET VALMBG=1
SET IB2=$GET(^IBE(353,IBCEXDA,2))
SET IBPAR=+$PIECE(IB2,U,5)
+4 KILL ^TMP("IBCEX",$JOB)
+5 DO SET^VALM10(1,"Form Number: "_IBCEXDA)
DO SET^VALM10(2,"Base File : "_$PIECE($GET(^DIC(+IB2,0)),U))
+6 DO SET^VALM10(3,"Format Type: "_$$EXPAND^IBTRE(353,2.02,$PIECE(IB2,U,2)))
+7 DO SET^VALM10(4," ")
+8 DO SET^VALM10(5,"Description: "_$PIECE(IB2,U,6))
+9 SET VALMCNT=5
+10 IF $PIECE(IB2,U,2)="P"
DO SET^VALM10(VALMCNT+1,"Form Length: "_$PIECE(IB2,U,3))
SET VALMCNT=VALMCNT+1
+11 IF $PIECE(IB2,U,2)="T"
SET Z=$SELECT(IBPAR:$PIECE($GET(^IBE(353,IBPAR,2)),U,7),1:$PIECE(IB2,U,7))
if Z=""
SET Z="^"
DO SET^VALM10(VALMCNT+1," Delimiter: "_Z)
SET VALMCNT=VALMCNT+1
+12 IF IBPAR
DO SET^VALM10(VALMCNT+1," ")
DO SET^VALM10(VALMCNT+2,"Associated With National Form: "_$PIECE($GET(^IBE(353,IBPAR,0)),U))
SET VALMCNT=VALMCNT+2
+13 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT," ")
+14 IF $PIECE(IB2,U,2)'="S"
Begin DoDot:1
+15 KILL Z
+16 SET VALMCNT=VALMCNT+1
SET Z0=$GET(^IBE(353,IBPAR,"PRE"))
SET Z=$GET(^IBE(353,IBCEXDA,"PRE"))
+17 IF $LENGTH(Z)>57
DO SPLITZ(.Z)
+18 DO SET^VALM10(VALMCNT,"Entry Pre-processor : "_$SELECT(Z'="":Z,Z0="":"",1:Z0_" (defined for associated 'parent' form)"))
+19 IF $DATA(Z(0))
Begin DoDot:2
+20 NEW CT
+21 FOR CT=0:1:$ORDER(Z(""),-1)
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,Z(CT))
+22 KILL Z
End DoDot:2
+23 SET VALMCNT=VALMCNT+1
SET Z0=$GET(^IBE(353,IBPAR,"POST"))
SET Z=$GET(^IBE(353,IBCEXDA,"POST"))
+24 IF $LENGTH(Z)>57
DO SPLITZ(.Z)
+25 DO SET^VALM10(VALMCNT,"Entry Post-processor: "_$SELECT(Z'="":Z,Z0="":"",1:Z0_" (defined for associated 'parent' form)"))
+26 IF $DATA(Z(0))
Begin DoDot:2
+27 NEW CT
+28 FOR CT=0:1:$ORDER(Z(""),-1)
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,Z(CT))
+29 KILL Z
End DoDot:2
End DoDot:1
+30 SET VALMCNT=VALMCNT+1
SET Z0=$GET(^IBE(353,IBPAR,"FPRE"))
SET Z=$GET(^IBE(353,IBCEXDA,"FPRE"))
+31 IF $LENGTH(Z)>57
DO SPLITZ(.Z)
+32 DO SET^VALM10(VALMCNT,"Form Pre-processor : "_$SELECT(Z'="":Z,Z0="":"",1:Z0_" (defined for associated 'parent' form)"))
+33 IF $DATA(Z(0))
Begin DoDot:1
+34 NEW CT
+35 FOR CT=0:1:$ORDER(Z(""),-1)
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,Z(CT))
+36 KILL Z
End DoDot:1
+37 SET VALMCNT=VALMCNT+1
SET Z0=$GET(^IBE(353,IBPAR,"FPOST"))
SET Z=$GET(^IBE(353,IBCEXDA,"FPOST"))
+38 IF $LENGTH(Z)>57
DO SPLITZ(.Z)
+39 DO SET^VALM10(VALMCNT,"Form Post-processor : "_$SELECT(Z'="":Z,Z0="":"",1:Z0_" (defined for associated 'parent' form)"))
+40 IF $DATA(Z(0))
Begin DoDot:1
+41 NEW CT
+42 FOR CT=0:1:$ORDER(Z(""),-1)
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,Z(CT))
+43 KILL Z
End DoDot:1
+44 IF $PIECE(IB2,U,2)'="S"
Begin DoDot:1
+45 SET VALMCNT=VALMCNT+1
SET Z0=$GET(^IBE(353,IBPAR,"OUT"))
SET Z=$GET(^IBE(353,IBCEXDA,"OUT"))
+46 IF $LENGTH(Z)>57
DO SPLITZ(.Z)
+47 DO SET^VALM10(VALMCNT,"Output Logic : "_$SELECT(Z'="":Z,Z0="":"(Use formatter default)",1:Z0_" (defined for associated 'parent' form)"))
+48 IF $DATA(Z(0))
Begin DoDot:2
+49 NEW CT
+50 FOR CT=0:1:$ORDER(Z(""),-1)
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,Z(CT))
+51 KILL Z
End DoDot:2
+52 SET VALMCNT=VALMCNT+1
SET Z0=$GET(^IBE(353,IBPAR,"EXT"))
SET Z=$GET(^IBE(353,IBCEXDA,"EXT"))
+53 IF $LENGTH(Z)>57
DO SPLITZ(.Z)
+54 DO SET^VALM10(VALMCNT,"Extract Logic : "_$SELECT(Z'="":Z,Z0="":"",1:Z0_" (defined for associated 'parent' form)"))
+55 IF $DATA(Z(0))
Begin DoDot:2
+56 NEW CT
+57 FOR CT=0:1:$ORDER(Z(""),-1)
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,Z(CT))
+58 KILL Z
End DoDot:2
End DoDot:1
+59 QUIT
+60 ;
SELX ; -- Select the form to process
+1 DO EN^VALM2($GET(XQORNOD(0)),"S")
+2 SET IBCEXDA=$PIECE($GET(^TMP("IBCEFORMDX",$JOB,+$ORDER(VALMY("")))),U,2)
+3 QUIT
+4 ;
FNLX ; Clean up after form view/edit action
+1 KILL IBCEXDA
+2 DO CLEAN^VALM10
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
HDRX ; -- Hdr for form view/edit action
+1 SET VALMHDR(1)=" "
+2 SET VALMHDR(2)="LOCAL FORM: "_$PIECE($GET(^IBE(353,+$GET(IBCEXDA),0)),U)
+3 QUIT
+4 ;
SPLITZ(Z) ;Splits code into chunks the display can handle
+1 NEW A,CT,Q,ST
+2 SET A=Z
SET CT=0
SET ST=57
+3 SET Z=$EXTRACT(A,1,ST)
+4 FOR CT=0:1
SET Q=$EXTRACT(A,ST+1,ST+57)
if Q=""
QUIT
SET Z(CT)=$JUSTIFY("",22)_Q
SET ST=ST+57
+5 QUIT
+6 ;
