- IBYOPOS1 ;ALB/TMP - IB*2*51 POST-INSTALL ;22-JAN-96
- ;;2.0;INTEGRATED BILLING;**51**;21-MAR-94
- ;
- ADDFORMS ; Add the local forms for HCFA 1500 and UB92 if they don't
- ; already exist
- ; Sets up local forms as defaults for form prints
- ; HCFA 1500 and UB-92
- D MES^XPDUTL("Setting up local form defaults for bill forms.")
- N IB2,IBFORM,IBFORMNM,IBLOC,IBLOCN,IBTEXT,DO,DD,DIC,DIE,DINUM,DR,X,Y,Z,Z0,Z1
- ;
- F IBFORM=2,3 S Z=$P($G(^IBE(353,IBFORM,2)),U,8) D
- . K IBTEXT
- . I 'Z D
- .. S IBFORMNM=$S(IBFORM=2:"HCFA 1500",1:"UB-92")
- .. S IBLOCN="LOCAL "_IBFORMNM_" (AUTO-ADDED)"
- .. S IB2=$G(^IBE(353,IBFORM,2))
- .. S IBLOC=+$O(^IBE(353,"B",IBLOCN,0))
- .. I IBLOC D MES^XPDUTL("Form "_IBLOCN_" already exists - not added again")
- .. I 'IBLOC D
- ... F Z0=1:1:5 L +^IBE(353,0):1 Q:$T
- ... I '$T S IBTEXT(1)=" Problem adding local print form for "_IBFORMNM,IBTEXT(2)=" Please add this form manually" D ERRMSG^IBYOPOST(.IBTEXT) Q
- ... D MES^XPDUTL("Adding form '"_IBLOCN_"' to form file.")
- ... S Z1=$O(^IBE(353,"A"),-1) I Z1<10000 S Z1=9999
- ... S Z1=Z1+1,DINUM=Z1,DLAYGO=353,DIC="^IBE(353,",DIC(0)="L",X=IBLOCN
- ... S DIC("DR")="2.01////399;2.02////P;2.03////"_$P(IB2,U,3)_";2.04////0;2.05////"_IBFORM_";2.06////"_IBLOCN
- ... D FILE^DICN K DO,DD,DIC,DLAYGO,DINUM
- ... L -^IBE(353,0)
- ... I Y<0 S IBTEXT(1)=" Problem adding local print form for "_IBFORMNM,IBTEXT(2)=" Please add the form manually using the output formatter" D ERRMSG^IBYOPOST(.IBTEXT) Q
- ... S IBLOC=+Y
- .. ;
- .. D MES^XPDUTL("Updating "_IBFORMNM_"'s PRINT FORM field with "_IBLOCN_".")
- .. S DIE="^IBE(353,",DA=IBFORM,DR="2.08////"_IBLOC D ^DIE
- .. I '$P($G(^IBE(353,IBFORM,2)),U,8) S IBTEXT(1)=" Problem updating "_IBFORMNM_"'s PRINT FORM data",IBTEXT(2)=" Please update this form definition manually so your bills print correctly" D ERRMSG^IBYOPOST(.IBTEXT) Q
- ;
- S Z=8 F S Z=$O(^IBE(Z)) Q:'Z I $P($G(^IBE(353,Z,2)),U,2)="S" D
- . S DR="2.05////"_Z,DIE="^IBE(353,",DA=Z D ^DIE
- D COMPLETE^IBYOPOST
- ;
- D BMES^XPDUTL("Post install complete.")
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYOPOS1 2052 printed Mar 13, 2025@21:40:59 Page 2
- IBYOPOS1 ;ALB/TMP - IB*2*51 POST-INSTALL ;22-JAN-96
- +1 ;;2.0;INTEGRATED BILLING;**51**;21-MAR-94
- +2 ;
- ADDFORMS ; Add the local forms for HCFA 1500 and UB92 if they don't
- +1 ; already exist
- +2 ; Sets up local forms as defaults for form prints
- +3 ; HCFA 1500 and UB-92
- +4 DO MES^XPDUTL("Setting up local form defaults for bill forms.")
- +5 NEW IB2,IBFORM,IBFORMNM,IBLOC,IBLOCN,IBTEXT,DO,DD,DIC,DIE,DINUM,DR,X,Y,Z,Z0,Z1
- +6 ;
- +7 FOR IBFORM=2,3
- SET Z=$PIECE($GET(^IBE(353,IBFORM,2)),U,8)
- Begin DoDot:1
- +8 KILL IBTEXT
- +9 IF 'Z
- Begin DoDot:2
- +10 SET IBFORMNM=$SELECT(IBFORM=2:"HCFA 1500",1:"UB-92")
- +11 SET IBLOCN="LOCAL "_IBFORMNM_" (AUTO-ADDED)"
- +12 SET IB2=$GET(^IBE(353,IBFORM,2))
- +13 SET IBLOC=+$ORDER(^IBE(353,"B",IBLOCN,0))
- +14 IF IBLOC
- DO MES^XPDUTL("Form "_IBLOCN_" already exists - not added again")
- +15 IF 'IBLOC
- Begin DoDot:3
- +16 FOR Z0=1:1:5
- LOCK +^IBE(353,0):1
- if $TEST
- QUIT
- +17 IF '$TEST
- SET IBTEXT(1)=" Problem adding local print form for "_IBFORMNM
- SET IBTEXT(2)=" Please add this form manually"
- DO ERRMSG^IBYOPOST(.IBTEXT)
- QUIT
- +18 DO MES^XPDUTL("Adding form '"_IBLOCN_"' to form file.")
- +19 SET Z1=$ORDER(^IBE(353,"A"),-1)
- IF Z1<10000
- SET Z1=9999
- +20 SET Z1=Z1+1
- SET DINUM=Z1
- SET DLAYGO=353
- SET DIC="^IBE(353,"
- SET DIC(0)="L"
- SET X=IBLOCN
- +21 SET DIC("DR")="2.01////399;2.02////P;2.03////"_$PIECE(IB2,U,3)_";2.04////0;2.05////"_IBFORM_";2.06////"_IBLOCN
- +22 DO FILE^DICN
- KILL DO,DD,DIC,DLAYGO,DINUM
- +23 LOCK -^IBE(353,0)
- +24 IF Y<0
- SET IBTEXT(1)=" Problem adding local print form for "_IBFORMNM
- SET IBTEXT(2)=" Please add the form manually using the output formatter"
- DO ERRMSG^IBYOPOST(.IBTEXT)
- QUIT
- +25 SET IBLOC=+Y
- End DoDot:3
- +26 ;
- +27 DO MES^XPDUTL("Updating "_IBFORMNM_"'s PRINT FORM field with "_IBLOCN_".")
- +28 SET DIE="^IBE(353,"
- SET DA=IBFORM
- SET DR="2.08////"_IBLOC
- DO ^DIE
- +29 IF '$PIECE($GET(^IBE(353,IBFORM,2)),U,8)
- SET IBTEXT(1)=" Problem updating "_IBFORMNM_"'s PRINT FORM data"
- SET IBTEXT(2)=" Please update this form definition manually so your bills print correctly"
- DO ERRMSG^IBYOPOST(.IBTEXT)
- QUIT
- End DoDot:2
- End DoDot:1
- +30 ;
- +31 SET Z=8
- FOR
- SET Z=$ORDER(^IBE(Z))
- if 'Z
- QUIT
- IF $PIECE($GET(^IBE(353,Z,2)),U,2)="S"
- Begin DoDot:1
- +32 SET DR="2.05////"_Z
- SET DIE="^IBE(353,"
- SET DA=Z
- DO ^DIE
- End DoDot:1
- +33 DO COMPLETE^IBYOPOST
- +34 ;
- +35 DO BMES^XPDUTL("Post install complete.")
- +36 QUIT
- +37 ;
