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